如何在Shiny中使用不同模块的输入完成数据子集筛选

核心问题点 #

• dateSelectServer返回列表时错误使用赋值符<-，未给列表元素命名，导致下游模块无法通过$min_date、$max_date获取对应响应式值
• dateRangeInput默认起止日期调用了不存在的数据集arise_app，与实际测试数据集test_app不符
• 测试打印响应式值时未执行响应式调用，直接打印date_range只会输出列表结构，不会返回选中的日期值
• 代码依赖的ymd、infoBoxOutput、filter等函数需要提前加载对应依赖包

修复后可运行完整代码 #

# 加载依赖包
library(shiny)
library(lubridate)
library(shinydashboard)
library(dplyr)

# 测试数据
test_app <- structure(list(BMI = c(36, 32, 25, 35, 25, 30, 39, 44, 38, 24
), prosthesis = c("SIGMA", "SIGMA", "ATTUNE", "ATTUNE", "ATTUNE", 
"SIGMA", "ATTUNE", "ATTUNE", "SIGMA", "SIGMA"), op_duration = structure(c(59, 
60, 121, 63, 73, 64, 81, 60, 60, 65), class = "difftime", units = "mins"), 
    year_m = structure(c(18262, 18262, 18322, 18262, 18262, 18262, 
    18262, 18262, 18293, 18293), class = "Date")), row.names = c(NA, 
-10L), class = c("tbl_df", "tbl", "data.frame"))

# 日期选择模块UI
dateSelectUI <- function(id){
  tagList(dateRangeInput(NS(id, "dateRange"), "Dates", 
                         start = min(ymd(test_app$year_m)),
                         end = max(ymd(test_app$year_m)),
                         format = "dd-mm-yyyy")
  )
}

# 日期选择模块服务端
dateSelectServer <- function(id){
  moduleServer(id, function(input, output, session){
    return(
      list(
        min_date = reactive({input$dateRange[1]}),
        max_date = reactive({input$dateRange[2]})
      )
    ) 
  })
}

# 汇总展示模块UI
demoSummaryUI <- function(id){
  tagList(infoBoxOutput(NS(id, "numbers"), width = 6),
          infoBoxOutput(NS(id, "period"), width = 6),
          verbatimTextOutput(NS(id, "verbatim"))
  )
}

# 汇总展示模块服务端
demoSummaryServer <- function(id, dataset, date_range){
  moduleServer(id, function(input, output, session){
    # 测试打印选中日期
    output$verbatim <- renderPrint({
      paste("起始日期：", date_range$min_date(), " 结束日期：", date_range$max_date())
    })
    
    # 日期过滤逻辑示例
    filtered_data <- reactive({
      dataset %>%
        filter(year_m >= date_range$min_date() & year_m <= date_range$max_date())
    })
    
    # 信息框示例
    output$numbers <- renderInfoBox({
      infoBox("筛选后数据量", nrow(filtered_data()), icon = icon("list"))
    })
    
    output$period <- renderInfoBox({
      infoBox("选中日期跨度", paste0(as.numeric(date_range$max_date() - date_range$min_date()), "天"), icon = icon("calendar"))
    })
  })
}

# 主应用UI
ui <- fluidPage(
  dateSelectUI("demoDate"),
  demoSummaryUI("Demo")
)

# 主应用服务端
server <- function(input, output, session){
  demo_date <- dateSelectServer("demoDate")
  demoSummaryServer("Demo",
                    dataset = test_app,
                    date_range = demo_date)
}

shinyApp(ui, server)

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