Shiny中如何使用DT::renderDataTable渲染的数据绘图并设置selectInput无默认选中

核心修改点 #

• 调整下拉框配置实现无默认选中效果
• 提取公共筛选响应变量，同步供表格、折线图调用，实现筛选联动
• 修复原有绘图逻辑的冗余代码与语法错误

下拉框无默认选中配置 #

原有updateSelectInput的selected参数赋值为全量可选值会导致默认全选，修改为：

• 开启selectize=TRUE，添加未选中时的占位提示
• 更新下拉选项时将selected设为character(0)实现初始无选中

联动逻辑实现 #

将表格中单独写的筛选逻辑提取为独立响应式变量filtered_data()，DT渲染和ggplot绘图均调用该变量，保证数据同源、筛选同步。同时删除绘图代码中冗余的xlsx操作函数，修正折线图分组聚合逻辑。

library(shiny)
library(DT)
library(dplyr)
library(ggplot2)

data_1 <- mtcars

# User Interface
ui <- fluidPage(
  titlePanel("My dashboard"),
  sidebarLayout(
    sidebarPanel(
      # 开启selectize支持placeholder，设置无默认选中
      selectInput('filter_gear', 'gear', choices = NULL, selected = NULL, 
                  multiple = FALSE, selectize = TRUE, width = NULL, size = NULL,
                  options = list(placeholder = "请选择gear")),
      
      selectInput('filter_carb', 'carb', choices = NULL, selected = NULL, 
                  multiple = FALSE, selectize = TRUE, width = NULL, size = NULL,
                  options = list(placeholder = "请选择carb")),
      
      selectInput('filter_cyl', 'cyl', choices = NULL, selected = NULL, 
                  multiple = FALSE, selectize = TRUE, width = NULL, size = NULL,
                  options = list(placeholder = "请选择cyl"))
    ),
    
    mainPanel(
      tabsetPanel(id="mydash", type= "tabs",
                  tabPanel("Plot", plotOutput("fig"), plotOutput("fig2"), plotOutput("fig3")),
                  tabPanel("Tables", p(DTOutput('databasedf')))
                  
      )
    )
  )
)


server <- function(input, output, session) {
  
  filterdf <- reactive({
    filterdf <- data_1
    filterdf <- droplevels.data.frame(filterdf)
    return(filterdf)
  })
  
  filtergear <- reactive({
    unique(as.character(filterdf()$gear))
  })
  
  observeEvent(filtergear(), {
    updateSelectInput(session,
                      "filter_gear",
                      choices = filtergear(),
                      selected = character(0)) # 初始无选中
  })
  
  # 子级动态筛选
  datasub1 <- reactive({
    req(input$filter_gear) # 避免未选中时报错
    data_1[data_1$gear %in% input$filter_gear,]
  })
  
  filtercarb <- reactive({
    unique(as.character(datasub1()$carb))
  })
  
  observeEvent(filtercarb(), {
    updateSelectInput(session,
                      "filter_carb",
                      choices = sort(filtercarb()),
                      selected = character(0)) # 初始无选中
  })
  
  datasub2 <- reactive({
    req(input$filter_carb) # 避免未选中时报错
    data_1[data_1$carb %in% input$filter_carb,]
  })
  
  filtercyl <- reactive({
    unique(as.character(datasub2()$cyl))
  })
  
  observeEvent(filtercyl(), {
    updateSelectInput(session,
                      "filter_cyl",
                      choices = sort(filtercyl()),
                      selected = character(0)) # 初始无选中
  })
  
  # 提取公共筛选响应变量，供表格和图表共用
  filtered_data <- reactive({
    req(input$filter_gear, input$filter_carb, input$filter_cyl)
    Filter1 <- droplevels.data.frame(data_1)
    filter(Filter1,
           gear %in% input$filter_gear,
           carb %in% input$filter_carb,
           cyl %in% input$filter_cyl)
  })
  
  output$databasedf <- DT::renderDT({
    datatable(filtered_data(),
              filter="none",
              selection="none",
              escape=FALSE,
              rownames = FALSE,
              autoHideNavigation = TRUE,
              style = 'bootstrap4',
              options = list(searching = FALSE,
                             ordering = FALSE,
                             paging = FALSE,
                             info = FALSE
              )) %>%
      formatStyle(columns = 1, fontWeight = 'bold', `text-align` = 'left')
  })
  
  output$fig <- renderPlot({ 
    # 按am、hp分组聚合mpg均值，适配折线图绘制
    plot_data <- filtered_data() %>%
      group_by(am, hp) %>%
      summarise(mean_mpg = mean(mpg), .groups = "drop")
    
    ggplot(plot_data, aes(x = hp, y = mean_mpg, color = factor(am))) +
      geom_line(linewidth = 1) +
      labs(color = "am", y = "平均mpg", x = "hp") +
      theme_minimal()
  })
  
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Daniela saba rosner