Shiny中Plotly绘图的两列动态布局问题及解决

需求与问题 #

需要实现Plotly图表的两列动态行数布局：根据选择的图表数量自动调整行数（例如5/6张图表时为3行2列）。但原有代码存在两个问题：

• 多图表场景下所有图表内容重复，仅显示同一张图
• 已设置列宽为6，但图表仍垂直堆叠，无法实现两列并排

初始问题代码 #

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(selectInput(inputId = "y", label = "Y", choices = names(mtcars), selected = names(mtcars)[1], multiple = F),
                 selectizeInput(inputId = "xvars", label = "X", choices = names(mtcars), selected = names(mtcars)[1],
                                multiple = T)),
    mainPanel(uiOutput("allplots"))
  )
  
)

server <- function(input, output, session) {

  output$allplots <- renderUI({
    plt_list <- list()

    for (x in input$xvars){
      plt_list[[x]] <- renderPlotly({
        mtcars %>% ggplot(aes_string(x = x, y = input$y)) + geom_point()
      })
    }
    
    if (length(input$xvars) == 1) {
      plottoUI <- fluidRow(column(12, plt_list[1]))
    } else {
      plottoUI <- fluidRow(column(6, plt_list[1:length(input$xvars)]))
    }
    
    return(plottoUI)
  })
}

shinyApp(ui, server)

问题表现 #

所有图表垂直排列在一列中，且每张图表的内容完全重复，无法实现预期的两列布局效果

解决方案思路 #

1. 解决图表重复问题：将生成图表列表的for循环替换为lapply，避免循环变量延迟绑定导致的内容重复
2. 解决布局堆叠问题：不再将整个图表列表传入单个column，而是通过lapply为每个图表单独创建column(6)，实现两列并排

核心修改代码片段 #

plt_list <- lapply(input$xvars, function(x){
  renderPlotly({
    mtcars %>% ggplot(aes_string(x = x, y = input$y)) + geom_point()
  })
})

最终解决方案代码 #

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(selectInput(inputId = "y", label = "Y", choices = names(mtcars), selected = names(mtcars)[1], multiple = F),
                 selectizeInput(inputId = "xvars", label = "X", choices = names(mtcars), selected = names(mtcars)[1],
                                multiple = T)),
    mainPanel(uiOutput("allplots"))
  )
  
)

server <- function(input, output, session) {
  
  output$allplots <- renderUI({
    plt_list <- list()
    
    plt_list <- lapply(input$xvars, function(x){
      renderPlotly({
        mtcars %>% ggplot(aes_string(x = x, y = input$y)) + geom_point()
      })
    })
   
    if (length(input$xvars) == 1) {
      plottoUI <- fluidRow(column(12, plt_list[1]))
    } else {
      plottoUI <- fluidRow(
        lapply(1:length(input$xvars), function(x) column(6, plt_list[x]))
      )
    }
    
    return(plottoUI)
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Abbas