Shiny R:plotly 中的情节显示不佳

问题描述

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

这是代码

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")
           ),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,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,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",sep = "_")
        plotlyOutput(plotname)
      })
      
      do.call(flowLayout,plot_output_list)
      
    }
    
  })

}

shinyApp(ui,server)

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

解决方法

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

ui <- fluidPage(
  column(2,),column(8,fluidRow(
           
           column(4,selectInput("resposta","Dependent variable",choices = names(dades))
           ),column(4,textInput("explicatives","Independent variables")
           ),actionButton("executar","Run")
           )
         ),fluidRow(# align = "center",column(12,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(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"),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",sep = "_")
        plotlyOutput(plotname)
      })
      
      do.call(flowLayout,plot_output_list)
      
    }
    
  })
  
}

shinyApp(ui,server)

output