1

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)
Village.Idyot
  • 1,359
  • 2
  • 8

2 Answers2

1

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

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Very elegant. I noticed that if I enter values into a table, those values are correctly preserved as more tables are added. However, if I delete one of the tables that isn't the last table added (say I delete table "Col 2" when I have also added "Col 3" and "Col 4" with manual inputs into "Col 3" and "Col 4"), manual inputs into non-deleted columns are lost ("Col 3" and "Col 4" in this example). How can manual inputs into tables be preserved when prior tables are deleted? – Village.Idyot Dec 22 '22 at 12:29
  • 1
    @Village.Idyot the issue was that there is no code to update the added tables in `uiTbl` on user input. For the first table you are doing this via `hot_to_r`. Accordingly, once the added tables are re-rendered with a new colname the user input is lost. I added another observer to update the added tables in `uiTbl` on user input - please see my edit. – ismirsehregal Dec 22 '22 at 13:49
  • 1
    I should have known about `hot_to_r` for added tables, I stripped them out to simplify the code for Stack and then forgot about them. Sorry about that! – Village.Idyot Dec 22 '22 at 14:17
0

Minor addition to ismirsehregal's answer above, to correctly number tables when the number exceeds 9:

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) # mod
  rv <- reactiveValues()                
  
  observeEvent(input$hottable1, {uiTbl$div_01_tbl <- hot_to_r(input$hottable1)}) # mod
  
  output$hottable1 <- renderRHandsontable({rhandsontable(uiTbl$div_01_tbl, useTypes = TRUE)}) # mod
  
  observeEvent(input$addTbl, {
    divID <- paste0("div_", if(input$addTbl+1 < 10){"0"},input$addTbl+1) # mod
    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)
Village.Idyot
  • 1,359
  • 2
  • 8
  • 1
    FYI just modified my answer regarding the leading zero using `sprintf`, which is more convenient compared to the `if` construct. Cheers – ismirsehregal Jan 05 '23 at 10:53