如何优化Shiny表格生成代码 复用响应式变量减少重复逻辑

你之前修改后无法运行的核心原因是：data_subset1()的返回值仅为按「Week、Category」分组聚合后的平均时长结果，其内部定义的Test（过滤后原始数据）、meanTest均为函数局部变量，在data_subset2中无法直接访问。
同时data_subset1和data_subset2的聚合逻辑有差异（前者分组不含date2），因此正确的复用方式是把二者共用的「日期校验+数据过滤」逻辑抽为独立的公共reactive，两个子集各自基于公共过滤结果做自己的聚合处理即可。

修改后完整可运行代码 #

library(shiny)
library(shinythemes)
library(dplyr)

Test <- structure(list(date1 = as.Date(c("2021-11-01")),
                       date2 = as.Date(c("2021-10-22")), 
                       Week = c("Friday"),
                       Category = c("ABC"), 
                       time = c(4),DR1 = c(2),DR2 = c(3)), class = "data.frame",row.names = c(NA, -1L))
ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('daterange'),
                                 downloadButton("dl", "Download")
                               ),
                               mainPanel(
                                 dataTableOutput('table')
                                 
                               )
                             ))
  ))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   min   = min(data()$date1))
    
  })
  
  observe({updateDateRangeInput(session,"daterange1",start = NA, end = NA)})
  
  # 抽离公共的日期校验、数据过滤逻辑
  filtered_data <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    filter(data(), date1 %in% days | date2 %in% days)
  })
  
  data_subset1 <- reactive({
    filtered_data() %>%
      group_by(Week,Category) %>%
      summarize(time=mean(time), .groups = 'drop')
  })
  
  
  data_subset2 <- reactive({
    Test <- filtered_data()
    meanTest <- Test %>%
      group_by(date2,Week, Category) %>%
      summarize(Time=mean(time),.groups = 'drop')
    
    # 避免和R内置rename函数重名，变量名改为rename_cols
    rename_cols <- Test %>%
      select(starts_with("DR")) %>% 
      names() %>%
      paste0("Time-",.)
    
    left_join(meanTest, Test, by = c("date2","Week","Category")) %>%
      mutate(across(starts_with("DR"), ~ Time - .))  %>%
      select(-date1, -Week, -time) %>%
      rename_at(-c(1:3), ~rename_cols)
  })
  
  output$table <- renderDataTable({
    data_subset1()
  })

  
    output$dl <- downloadHandler(
    filename = function() { "data.xlsx"},
    content = function(file) {
    data1<-data_subset1()
    data2<-data_subset2()
    sheets <- mget(ls(pattern = "data"))
    writexl::write_xlsx(sheets, path = file)
    }
  )
  
  
}

shinyApp(ui = ui, server = server)

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