如何通过单击 R shiny 中的操作按钮为用户输入反应生成额外的 rhandsontable 表？

Question

我一直在使用操作按钮将列添加到 R Shiny 中一系列链接的 rhandsontable 表中。但是，现在，我正在尝试弄清楚如何通过单击操作按钮来生成额外的 rhandsontable 表模板。这可能吗？每个添加的表都需要独立于其他表，在允许用户输入和存储值到独立于其他表的添加表的意义上，尽管添加的“空白”新表可以共享一个公共基础模板形式。下面代码（uiTable1、hottable1）中显示的“基表”永远不能被用户删除。下面的代码显示了我开始的内容，但操作按钮还不起作用。

代码：

library(rhandsontable)
library(shiny)

rowNames1 <- c('A','B','C','Sum') 
data1 <- data.frame(row.names = rowNames1, 'Col 1' = c(1,1,0,2), check.names = FALSE)

ui <- fluidPage(br(),
  rHandsontableOutput('hottable1'),br(),    # generates base table, can never be deleted by user
  actionButton("addTbl", "Add table"),br()  # adds table
)

server <- function(input, output) {
  uiTable1 <- reactiveVal(data1)            # base table can never be deleted by user
  
  # records changes to base table and will need same for added tables:
  observeEvent(input$hottable1,{uiTable1(hot_to_r(input$hottable1))})
  output$hottable1 <- renderRHandsontable({
    rhandsontable(uiTable1(),rowHeaderWidth = 100, useTypes = TRUE)
  })
  
  # counts nbr of tables added by user clicks of addTbl action button:
  cntAdds = reactiveVal(0)
  observeEvent(input$addTbl,{
    cntAdds(cntAdds()+1) 
  })
  
  # adds column summation to last row of table, will need for all added tables too:
  observe({
    req(input$hottable1)
    DF <- hot_to_r(input$hottable1)
    DF[setdiff(rowNames1, "Sum"),]
    DF["Sum",] <- colSums(DF[setdiff(rowNames1, "Sum"),, drop = FALSE], na.rm = TRUE)
    uiTable1(DF)
  })

  # Pending: observer adds new table
  # observeEvent(input$addTbl, {
  #   newTbl1 <- data.frame(c(1,1,0,1)) 
  #   names(newTbl1) <- paste("Tbl", hot_to_r(cntAdds()))
  #   uiTable1(cbind(uiTable1(), newTbl1))
  # })
}

shinyApp(ui,server)

Answer 1

下面的内容似乎可以解决问题，并提供了大量解释性的 cmet：

library(rhandsontable)
library(shiny)

rowNames1 <- c("A", "B", "C", "Sum")
data1 <- data.frame(row.names = rowNames1, "Col 1" = c(1, 1, 0, 2), check.names = FALSE)

ui <- fluidPage(
  rHandsontableOutput("hottable1"),       # undeletable base table
  actionButton("addTbl", "Add table"),    # adds new table
  tags$div(id = "placeholder")            # using div for insertUI selector is more stable
)

server <- function(input, output) {
  uiTbl1 <- reactiveValues(base = data1)  # undeletable base table
  rv <- reactiveValues()                  # used for dynamic table add/removal
  
  # records changes to base table:
  observeEvent(input$hottable1, {
    uiTbl1$base <- hot_to_r(input$hottable1)
  })
  
  # used to render changed base table:
  output$hottable1 <- renderRHandsontable({
    rhandsontable(uiTbl1$base, rowHeaderWidth = 100, useTypes = TRUE)
  })
  
  # adds column sum to last row of base table (same function for added tables further down):
  observe({
    req(input$hottable1)
    DF <- hot_to_r(input$hottable1)
    DF[setdiff(rowNames1, "Sum"), ]
    DF["Sum", ] <- colSums(DF[setdiff(rowNames1, "Sum"), , drop = FALSE], na.rm = TRUE)
    uiTbl1$base <- DF
  })
  
  # dynamically add/remove tables:
  observeEvent(input$addTbl, {
    divID <- gsub("\.", "", format(Sys.time(), "%H%M%OS3")) # system time at add used as table ID
    dtID <- paste0(divID, "DT")
    btnID <- paste0(divID, "rmv")
    uiTbl1[[paste0(divID,"tbl")]] <- data1 # captures initial dataframe values
    
    # renders table delete button and added table in UI:
    insertUI(
      selector = "#placeholder",
      ui = tags$div(
        id = divID,
        actionButton(btnID, "Remove table", class = "pull-left btn btn-danger"),
        rHandsontableOutput(dtID),
        hr()
      )
    )
    # server section for added table:
    output[[dtID]] <- renderRHandsontable({
      req(uiTbl1[[paste0(divID,"tbl")]])
      rhandsontable(uiTbl1[[paste0(divID,"tbl")]], rowHeaderWidth = 100, useTypes = TRUE)
    })
    
    # adds column summation to last row of added table:
    observeEvent(input[[dtID]], {
      DF <- hot_to_r(input[[dtID]])
      DF[setdiff(rowNames1, "Sum"), ]
      DF["Sum", ] <- colSums(DF[setdiff(rowNames1, "Sum"), , drop = FALSE], na.rm = TRUE)
      uiTbl1[[paste0(divID,"tbl")]] <- DF # update the table with the sum
    })
    
    # remove table from the app when remove button clicked:
    observeEvent(input[[btnID]],{
      removeUI(selector = paste0("#", divID))
      rv[[divID]] <- NULL
      uiTbl1[[paste0(divID,"tbl")]] <- NULL
      },
      ignoreInit = TRUE,
      once = TRUE
    )
  })
  
}

shinyApp(ui, server)