【问题标题】:Shiny R: bad display of plots in plotlyShiny R:情节显示不佳
【发布时间】:2021-08-12 07:36:57
【问题描述】:

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

这是代码:

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)

在“因变量”输入中,您必须选择“binary_variable”并在“自变量”中输入类似“Sepal.Length + Sepal.Width + Species”的内容。问题是情节就像叠加,就像它们之间没有足够的空间一样。我该如何解决这个问题?

【问题讨论】:

    标签: r plot shiny plotly superimpose


    【解决方案1】:

    虽然您不能在layout() 中指定widthheight,但您可以让它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)
    

    【讨论】:

      猜你喜欢
      • 2021-12-03
      • 1970-01-01
      • 2019-11-22
      • 2015-10-18
      • 2013-06-28
      • 2017-09-18
      • 1970-01-01
      • 2019-03-06
      • 1970-01-01
      相关资源
      最近更新 更多