如何在 R Shiny removeUI 函数中正确使用选择器？

Question

在运行下面发布的代码时，用户通过单击“添加表格”操作按钮来添加表格。这部分工作正常。但是，我还试图允许用户通过selectizeInput() 函数一次删除一个表，通过服务器部分中 Shiny 的removeUI() 函数执行表删除。我很难在 selectizeInput() 中编写正确的“选择器”。请在服务器部分查看我的最后一个 observeEvent()，其中显示了我对 removeUI() 的占位符。有人可以帮助使用正确的选择器来删除选定的表吗？

用户选择要删除的表名，但由于我的 NULL 占位符，当前起草的所有表都被删除，而不仅仅是选定的表。此外，删除后剩余的表以及删除后添加的所有表都应左对齐，以便呈现连续的表块。

代码：

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("%02d", 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)

Answer 1

嵌套观察者时需要格外小心。一般来说，我根本不建议这样做。在这种情况下，您应该只使用它为每个新表创建一个观察者，以根据用户输入更新uiTbl。

请检查以下内容——我将命名列表传递给selectizeInput，以便我们可以访问 divID 以删除表：

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("%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)
      )
    )
    
    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, {
    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)