rshinyshiny-reactivityaction-button

How to track the net number of action button clicks in order to correctly label a series of rendered tables with their count?

In running the reduced code posted at the bottom, the user generates a series of rhandsontable tables by clicking the button "Add table" and deletes added tables by clicking on the corresponding "Delete" buttons underneath each table. The base or first table can never be deleted. As illustrated below, I'd like each table's column header to reflect its count. Two approaches that come to mind are either (a) count the number of "net" actionButton() clicks (number of clicks of "Add table" minus number of clicks of any of the "Delete" buttons) and insert this resulting value into the header of each table, or (b) count the number of tables. I prefer (b) but I don't know how to do either. Any recommendations?

Illustration:

enter image description here

Code:

library(rhandsontable)
library(shiny)

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

ui <- fluidPage(
  br(),
  actionButton("addTbl","Add table"),
  br(),br(),
  tags$div(id = "placeholder",        
           tags$div(
             style = "display: inline-block", 
             rHandsontableOutput("hottable1")
           )
  )
)

server <- function(input, output) {
  uiTbl1 <- reactiveValues(base = data1)
  rv <- reactiveValues()                
  
  observeEvent(input$hottable1, {uiTbl1$base <- hot_to_r(input$hottable1)})
  
  output$hottable1 <- renderRHandsontable({rhandsontable(uiTbl1$base, useTypes = TRUE)})
  
  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
    
    insertUI(
      selector = "#placeholder",
      ui = tags$div(
        id = divID,
        style = "display:inline-block;",
        rHandsontableOutput(dtID), 
        actionButton(btnID, "Delete", class = "pull-left btn btn-danger"),
      )
    )
    
    output[[dtID]] <- renderRHandsontable({
      req(uiTbl1[[paste0(divID,"tbl")]])
      rhandsontable(uiTbl1[[paste0(divID,"tbl")]], useTypes = TRUE)
    })
    
    observeEvent(input[[btnID]],{
      removeUI(selector = paste0("#", divID))
      rv[[divID]] <- NULL
      uiTbl1[[paste0(divID,"tbl")]] <- NULL
      },
      ignoreInit = TRUE,
      once = TRUE
    )
  })
}

shinyApp(ui, server)
Solution

  • We need another obersver to modify the colnames in uiTbl1. Please check the following:

    library(shiny)
library(rhandsontable)

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

ui <- fluidPage(
  br(),
  actionButton("addTbl","Add table"),
  br(),br(),
  tags$div(id = "placeholder",        
           tags$div(
             style = "display: inline-block", 
             rHandsontableOutput("hottable1")
           )
  )
)

server <- function(input, output, session) {
  uiTbl <- reactiveValues(div_01_tbl = data1)
  rv <- reactiveValues()                
  
  observeEvent(input$hottable1, {uiTbl$div_01_tbl <- hot_to_r(input$hottable1)})
  
  output$hottable1 <- renderRHandsontable({rhandsontable(uiTbl$div_01_tbl, useTypes = TRUE)})
  
  observeEvent(input$addTbl, {
    # divID <- gsub("\\.", "", format(Sys.time(), "%H%M%OS3")) # system time at add used as table ID
    divID <- paste0("div_", sprintf("%02d", input$addTbl+1))
    dtID <- paste0(divID, "_DT")
    btnID <- paste0(divID, "_rmv")
    uiTbl[[paste0(divID,"_tbl")]] <- data1 # captures initial dataframe values
    
    insertUI(
      selector = "#placeholder",
      ui = tags$div(
        id = divID,
        style = "display:inline-block;",
        rHandsontableOutput(dtID), 
        actionButton(btnID, "Delete", class = "pull-left btn btn-danger"),
      )
    )
    
    output[[dtID]] <- renderRHandsontable({
      req(uiTbl[[paste0(divID,"_tbl")]])
      rhandsontable(uiTbl[[paste0(divID,"_tbl")]], useTypes = TRUE)
    })
    
    observeEvent(input[[dtID]], {uiTbl[[paste0(divID,"_tbl")]] <- hot_to_r(input[[dtID]])})
    
    observeEvent(input[[btnID]],{
      removeUI(selector = paste0("#", divID))
      rv[[divID]] <- NULL
      uiTbl[[paste0(divID,"_tbl")]] <- NULL
    },
    ignoreInit = TRUE,
    once = TRUE
    )
  })
  
  observe({
    tables_list <- reactiveValuesToList(uiTbl)
    tables_list <- tables_list[order(names(tables_list))]
    table_lengths <- lengths(tables_list)
    cumsum_table_lengths <- cumsum(table_lengths)[table_lengths != 0L]
    
    for(i in seq_along(cumsum_table_lengths)){
      names(uiTbl[[names(cumsum_table_lengths[i])]]) <- paste("Col", cumsum_table_lengths[i])
    }
  })
}

shinyApp(ui, server)

    result