如何正确使用R Shiny removeUI功能中的选择器?

Question

在运行下面发布的代码时，用户通过点击"Add table"操作按钮。这部分工作正常。然而，我也试图允许用户通过selectizeInput()函数一次删除一个表，通过服务器部分中的Shiny的removeUI()函数执行表删除。我在编写正确的选择器时遇到了困难在selectizeInput()内。请参阅服务器部分中显示removeUI()占位符的最后一个observeEvent()。有人可以帮助删除选定表的正确选择器吗?

用户选择要删除的表名，但由于当前起草的表被删除，而不仅仅是被选中的表，因为我的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，以便我们可以访问删除表的div:

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