How to sum all colums in rhandsontable when reactively updating the table in Shiny with user inputs?-CodePudding

I've been trying to apply the solution in post Shiny App: How to get total sum by column to my situation but am unable to get it to work. I simply want the "Total" row at the bottom of the table to recalculate every time the user changes one of the fields above it, but I get an error message when un-commenting the observe() that is commented-out in the below code. This observe() is my attempt to implement the solution offered in the aforementioned post. What am I doing wrong here, and more generally what is the proper method of summing a column in rhandsontable?

Code:

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)

CodePudding user response：

Unfortunately @MichaelDewar's answer is not correct.

colSums can handle single column data.frames just fine:

colSums(data.frame(1:10))

However, when indexing data.frames you have to make sure to avoid dimensions being dropped - as colSums does not work on vectors. Just use drop = FALSE to achive this:

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)

Please see ?`[`, this related article or my earlier answer here.

CodePudding user response：

The problem is that colSums doesn't work for a data frame with a single column. You have to use sum in that case. Put this in the server.

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