基于Shiny sortable包实现拖拽图表名展示对应ggplot图表的需求

实现思路 #

核心是监听拖拽目标区域的内容变化，通过名称与图表对象的映射关系，动态渲染对应ggplot图表，具体修改如下：

修改后的完整代码 #

library(shiny)
library(ggplot2)
library(sortable)

# 定义所有图表对象
line_chart <- ggplot(mtcars, aes(mpg, cyl)) + geom_line() + theme_bw()
bar_chart <- ggplot(mtcars, aes(mpg, cyl)) + geom_col() + theme_bw()
pie_chart <- ggplot(mtcars, aes(x = "", fill = factor(cyl))) + 
  geom_bar(width = 1) + 
  coord_polar("y", start = 0) + 
  theme_void()

ui <- fluidPage(
  tags$style(
    "
    body{
      padding:1em;
      background: #e7e7e9;
    }

    .default-sortable .rank-list-item{
      border-radius: 3px;
      display: block;
      padding: 10px 15px;
      background-color: #f8f8f8;
      border: 1px solid #ddd;
      overflow: unset;
      cursor: grab;
    }

    .default-sortable.bucket-list.bucket-list-vertical {
      flex-direction: row;
      gap: 2em;
      justify-content: center;
    }

    div#rank-list-rank_list_1{
      flex-direction: column;
      order: 1;
    }

    div#rank_list_1 {
      display: flex;
      flex-direction: column;
      height: 400px !important;
      overflow: scroll;
      border: 5px solid #333;
      padding: 1em;
      background: white;
      min-width: 250px;
    }

    div#rank-list-rank_list_2{
      order:-1;
    }

    div#rank_list_2 {
      display: flex;
      flex-wrap: wrap;
      width: 800px;
      gap: 2em;
      justify-content: flex-start;
      padding: 1em;
      border: 5px solid #333;
      background: white;
      min-height: 400px;
    }

    div#rank_list_2 .rank-list-item {
      border: 2px solid #2ecc71;
      width: 280px;
      margin-bottom: 1em;
    }

    .chart-container {
      width: 280px;
      height: 250px;
    }
    "
  ),

  title = "Dashboard",
  div(
    h5('Dashboard', style = 'font-size:3em;font-weight:900; text-align: center;'),
    class = 'all_options',
    style ='height: 100%;border:2px solid gray; padding: 1em;',
    bucket_list(
      header = "拖拽图表到左侧区域展示",
      group_name = "bucket_list_group",
      orientation = "vertical",
      add_rank_list(
        text = "图表列表",
        input_id = "rank_list_1",
        labels = list(
          htmltools::tags$div("Line Chart"),
          htmltools::tags$div("Bar Chart"),
          htmltools::tags$div("Pie Chart")
        )
      ),
      add_rank_list(
        text = "展示区域",
        labels = NULL,
        input_id = "rank_list_2"
      )
    )
  )
)

server <- function(input, output, session) {
  # 建立图表名称与对象的映射关系
  chart_mapping <- list(
    "Line Chart" = line_chart,
    "Bar Chart" = bar_chart,
    "Pie Chart" = pie_chart
  )

  # 监听拖拽变化，动态渲染图表
  observeEvent(input$rank_list_2, {
    req(input$rank_list_2)
    
    # 清空目标区域原有内容
    removeUI(selector = "#rank_list_2 .chart-container")
    
    # 遍历拖拽的图表名称，生成对应图表
    lapply(input$rank_list_2, function(chart_name) {
      chart_id <- paste0("chart_", gsub(" ", "_", chart_name))
      
      # 向目标区域插入图表容器
      insertUI(
        selector = "#rank_list_2",
        where = "beforeEnd",
        ui = div(
          class = "chart-container",
          h4(chart_name),
          plotOutput(chart_id, width = "100%", height = "220px")
        )
      )
      
      # 渲染对应图表
      output[[chart_id]] <- renderPlot({
        chart_mapping[[chart_name]]
      })
    })
  })
}

shinyApp(ui = ui, server = server)

关键修改说明 #

• 图表映射：创建chart_mapping命名列表，将拖拽文本与ggplot对象绑定，实现名称到图表的快速匹配。
• 动态渲染：通过observeEvent监听input$rank_list_2（目标区域的拖拽内容），动态插入图表容器并渲染对应plot。
• 样式优化：调整目标区域布局，让图表展示更整齐，同时优化拖拽项样式提升交互感。
• 补充饼图：完善原代码中未实现的Pie Chart，保证功能完整性。

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