如何让Shiny绘图响应复选框的数据选择

你需要实现复选框勾选状态联动绘图数据显示，取消勾选对应项时，其数据从三个图中移除，重新勾选后恢复。以下是修改后的完整代码及关键改动说明：

关键改动点 #

• 去掉冗余的checkbox_states响应值，直接通过input$UseFile获取复选框选中状态
• 新增filtered_data反应式对象，根据选中的复选框过滤原始数据，只保留对应trial的行
• 绘图时传入过滤后的反应式数据，确保绘图随复选框状态动态更新
• 简化复选框初始化逻辑，直接默认选中所有选项

修改后的完整代码 #

library(shiny)                 # Server/App
library(shinyWidgets)          # Custom controls
library(tidyverse)             # For ggplot and dataframe manipulations

# Function to generate checkbox group UI
generateCheckboxGroupUI <- function(id, choices, names, selected, label) {
  checkbox_group <- 
    checkboxGroupButtons(
      inputId = id,
      label = label, 
      choiceValues = choices,
      choiceNames = names,
      selected = selected,
      status = "primary",
      direction = "vertical",
      checkIcon = list(
        yes = icon("ok", 
                   lib = "glyphicon"),
        no = icon("remove",
                  lib = "glyphicon")),
      size = 'sm'
    )
}

# Plot function
# Data frames must contain standard variables trial, time, and 3 columns of 
# data, pass column to plot in index = c(1,2,3)
CreatePlot <- function(df, index) {
  ylab <- names(df)[index + 2]
  df <- df %>% select(c(1, 2, data = index + 2))
  
  plot <- ggplot(df, aes(x = time, y = data, col = trial)) +
    geom_line(linewidth = 1) +
    labs(x = "Time (s)", y = ylab) +
    theme_minimal()
}

# ---- User Interface ----

ui <- fluidPage(
  sidebarLayout(
    # Nothing in sidebar for this example
    sidebarPanel(),
    
    # Main panel displays controls and plots
    mainPanel(
      # 1. Title
      fluidRow(
        column(12, align = 'center', h3("Reactive Plots"))
      ),
      
      # 2. File controls
      fluidRow(
        # File labels
        column(4),
        column(3, style = "display: flex;text-align: left; align-items: flex-start;",
               wellPanel(uiOutput("file_names")), style = "text-align: left;"),
        # File selection check boxes
        column(1, style = "display: flex; justify-content: center; align-items: flex-start;",
               wellPanel(uiOutput("UseFile"))),
        column(4)
      ),
      
    ), # mainPanel
  ), # sidebarLayout
  
  # New section below sidebar layout to use full width for plots
  # 3. Left side plot windows
  fluidRow(
    column(4, plotOutput("left_plot")),
    column(4, plotOutput("middle_plot")),
    column(4, plotOutput("right_plot"))
  )
  
) # fluidPage


#### ---- Server ---- ####
server <- function(input, output) {
  
  #############
  # Test Data: 4 files with time, X, Y, Z Data of equal lengths
  # Data inside server to replicate actual program
  # In actual program file chooser loads data files
  
  file_name_labels <- c("File_1", "File_2", "File_3", "File_4")
  num_files <- 4
  t <- seq(0,10,0.1)
  shift <- 0.25
  
  F1 <- tibble(
    trial = as.factor(1),
    time = t,
    X = sin(t),
    Y = cos(t),
    Z = sin(t) + cos(t)
  )
  
  F2 <- tibble(
    trial = as.factor(2),
    time = t,
    X = sin(t + shift),
    Y = cos(t + shift),
    Z = sin(t + shift) + cos(t + shift)
  )
  
  F3 <- tibble(
    trial = as.factor(3),
    time = t,
    X = sin(t - shift),
    Y = cos(t - shift),
    Z = sin(t - shift) + cos(t - shift)
  )
  
  F4 <- tibble(
    trial = as.factor(4),
    time = t,
    X = sin(-t),
    Y = cos(-t),
    Z = sin(-t) + cos(-t)
  )
  
  # Now bind together
  plot_data <- bind_rows(F1, F2, F3, F4)
  
  ########
  
  # File names
  # Create file name labels in UI
  output$file_names <- renderUI({
    file_names <- lapply(file_name_labels, function(name) {
      # Adjust h-level here to get size right
      h4(name)
    })
    
    tagList(
      # Add margin at the top to align with checkboxes and radio buttons
      tags$div(style = "margin-top: 12px;"),
      fluidRow(file_names)
    )
  })
  
  # choices are given dummy values: c('A', 'B', 'C', ...)
  checkbox_choices <- LETTERS[1:num_files]
  # names are set to blank in a vector of same size as choices
  checkbox_names <- rep("", num_files)
  # Plot File options
  output$UseFile <- renderUI({
    checkbox_group <- generateCheckboxGroupUI(
      id = "UseFile", 
      choices = checkbox_choices,
      names = checkbox_names,
      selected = checkbox_choices,  # 默认选中所有选项
      label = "Files")
    
    checkbox_group
  })
  
  # 反应式过滤数据：根据选中的复选框筛选对应的trial
  filtered_data <- reactive({
    # 将选中的字母映射到对应的trial编号（A->1, B->2...）
    selected_trials <- as.factor(match(input$UseFile, LETTERS))
    plot_data %>% filter(trial %in% selected_trials)
  })
  
  # Create the three plots
  output$left_plot <- renderPlot({
    plot <- CreatePlot(df = filtered_data(), index = 1)
    plot
  })
  
  output$middle_plot <- renderPlot({
    plot <- CreatePlot(df = filtered_data(), index = 2)
    plot
  })
  
  output$right_plot <- renderPlot({
    plot <- CreatePlot(df = filtered_data(), index = 3)
    plot
  })
  
} # Server

shinyApp(ui = ui, server = server)

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