【发布时间】：2020-09-10 16:28:30
【问题描述】：
我正在使用自定义函数 render_panels 动态生成输入，该函数创建一个 wellPanel，其中包含 selectizeInput 和 actionButton，actionButton 使用 removeUI 删除整个 wellPanel 使用div 的 id 作为选择器。我还有一个全局添加按钮来添加新的wellPanel。
我有一种方法可以通过观察每个面板的删除按钮事件来删除wellPanel，然后使用removeUI 并将相应的 div id 指定为选择器，但我想知道是否有更有效的方法使用 for 循环或矢量化方法。
编辑注意：我专门使用这种方法来代替insertUI，以便提供使用已插入面板来初始化应用程序的能力。例如，闪亮的应用程序将作为一个函数执行，用户可以在其中提供下拉选择值的字符向量。我在服务器中添加了一个字符向量prevInputs，一个反应值counter$n，它已经替换了input$add，以便创建length(prevInputs)的初始面板，如果!is.null(prevInputs)和一个初始化selected值参数的方法对于 selectizeInput 和 make_panels 中的现有值来说明这一点。
见代表：
library(shiny)
render_panels <- function(n, removed_panels, inputs){
make_panels <- function(n, inputs){
panels <- tags$div(id = n,
wellPanel(
selectizeInput(inputId = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = inputs[[paste0("dropdown", n)]]),
actionButton(paste0("remove", n), label = paste0("remove", n))
)
)
}
ui_out <- vector(mode = "list", length = n)
for(i in seq_along(ui_out)){
if(i %in% removed_panels) next
ui_out[[i]] <- tagList(
make_panels(n = i, inputs)
)
}
return(ui_out)
}
ui <- fluidPage(
fluidRow(
column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
removed <- reactiveValues(
values = list()
)
prevInputs <- c("a", "b", "c")
reactiveInputs <- reactiveValues(values = list())
observe({
reactiveInputs$values$dropdown1 = prevInputs[[1]]
reactiveInputs$values$dropdown2 = prevInputs[[2]]
reactiveInputs$values$dropdown3 = prevInputs[[3]]
})
counter <- reactiveValues(n = ifelse(!is.null(prevInputs), length(prevInputs), 0))
observeEvent(input$add, {
counter$n <- counter$n + 1
})
observeEvent(input$remove1,{
removed$values <- c(removed$values, 1)
removeUI(
selector = "div#1", immediate = TRUE,
)
}, once = TRUE)
observeEvent(input$remove2,{
removed$values <- c(removed$values, 2)
removeUI(
selector = "div#2", immediate = TRUE,
)
}, once = TRUE)
observeEvent(input$remove3,{
removed$values <- c(removed$values, 3)
removeUI(
selector = "div#3", immediate = TRUE,
)
}, once = TRUE)
output$mypanels <- renderUI({
render_panels(n = counter$n, removed_panels = removed$values, inputs = reactiveInputs$values)
})
}
shinyApp(ui, server)
如您所见，如果生成了 100 个wellPanels，我将不得不使用 100 个observeEvent，这不是我们想要的……这是我对 for 循环的尝试：
我想将所有 observeEvent 调用替换为如下所示，但似乎无法正常工作。
observe({
req(input$remove1)
for(i in seq_len(input$add)){
if(input[[paste0("remove", i)]] == 1){
removeUI(selector = paste0("div#", i), immediate = TRUE)
}
}
})
编辑：
这是使用 shinymaterial 包作为替代 UI 提供的答案的尝试。注意shinymaterial 包要求您将 ui 元素包装在 render_material_from_server 内 renderUI 中，以用于在服务器端生成的任何 UI，即
output$dropdown <- renderUI({
render_material_from_server(
material_dropdown(input_id = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = "a")
)
})
render_material_from_server这个函数是新推出的，只存在于GH上的当前开发版本包中：shinymaterial
在任何情况下，insertUI 都不会使用来自 shinymaterial 的 material_page UI 按预期呈现 UI 元素
library(shiny)
library(shinymaterial)
make_panels <- function(n, selected){
tags$div(
material_card(
material_dropdown(input_id = paste0("dropdown", n), label = paste0("dropdown", n), choices = c("a", "b", "c"), selected = selected),
actionButton(paste0("remove", n), label = paste0("remove", n), class = "mybtn")
)
)
}
ui <- material_page(
tags$script("
$(document).on('click', '.mybtn', function(){
$(this).parent().remove();
})
"),
material_row(
material_column(width = 6,
actionButton("add", label = "add"),
uiOutput("mypanels")
)
)
)
server <- function(input, output, session){
choices = c("a", "b", "c")
init_counter <- reactiveVal(3)
observe({
for(i in seq_len(isolate(init_counter()))){
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(i, choices[i]))
}
})
observeEvent(input$add, {
panel_index <- init_counter() + input$add
insertUI(selector = "#mypanels", where = "beforeEnd", ui = make_panels(panel_index, choices[panel_index]))
})
}
shinyApp(ui, server)
【问题讨论】：