如何通过用户输入更新Shiny中rhandsontable的行列数及列名？

修改后的完整代码 #

library(rhandsontable)
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  skin = "blue",
  dashboardHeader(title = "PVA", titleWidth = 450),
  dashboardSidebar(id = "", width = 450,
                   sidebarMenu(
                     menuItem("Welcome", tabName = "menuWelcome", icon = shiny::icon("face-smile")),
                     menuItem("Stocking", tabName = "menuStocking", icon = shiny::icon("fish")),
                     menuItem("Review", tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart"))
                   )),
  dashboardBody(
    tabItems(
      tabItem(tabName = "menuWelcome",
              valueBox("Population Viability Analysis", "Welcome", icon = shiny::icon("face-smile"), width = 8)),
      tabItem(tabName = "menuStocking",
              fluidRow(valueBox("Proposed Stocking", "Enter Data", icon = shiny::icon("fish"), width = 8)),
              fluidRow(box(sliderInput("n.stockyrs", "Number years to stock", value = 5, min = 0, max = 25, step = 1), width = 8)),
              fluidRow(box(sliderInput("n.stockage", "Number ages to stock", value = 1, min = 0, max = 5, step = 1), width = 8)),
              fluidRow(box(title = "Enter data", status = "primary", solidHeader = TRUE, width = 8, rHandsontableOutput("hot")))),
      tabItem(tabName = "menuReview",
              fluidRow(valueBox("Review", "Review Input", icon = shiny::icon("fish"), width = 8)),
              fluidRow(box(title = "Stocking Data", status = "primary", solidHeader = TRUE, width = 8, rHandsontableOutput("rvw.hot")))
    )
  )
))

server <- function(input, output, session) {
  # 初始化响应式数据，匹配滑块默认设置
  values <- reactiveValues(
    data = data.frame(
      age = 1,
      month = 5,
      setNames(lapply(1:5, function(x) 250000), sprintf("yr%d", 1:5))
    )
  )
  
  # 监听滑块变化，动态调整表格行列
  observeEvent(c(input$n.stockyrs, input$n.stockage), {
    req(input$n.stockyrs, input$n.stockage)
    
    # 1. 处理列：动态生成yr开头的列名
    target_cols <- c("age", "month", sprintf("yr%d", 1:input$n.stockyrs))
    current_cols <- colnames(values$data)
    
    # 新增列：填充默认值0
    new_cols <- setdiff(target_cols, current_cols)
    if(length(new_cols) > 0) {
      values$data[new_cols] <- 0
    }
    
    # 删除多余列：仅保留目标列
    values$data <- values$data[, target_cols, drop = FALSE]
    
    # 2. 处理行：调整行数
    target_rows <- input$n.stockage
    current_rows <- nrow(values$data)
    
    if(target_rows > current_rows) {
      # 新增行：age自动递增，month默认5，放养数默认0
      new_ages <- (max(values$data$age) + 1):(max(values$data$age) + (target_rows - current_rows))
      new_rows <- data.frame(
        age = new_ages,
        month = 5,
        setNames(lapply(1:input$n.stockyrs, function(x) 0), sprintf("yr%d", 1:input$n.stockyrs))
      )
      values$data <- rbind(values$data, new_rows)
    } else if(target_rows < current_rows) {
      # 删除多余行：保留前target_rows行
      values$data <- values$data[1:target_rows, , drop = FALSE]
    }
  })
  
  # 渲染可编辑表格（Stocking标签）
  output$hot <- renderRHandsontable({
    rhandsontable(values$data)
  })
  
  # 监听表格编辑，更新响应式数据
  observeEvent(input$hot, {
    values$data <- hot_to_r(input$hot)
  })
  
  # 渲染只读表格（Review标签）
  output$rvw.hot <- renderRHandsontable({
    rhandsontable(values$data, readOnly = TRUE)
  })
  
  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

关键实现说明 #

• 动态列名生成：用sprintf("yr%d", 1:input$n.stockyrs)自动生成yr1到yrN的列名，结合集合运算和列索引实现列的增减。
• 行列调整逻辑：同步监听两个滑块的变化，优先处理列再处理行：
  • 新增列时填充默认值0，删除列时仅保留目标列；
  • 新增行时age自动递增，month默认设为5，放养数默认0；减少行时直接截断多余行。
• 响应式数据同步：用reactiveValues存储核心表格数据，确保编辑、滑块调整后的内容能实时同步到两个标签页的表格中。
• 优化渲染逻辑：将表格渲染与数据更新操作分离，避免重复渲染，提升应用运行效率。

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