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

The

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(tables_list) ### PRINT ###
  })
}

shinyApp(ui, server)

CodePudding user response：

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

CodePudding user response：

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("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]
    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.