How to subset a dynamically rendered list in R Shiny?

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)

I'm not sure if I understand the question - what is your expected result? — ismirsehregal, Jan 13 '23 at 14:46
I'm trying to output those names (Col 1, Col 2, etc.) into a vector. This is so I can populate the choices for a pending `selectizeInput()`. I was planning on using renderUI under that observer for the `selectizeInput()`. Once I understand how to navigate a list, I'll use the `selectizeInput()` to delete tables. — Village.Idyot, Jan 13 '23 at 15:25
I've been using print(xxx) to try to see how to navigate the dynamic list. No luck yet. For now I just want to see how to send those names (Col 1, Col 2, etc., wherever the user is in the addition/deletion of tables) into a vector. Once I figure out how to navigate the list I hope to be able to carry on with the `selectizeInput()` consolidating the table deletions. — Village.Idyot, Jan 13 '23 at 15:27
You only want the name of the columns? In that case, you could use a function of the apply family: sapply(your_list, \(x) names(x)[[2]]) For each df in your list, you're extracting the name of the second column. — bdbmax, Jan 13 '23 at 15:28
Hi bdbmax, could you please test your suggestion? So far I can't get it to work — Village.Idyot, Jan 13 '23 at 16:32
Sure. This is letting you grab the name of the second columns of a list of dataframes: First create the list: your_list <- list(first_list = data.frame(first_col = c("A", "B", "C"), col_2 = c(1,2,3)), second_list = data.frame(first_col = c("A", "B", "C"), col_2 = c(1,2,3))) Then use the sapply: sapply(your_list, \(x) names(x)[[2]]) — bdbmax, Jan 13 '23 at 17:27

score 2 · Accepted Answer · answered Jan 13 '23 at 20:27

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.

score 1 · Answer 2 · answered Jan 13 '23 at 17:59

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

How to subset a dynamically rendered list in R Shiny?

2 Answers2