How to extract deeply embedded table names from a list in R?-CodePudding

I'm trying to figure out how to navigate through lists in R (I've mostly worked with vectors to-date in R). The Shiny code posted at the bottom allows the user to dynamically add/delete tables, and I'm trying to capture in a separate list or vector the column names of the added tables. (I'm trying to capture the column names so I can populate a pending selectizeInput() function for choosing which tables to delete). Any recommendations for how to do this?

As you can see in my print() function in the code below, I am only extracting a high-level name, but instead would like to drill deeper to the column names of the individual tables. The following illustrations explain better.

In this illustration the user has added 2 tables, in addition to the first default table:

And in this illustration, the print() function produces the following list names in R Studio Console when I would like to instead only show "Col 1", "Col 2", and "Col 3", in this example of 2 clicks of "Add table":

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("d", 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(names(uiTbl))
  })
        
}

shinyApp(ui, server)

CodePudding user response：

Here is one albeit long-winded solution, resorting to my familiarity with data frames. I am sure there are cleaner approaches. See the inclusion of "tmp" objects in the last observe() for the core of my solution; I send the reactive values list into a dataframe and manipulate from there. I also include the selectizeInput() using renderUI() also embedded in the last observe() so you can see the point of my question. Rather than sending the desired vector to R Studio console via print() as in the OP, I send it to global environment as "tmp.R" so I can review more intricate input sequences.

library(dplyr)
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(),
  uiOutput("delSection"),
  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("d", 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])
    }
    tmp <- data.frame(cumsum_table_lengths)
    tmp <- data.frame(origTbl = rownames(tmp), tblCnt = tmp[,1])
    tmp <- tmp %>% mutate(tblCode = paste("Col",tblCnt))
    tmp.R <<- tmp
    
    output$delSection <-
      renderUI(
        tagList(
          selectizeInput(
            'delSelector', 
            'Select table for deletion:',
            choices = tmp[,3], 
            multiple = FALSE,
            options = list(placeholder = 'Choose table')
          ),
          p(actionButton('delTbl', 'Delete'))
        )
      )  
  })
  
}

shinyApp(ui, server)

CodePudding user response：

  observe({
    print(paste0(lapply(
      Filter(
        \(x)!is.null(x),
        reactiveValuesToList(uiTbl)
      ),
      names
    ), collapse = "; "))
  })