如何在RShiny中基于多用户自定义输入映射图例？

数据集说明 #

使用的土壤湿度数据集结构如下：

structure(list(DATE = c("1966-09-14", "1966-09-14", "1966-09-14", 
"1966-09-14", "1966-09-14", "1966-09-14"), LOCATION = c("S1S", 
"S2W", "S3E", "S3W", "S4S", "S5"), D_15 = c(NA_real_, NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_), D_46 = c(3.81, 3.05, 
1.52, 1.37, 1.75, 1.6), D_76 = c(2.13, 2.97, 0.91, 0.91, 1.68, 
3.28), D_107 = c(2.67, 2.97, 2.67, 2.51, 2.97, 3.73), D_137 = c(2.44, 
2.74, 3.81, 4.11, 3.28, 3.43), D_168 = c(2.74, 2.9, 1.37, 4.27, 
3.96, 2.67), D_198 = c(2.44, 3.51, 2.97, 3.2, 2.74, 2.59), D_229 = c(2.74, 
3.81, 1.83, 4.88, 3.51, 3.05), D_259 = c(10.36, 3.12, 1.52, 3.43, 
2.67, NA), D_290 = c(11.51, 1.45, 0.46, 6.25, 2.59, NA), D_320 = c(11.05, 
2.9, NA, 5.79, NA, NA)), row.names = c(NA, 6L), class = "data.frame")

其中LOCATION代表流域站点，D_15、D_46等为不同深度的土壤湿度值。

问题描述 #

需要开发Shiny应用，支持用户选择多组「站点+深度」组合绘图，实现同一站点多深度对比或多站点同深度对比。当前代码的图例仅按站点映射颜色，无法区分同一站点的不同深度，也无法区分不同站点的同一深度，导致图例混乱。

当前代码问题 #

1. 图例颜色仅绑定站点，未结合深度信息，无法区分「站点+深度」的唯一组合
2. 重复创建多个filtered_data响应式对象，代码冗余
3. 宽表格式数据不利于统一处理多深度列

优化后的完整代码 #

1. 数据预处理（加载数据时统一处理） #

先将宽表转换为tidy格式，把所有深度列合并为depth和moisture两列：

# 加载必要包
library(shiny)
library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)

# 加载并转换数据
df <- read.csv("data/SM_alpha.csv")
df$DATE <- as.Date(df$DATE)

# 转成tidy格式：宽表转长表
df_tidy <- df %>%
  pivot_longer(cols = starts_with("D_"), 
               names_to = "depth", 
               values_to = "moisture")

2. ui.R #

保留原有的6组选择框，优化标签可读性：

ui <- fluidPage(
  titlePanel("MEF Data Explorer"),
  
  plotOutput('Plot'),
  
  hr(),
  
  fluidRow(
    column(3,
           h4("SELECT DATE RANGE"),
           sliderInput("mindate", "Min date:", 
                       min = min(df$DATE), max = max(df$DATE), 
                       value = min(df$DATE)),
           sliderInput("maxdate", "Max date:", 
                       min = min(df$DATE), max = max(df$DATE), 
                       value = max(df$DATE))
    ),
    column(4,
           h4("SELECT SITE"),
           selectInput(inputId = "site_1", label = "组1", choices = c("", unique(df$LOCATION))),
           selectInput(inputId = "site_2", label = "组2", choices = c("", unique(df$LOCATION))),
           selectInput(inputId = "site_3", label = "组3", choices = c("", unique(df$LOCATION))),
           selectInput(inputId = "site_4", label = "组4", choices = c("", unique(df$LOCATION))),
           selectInput(inputId = "site_5", label = "组5", choices = c("", unique(df$LOCATION))),
           selectInput(inputId = "site_6", label = "组6", choices = c("", unique(df$LOCATION)))
    ),
    column(4,
           h4("SELECT DEPTH"),
           selectInput(inputId = "depth_1", label = "组1", choices = unique(df_tidy$depth)),
           selectInput(inputId = "depth_2", label = "组2", choices = unique(df_tidy$depth)),
           selectInput(inputId = "depth_3", label = "组3", choices = unique(df_tidy$depth)),
           selectInput(inputId = "depth_4", label = "组4", choices = unique(df_tidy$depth)),
           selectInput(inputId = "depth_5", label = "组5", choices = unique(df_tidy$depth)),
           selectInput(inputId = "depth_6", label = "组6", choices = unique(df_tidy$depth))
    )
  )
)

3. server.R #

重构逻辑，统一处理用户选择的多组参数，按「站点+深度」组合映射图例：

server <- function(input, output) {
  
  # 收集用户选择的有效组合（排除未选择的空值）
  selected_combinations <- reactive({
    # 构建6组选择的列表
    choices <- list(
      list(site = input$site_1, depth = input$depth_1),
      list(site = input$site_2, depth = input$depth_2),
      list(site = input$site_3, depth = input$depth_3),
      list(site = input$site_4, depth = input$depth_4),
      list(site = input$site_5, depth = input$depth_5),
      list(site = input$site_6, depth = input$depth_6)
    )
    # 过滤掉未选择站点的组合
    Filter(function(x) x$site != "", choices)
  })
  
  # 筛选对应的数据
  filtered_data <- reactive({
    req(selected_combinations())
    
    # 把选择的组合转换成筛选条件
    purrr::map_dfr(selected_combinations(), function(comb) {
      df_tidy %>%
        filter(LOCATION == comb$site, depth == comb$depth) %>%
        mutate(legend_label = paste(comb$site, comb$depth, sep = " - "))
    })
  })
  
  # 绘制图表
  output$Plot <- renderPlot({
    req(filtered_data())
    
    ggplot(filtered_data(), aes(x = DATE, y = moisture, colour = legend_label)) +
      geom_line() +
      xlim(input$mindate, input$maxdate) +
      labs(colour = "站点-深度") +
      theme_light()
  })
  
}

# 运行应用
shinyApp(ui = ui, server = server)

关键优化点 #

1. Tidy数据格式：将宽表转长表后，所有深度数据统一存储，避免重复处理多列
2. 图例绑定组合：用paste(站点, 深度)生成唯一图例标签，确保每个「站点+深度」组合有独立的颜色和图例项
3. 简化响应式逻辑：用列表收集用户选择，统一过滤有效组合，避免创建多个冗余的filtered_data对象
4. 动态过滤数据：自动排除未选择站点的组合，避免空数据绘图报错

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