How to subset a dynamically rendered list in R Shiny? - r

Question

The code posted at the bottom allows the user to dynamically add and delete tables. You'll see when adding tables that their column headers are automatically sequentially numbered "Col 1", "Col 2", etc. Remaining tables are automatically renumbered after any table is deleted.
How would I capture, in a vector, the nested names of all of these tables ("Col 1", "Col 2", for example)? As shown in the illustration below, a screenshot of the R studio console when running the code and clicking the "Add table" button once. I use print(tables_list) to see the contents of the list. I just don't know how to move around that dynamic list.
I'm having trouble understanding how to subset a dynamic list like this one. I also wonder if I'll be able to reference other values in the list by referring to these element names of Col 1, Col 2, etc.
Illustration:
Code:
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)})
observe({
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])
}
print(tables_list) ### PRINT ###
})
}
shinyApp(ui, server)

Answer 1

We can create the needed vector in the observe() call and pass it to updateSelectizeInput if you need it somewhere else you could pass it to a reactiveVal instead:
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")
)
),
br(),
selectizeInput(inputId = "select_deletion",
label = "Select deletion",
choices = NULL,
selected = NULL,
multiple = TRUE)
)
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)})
observe({
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]
table_names <- paste("Col", cumsum_table_lengths)
for(i in seq_along(cumsum_table_lengths)){
names(uiTbl[[names(cumsum_table_lengths[i])]]) <- table_names[i]
}
# print(tables_list) ### PRINT ###
# browser() ### use browser() to analyse your observer
freezeReactiveValue(input, "select_deletion")
updateSelectizeInput(session, inputId = "select_deletion", choices = table_names, selected = NULL)
})
}
shinyApp(ui, server)
PS: Please remember to avoid <<- and renderUI wherever you can.

Answer 2

Below is one long-winded way of doing this (also using dplyr for a mutate()), by reverting back to my familiarity with data frames. See the additions of "tmp" objects in the below which replaces the last observe() in the OP. Note that rather than using print() to see the vector as I did in my OP, I send it to the global environment via "tmp.R" for reviewing more complicated input sequences. I hope better solutions to this are posted! I'd like to learn how to easily navigate nested lists. Also, I leave in, but comment-out, object "test1" which is a good way to view the contents of the list neatly organized as a dataframe.
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])
}
tmp <- data.frame(cumsum_table_lengths)
tmp <- data.frame(origTbl = rownames(tmp), tblCnt = tmp[,1])
tmp <- tmp %>% mutate(tblCode = paste("Col",tblCnt))
tmp <- tmp[,3]
tmp.R <<- tmp
# test1 <- as.data.frame(do.call(cbind, tables_list)) ## this is also useful
})