Shiny R：plotly 中的绘图显示错误

Question

我在显示地块时遇到了一些问题。 它们是动态添加的：选择的变量越多，绘制的图就越多。 问题是没有空间尊重。

这是代码：

dades <- iris
binary_variable <- factor(sample(x = c(0, 1), size = nrow(dades), replace = TRUE))
dades <- cbind(iris, binary_variable)

ui <- fluidPage(
  column(2, ),
  column(8, 
         
         fluidRow(
           
           column(4, 
                  selectInput("resposta", "Dependent variable", choices = names(dades))
           ),
           column(4,
                  textInput("explicatives", "Independent variables")
           ),
           column(4,
                  actionButton("executar", "Run")
           )
         ),
         fluidRow(align = "center",
                  verbatimTextOutput("resultat"),
                  uiOutput("grafics")
         )
         
  ),
  column(2, )
)

server <- function(input, output, session) {
  
  model <- reactive({
    
    if(input$executar == 0){
      
      return(invisible(NULL))
      
    }else{
      
      isolate({
        
        resposta2 <- factor(dades[, input$resposta])
        etiquetes <- levels(resposta2)
        levels(resposta2) <- c(0, 1)
        resposta2 <- factor(resposta2, levels = c(0, 1), labels = etiquetes)
        
        f <- as.formula(paste0("resposta2 ~ ", input$explicatives))
        
        
        glm(formula = f, family = binomial, data = dades)
        
      })
      
    }
    
  })

  output$resultat <- renderPrint({
    
    if(input$executar == 0){
      
      return(invisible(NULL))
      
    }else{
      
      isolate({
        
        summary(model())
        
      })
      
    }
    
  })

  observe({
    
    if(input$executar == 0) {
      
      return(invisible(NULL))
      
    } else {
      
      lapply(names(model()$model)[-1], function(par){
        
        
        if (is.factor(model()$model[, par]) || is.character(model()$model[, par]) || is.integer(model()$model[, par])) {
          
          taula <- as.data.frame(table(model()$model$resposta2, model()$model[, par]))
          p <- plot_ly(taula, x = ~ Var1, y = ~Freq, color = ~Var2, type = "bar") %>% 
            layout(title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), height = 500, width = 500, inline = TRUE)
          output[[paste("plot", par, sep = "_")]] <- renderPlotly({
            p
          })
          
        } else if (is.numeric(model()$model[, par])){
          
          p <- plot_ly(model()$model, y = ~model()$model[, par], color = ~resposta2, type = "box") %>%
            layout(title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), height = 500, width = 500, inline = TRUE)
          output[[paste("plot", par, sep = "_")]] <- renderPlotly({
            p
          })
          
          
        }
        
        
      })
      
    }
    
  })
  
  output$grafics <- renderUI({
    
    if(input$executar == 0) {
      
      return(invisible(NULL))
      
    } else {
      
      plot_output_list <- lapply(names(model()$model)[-1], function(par) {
        plotname <- paste("plot", par, sep = "_")
        plotlyOutput(plotname)
      })
      
      do.call(flowLayout, plot_output_list)
      
    }
    
  })

}

shinyApp(ui, server)

在“因变量”输入中，您必须 select“binary_variable”，在“自变量”中输入类似“Sepal.Length + Sepal.Width + Species”的内容。 问题是情节就像叠加，就像它们之间没有足够的空间一样。 我怎样才能解决这个问题？

Answer 1

虽然您不能在layout()中指定width和height ，但可以让它autosize 。 此外，最好将图例放在底部，因为水平显示多个图。 尝试这个

ui <- fluidPage(
  column(2, ),
  column(8, 
         
         fluidRow(
           
           column(4, 
                  selectInput("resposta", "Dependent variable", choices = names(dades))
           ),
           column(4,
                  textInput("explicatives", "Independent variables")
           ),
           column(4,
                  actionButton("executar", "Run")
           )
         ),
         fluidRow(# align = "center",
           column(12, verbatimTextOutput("resultat")),
           column(12, uiOutput("grafics"))
         )
         
  ),
  column(2, )
)

server <- function(input, output, session) {
  
  model <- reactive({
    
    if(input$executar == 0){
      
      return(invisible(NULL))
      
    }else{
      
      isolate({
        
        resposta2 <- factor(dades[, input$resposta])
        etiquetes <- levels(resposta2)
        levels(resposta2) <- c(0, 1)
        resposta2 <- factor(resposta2, levels = c(0, 1), labels = etiquetes)
        
        f <- as.formula(paste0("resposta2 ~ ", input$explicatives))
        
        glm(formula = f, family = binomial, data = dades)
        
      })
      
    }
    
  })
  
  output$resultat <- renderPrint({
    
    if(input$executar == 0){
      
      return(invisible(NULL))
      
    }else{
      
      isolate({
        
        summary(model())
        
      })
      
    }
    
  })
  
  observe({
    
    if(input$executar == 0) {
      
      return(invisible(NULL))
      
    } else {
      
      lapply(names(model()$model)[-1], function(par){
        
        
        if (is.factor(model()$model[, par]) || is.character(model()$model[, par]) || is.integer(model()$model[, par])) {
          
          taula <- as.data.frame(table(model()$model$resposta2, model()$model[, par]))
          p <- plot_ly(taula, x = ~ Var1, y = ~Freq, color = ~Var2, type = "bar") %>% 
            layout(legend = list(orientation = "h"), title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), autosize=TRUE )
          output[[paste("plot", par, sep = "_")]] <- renderPlotly({
            p
          })
          
        } else if (is.numeric(model()$model[, par])){
          
          p <- plot_ly(model()$model, y = ~model()$model[, par], color = ~resposta2, type = "box") %>%
            layout(legend = list(orientation = "h"), title = NULL, xaxis = list(title = ""), yaxis = list(title = ""), autosize=TRUE )
          output[[paste("plot", par, sep = "_")]] <- renderPlotly({
            p
          })
          
        }
      })
    }
    
  })
  
  output$grafics <- renderUI({
    
    if(input$executar == 0) {
      
      return(invisible(NULL))
      
    } else {
      
      plot_output_list <- lapply(names(model()$model)[-1], function(par) {
        plotname <- paste("plot", par, sep = "_")
        plotlyOutput(plotname)
      })
      
      do.call(flowLayout, plot_output_list)
      
    }
    
  })
  
}

shinyApp(ui, server)