Search code examples
rlistvectorshinysubset

How to subset a dynamically rendered list in R Shiny?


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:

enter image description here

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)

Solution

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