How to correctly use the selector in the R Shiny removeUI function?-CodePudding

In running the code posted below, the user adds tables via clicks of the "Add table" action button. This part works fine. However, I'm also trying to allow the user to remove one table at a time via the selectizeInput() function, with table deletion executed via Shiny's removeUI() function in the server section. I'm having a hard time coding the correct "selector" within the selectizeInput(). Please see my last observeEvent() in the server section which shows my placeholder for removeUI(). Could someone please help with the correct selector for deleting a selected table?

The user selects the table name to delete, but as currently drafted ALL tables are deleted and not just the selected table, because of my NULL placeholder. Also, remaining tables after deletion, and all tables added after deletion, should left align so that there is a continuous block of rendered tables.

Code:

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(),
        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")
    uiTbl[[paste0(divID,"_tbl")]] <- data1 # captures initial dataframe values

    insertUI(
      selector = "#placeholder",
      ui = tags$div(
        id = divID,
        style = "display:inline-block;",
        rHandsontableOutput(dtID)
      )
    )
    
    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]])})
   
    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]
      }
      
      freezeReactiveValue(input, "select_deletion")
      updateSelectizeInput(session, inputId = "select_deletion", choices = table_names, selected = NULL)
      
      observeEvent(input$select_deletion,{ # << attempts to delete selected table via selectizeInput
        removeUI(selector = NULL)
        uiTbl[[paste0(divID,"_tbl")]] <- NULL
      })
    })
  })
}

shinyApp(ui, server)

CodePudding user response：

You need to be extremely careful when nesting observers. In general I don't recommend doing it at all. In this case you should only use it to create an observer for each new table to keep uiTbl updated on user input.

Please check the following - I'm passing a named list to selectizeInput so we can access the divIDs for the deletion of a table:

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 = FALSE),
  actionButton("delete", "Delete", class = "pull-left btn btn-danger")
)

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)
      )
    )
    
    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]])})
  })
  
  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
    divIDs <- gsub("_tbl", "", names(tables_list[table_lengths != 0L]))
    names(divIDs) <- table_names
    freezeReactiveValue(input, "select_deletion")
    updateSelectizeInput(session, inputId = "select_deletion", choices = divIDs, selected = NULL)
  })
  
  observeEvent(input$delete, {
    tables_list <- reactiveValuesToList(uiTbl)
    table_lengths <- lengths(tables_list)
    if(length(table_lengths[table_lengths != 0L]) > 1L){
      req(input$select_deletion)
      removeUI(selector = paste0("#", input$select_deletion))
      rv[[input$select_deletion]] <- NULL
      uiTbl[[paste0(input$select_deletion,"_tbl")]] <- NULL 
    }
  })
}

shinyApp(ui, server)