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