當使用用戶輸入響應式更新 Shiny 中的表時，如何對 rhandsontable 中的所有列求和？

Question

我一直在嘗試應用Shiny 后應用程序中的解決方案：如何按列獲取總和以適應我的情況，但無法使其正常工作。 我只想在每次用戶更改其上方的字段之一時重新計算表格底部的“總計”行，但是在取消注釋下面注釋掉的observe()時我收到一條錯誤消息代碼。 這個observe()是我嘗試實現上述帖子中提供的解決方案。 我在這里做錯了什么，更一般地說，在 rhandsontable 中對列求和的正確方法是什么？

代碼：

library(rhandsontable)
library(shiny)

rowNames <- c('Hello A','Hello B','Hello C','Hello D','Total') 
data <- data.frame(row.names = rowNames,'Col 1' = c(10,20,-5,18,43),check.names = FALSE)

ui <- fluidPage(br(),
  rHandsontableOutput('hottable'),br(),
  actionButton("addCol", "Add column"),br(),br(),
  uiOutput("delCol_step1") 
)

server <- function(input, output) {
  uiTable <- reactiveVal(data)
  observeEvent(input$hottable,{uiTable(hot_to_r(input$hottable))})

  output$hottable <- renderRHandsontable({
    rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)
  })
  
  # observe({
  #   req(input$hottable)
  #   DF <- hot_to_r(input$hottable)
  #   DF[setdiff(rowNames, "Total"),]
  #   DF["Total",] <- colSums(DF[setdiff(rowNames, "Total"),], na.rm = TRUE)
  #   uiTable(DF)
  # })
  
  observeEvent(input$addCol, {
    newCol2 <- data.frame(c(10,20,-5,18,43))
    names(newCol2) <- paste("Col", ncol(hot_to_r(input$hottable)) + 1)
    uiTable(cbind(uiTable(), newCol2))
  })
  
  output$delCol_step1 <- 
    renderUI(
      selectInput(
        "delCol_step2", 
        label = "Select column to delete:",
        choices = colnames(hot_to_r(input$hottable)),
        selected = "",
        multiple = TRUE
      )
    )
  
  observeEvent(input$delCol_step2,{
    tmp <- uiTable()
    if(ncol(tmp) > 1){             
      delCol <- input$delCol_step2    
      tmp <-tmp[,!(names(tmp) %in% delCol),drop=FALSE]  
      newNames <- sprintf("Col %d",seq(1:ncol(tmp)))  
      names(tmp) <- newNames                              
      uiTable(tmp)                                      
    }
  })
}

shinyApp(ui,server)

Answer 1

問題是colSums不適用於具有單列的數據框。 在這種情況下你必須使用sum 。 把這個放在服務器上。

observe({
      req(input$hottable)

      DF <- hot_to_r(input$hottable)
      if(ncol(DF)==1){
        DF["Total",] <- sum(DF[setdiff(rowNames, "Total"),], na.rm = TRUE)
      } else {
        DF["Total",] <- colSums(DF[setdiff(rowNames, "Total"),], na.rm = TRUE)
      }
      
      uiTable(DF)
    })

Answer 2

不幸的是@MichaelDewar 的回答不正確。

colSums可以很好地處理單列data.frame ：

colSums(data.frame(1:10))

但是，在索引data.frame時，您必須確保避免刪除維度 - 因為colSums不適用於 vectors 。 只需使用drop = FALSE即可實現：

library(rhandsontable)
library(shiny)

rowNames <- c('Hello A','Hello B','Hello C','Hello D','Total') 
data <- data.frame(row.names = rowNames,'Col 1' = c(10,20,-5,18,43),check.names = FALSE)

ui <- fluidPage(br(),
                rHandsontableOutput('hottable'),br(),
                actionButton("addCol", "Add column"),br(),br(),
                uiOutput("delCol_step1") 
)

server <- function(input, output) {
  uiTable <- reactiveVal(data)
  observeEvent(input$hottable,{uiTable(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({
    rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)
  })
  
  observe({
    req(input$hottable)
    DF <- hot_to_r(input$hottable)
    DF[setdiff(rowNames, "Total"),]
    DF["Total",] <- colSums(DF[setdiff(rowNames, "Total"),, drop = FALSE], na.rm = TRUE)
    uiTable(DF)
  })
  
  observeEvent(input$addCol, {
    newCol2 <- data.frame(c(10,20,-5,18,43))
    names(newCol2) <- paste("Col", ncol(hot_to_r(input$hottable)) + 1)
    uiTable(cbind(uiTable(), newCol2))
  })
  
  output$delCol_step1 <- 
    renderUI(
      selectInput(
        "delCol_step2", 
        label = "Select column to delete:",
        choices = colnames(hot_to_r(input$hottable)),
        selected = "",
        multiple = TRUE
      )
    )
  
  observeEvent(input$delCol_step2,{
    tmp <- uiTable()
    if(ncol(tmp) > 1){             
      delCol <- input$delCol_step2    
      tmp <-tmp[,!(names(tmp) %in% delCol),drop=FALSE]  
      newNames <- sprintf("Col %d",seq(1:ncol(tmp)))  
      names(tmp) <- newNames                              
      uiTable(tmp)                                      
    }
  })
}

shinyApp(ui,server)

請參閱?`[` 、 這篇相關文章或我之前在此處的回答。