如何在R Shiny中点击动作按钮动态生成独立rhandsontable表格

问题描述 #

原本实现了为rhandsontable表格添加列的功能，现在需要修改为：

• 点击动作按钮生成独立的rhandsontable表格模板，每个新增表格可独立输入并存储数据
• 空白新表共用基础模板结构
• 基础表（uiTable1、hottable1）不可被用户删除
• 原代码中动作按钮暂未生效，需要修复

修正后的完整代码 #

library(rhandsontable)
library(shiny)

# 基础模板数据
rowNames1 <- c('A','B','C','Sum') 
base_template <- data.frame(row.names = rowNames1, 'Col 1' = c(1,1,0,2), check.names = FALSE)

ui <- fluidPage(
  br(),
  # 动态渲染所有表格的容器
  uiOutput("tables_container"),
  br(),
  actionButton("addTbl", "Add table"),
  br()
)

server <- function(input, output) {
  # 用reactiveVal存储所有表格数据，基础表作为初始项
  all_tables <- reactiveVal(list(
    "base_table" = base_template
  ))
  
  # 处理添加表格按钮点击事件
  observeEvent(input$addTbl, {
    current_tables <- all_tables()
    # 生成新表格的唯一ID
    new_table_id <- paste0("table_", length(current_tables))
    # 添加新的模板表格
    current_tables[[new_table_id]] <- base_template
    all_tables(current_tables)
  })
  
  # 动态渲染所有表格
  output$tables_container <- renderUI({
    table_outputs <- lapply(names(all_tables()), function(table_id) {
      tagList(
        # 基础表显示固定标题，新增表显示带ID的标题
        if(table_id == "base_table"){
          h4("基础表格（不可删除）")
        } else {
          h4(paste("新增表格", gsub("table_", "", table_id)))
        },
        rHandsontableOutput(paste0("hottable_", table_id)),
        br()
      )
    })
    do.call(tagList, table_outputs)
  })
  
  # 为每个表格生成render和观察者
  observe({
    lapply(names(all_tables()), function(table_id) {
      local({
        current_id <- table_id
        output_name <- paste0("hottable_", current_id)
        
        # 渲染当前表格
        output[[output_name]] <- renderRHandsontable({
          rhandsontable(all_tables()[[current_id]], rowHeaderWidth = 100, useTypes = TRUE)
        })
        
        # 监听表格输入变化，更新数据
        observeEvent(input[[output_name]], {
          updated_data <- hot_to_r(input[[output_name]])
          # 自动计算Sum行
          updated_data["Sum",] <- colSums(updated_data[setdiff(rowNames1, "Sum"), , drop = FALSE], na.rm = TRUE)
          
          # 更新all_tables中的对应表格数据
          current_tables <- all_tables()
          current_tables[[current_id]] <- updated_data
          all_tables(current_tables)
        })
      })
    })
  })
}

shinyApp(ui,server)

关键实现说明 #

• 统一管理表格数据：用reactiveVal存储一个表格列表，基础表作为初始元素，新增表格直接追加到列表中，确保所有表格数据独立存储
• 动态UI渲染：通过renderUI动态生成所有表格的输出组件，避免在初始UI中硬编码
• 独立处理每个表格：用lapply配合local为每个表格创建独立的渲染逻辑和输入监听，保证每个表格的修改互不干扰
• 自动求和逻辑：每个表格的输入变化时，自动计算Sum行的列总和，同步更新数据
• 基础表保护：通过判断表格ID，给基础表标记不可删除的提示，且不会被添加/删除逻辑影响

内容的提问来源于stack exchange，提问作者Village.Idyot