如何通过点击R shiny中的一个操作按钮,为用户输入React性地生成额外的rhandsontable表?

nue99wik  于 2022-12-20  发布在  React
关注(0)|答案(1)|浏览(120)

我已经在R Shiny中使用操作按钮向一系列链接的rhandsontable表中添加列。然而,现在,我尝试弄清楚如何通过单击操作按钮来生成额外的rhandsontable表模板。这可能吗?每个添加的表都需要独立于其他表。在允许用户将值输入和存储到独立于其它表的所添加的表中的意义上,尽管所添加的“空白”新表可以共享公共基础模板表单。显示在下面的代码(uiTable1hottable1)永远不能被用户删除。下面的代码显示了我启动的内容,但操作按钮还没有工作。
代码:

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)
w7t8yxp5

w7t8yxp51#

下面的内容似乎很有用,并附有大量的解释性评论:

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)

相关问题