Shiny应用中实现选表后动态加载列名用于比值计算

修改思路 #

• 移除原代码中监听input$files更新num1和den1的逻辑，列名依赖的是选中的表格而非文件上传事件
• 创建selected_data响应式对象，实时获取当前选中的表格数据
• 监听input$selected_table的变化，结合已加载的表格列表动态更新分子、分母的下拉选项
• 补充比值计算与结果展示的逻辑

修改后的完整代码 #

library(DT)
library(shiny)
library(data.table)

# 创建测试CSV文件 -------------------------------------------------------
DF1 <- data.frame(x = 1:3, y = 2:4)
DF2 <- data.frame(x = 4:6, y = 5:7)
DF3 <- data.frame(x = 7:9, y = 8:10)
DF4 <- data.frame(x = 10:12, y = 11:13)

mapply(
  write.csv,
  x = list(DF1, DF2, DF3, DF4),
  file = list("DF1.csv", "DF2.csv", "DF3.csv", "DF4.csv"),
  row.names = FALSE
)

# Shiny应用 ---------------------------------------------------------------
ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    fileInput(
      "files",
      "选择文件",
      multiple = TRUE,
      accept = c(
        "text/csv",
        "text/comma-separated-values,text/plain",
        ".dp_txt",
        ".is_txt"
      )
    ),

    selectizeInput(
      inputId = "selected_table",
      label = "选择表格",
      choices = NULL,
      selected = NULL,
      multiple = FALSE
    ),

    selectizeInput("num1", "分子列", 
                   choices = NULL, 
                   selected = NULL, 
                   multiple = FALSE
    ),
    
    selectizeInput("den1", "分母列", 
                   choices = NULL, 
                   selected = NULL, 
                   multiple = FALSE
    ),
  ),
  mainPanel(
    DTOutput("table"),
    DTOutput("ratio_table")
  )
))

server <- function(input, output, session) {
  # 加载所有上传的表格为列表
  table_list <- reactive({
    req(input$files)
    setNames(lapply(input$files$datapath, fread), input$files$name)
  })
  
  # 更新表格选择下拉框
  observeEvent(input$files, {
    freezeReactiveValue(input, "selected_table")
    updateSelectizeInput(session,
                         inputId = "selected_table",
                         choices = input$files$name,
                         server = TRUE)
  })
  
  # 获取当前选中的表格数据
  selected_data <- reactive({
    req(table_list(), input$selected_table)
    table_list()[[input$selected_table]]
  })
  
  # 根据选中的表格更新分子、分母的列选项
  observeEvent(input$selected_table, {
    req(selected_data())
    col_names <- names(selected_data())
    
    freezeReactiveValue(input, "num1")
    updateSelectizeInput(session,
                         inputId = "num1",
                         choices = col_names,
                         server = TRUE)
    
    freezeReactiveValue(input, "den1")
    updateSelectizeInput(session,
                         inputId = "den1",
                         choices = col_names,
                         server = TRUE)
  })
  
  # 展示选中的原始表格
  output$table <- renderDT({
    req(selected_data())
    selected_data()
  }, server = FALSE)
  
  # 计算并展示比值结果
  output$ratio_table <- renderDT({
    req(selected_data(), input$num1, input$den1)
    data <- selected_data()
    # 计算比值，避免除以0的情况
    data$ratio <- ifelse(data[[input$den1]] == 0, NA, data[[input$num1]] / data[[input$den1]])
    data
  }, server = FALSE)
}

shinyApp(ui, server)

关键修改说明 #

1. selected_data()响应式对象：依赖已加载的表格列表和选中的表格名称，实时返回当前选中的完整表格数据，确保列名获取的准确性。
2. 列选项更新逻辑：监听input$selected_table的变化，当用户切换表格时，自动提取当前表格的列名，更新分子、分母的下拉选项。
3. 比值计算处理：添加了除以0的异常判断，避免计算报错，同时将比值作为新列添加到表格中展示。

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