使用 removeUI 删除多个元素/使用 tags$div() 为每个变量分配一个 id 包装多个元素

Question

有人建议我使用 insertUI here and found that it is a great feature. The following code allows to generate control widgets for a single or multiple elements using insertUI, but struck on incorporating removeUI related part. Tried jQuery options to remove inserted UI elements but did not work out. I found the following from Shiny dynamic UI, i.e., Note that, if you are inserting multiple elements in one call, you must wrap them in either a tagList() or a tags$div() (the latter option has the advantage that you can give it an id to make it easier to reference or remove it later on). Also, comments here 提供了一些线索，即 tags$div(id="sepal.width.div", sliderInput("sepal.width.slider", ...))，但我缺乏 HTML/CSS 知识使我无法继续前进向前。我正在看 (a) 用标签 $div() 包装多个小部件元素，为每个变量分配一个唯一的 id，它将在 removeUI 中使用； (b) 通过 removeUI.

调用多个元素

varnames <- names(iris[,1:4]) # names
varinit <- apply(iris[,1:4],2,median) # initival value used in slider
varmin <- apply(iris[,1:4],2,min) # min.
varmax <- apply(iris[,1:4],2,max) # max. 

ListofSelVars <<- vector(mode="character")

# control widgets for all elements
allControls <- lapply(setNames(varnames, varnames), function(x) {

   sliderInput(x, x, varmin[x], varmax[x], c(varmin[x], varinit[x]), 
               round = -2)   
})

ui <- navbarPage(
   tabPanel("Plot",
            sidebarLayout(
               sidebarPanel(
                  checkboxGroupInput("ConditioningVariables", "Conditioning variables (choose one or more):",
                                     varnames,inline = TRUE),
                  # add an action button
                  actionButton("add", "Update UI elements")
               ),
               mainPanel()
            )
   )
)

server <- function(input, output, session) {
   observeEvent(input$add, {
      insertUI(
         selector ='#add',
         where = "afterEnd",
         ui = allControls[setdiff(input$ConditioningVariables,ListofSelVars)]
      )

      ## removeUI related goes, here
      ## removeUI(selector=paste0())
      ## setdiff(ListofSelVars,input$ConditioningVariables) gives elements to be removed

      ## Global variable, keep track of elements that are selected

      ListofSelVars <<- input$ConditioningVariables

   })

}
shinyApp(ui, server)

Answer 1

这是工作代码。主要问题在于此处的名称，即 Sepal.Width。我用一个 div 和 div.Sepal.Width 这样的 id 包裹了每个滑块，这样它更容易移除。 removeUI 需要一个 jQuery 选择器，所以看起来像 #div.Sepal.Width 这样的东西会起作用，除了它不起作用，因为 . 本身就是一个 jQuery 选择器表示 class，所以我们需要对 . 进行双重转义。当然你也可以在第一次创建div的时候去掉.，这样就避免了麻烦...

varnames <- names(iris[,1:4]) # names
varinit <- apply(iris[,1:4],2,median) # initival value used in slider
varmin <- apply(iris[,1:4],2,min) # min.
varmax <- apply(iris[,1:4],2,max) # max. 

ListofSelVars <<- vector(mode="character")

# control widgets for all elements
allControls <- lapply(setNames(varnames, varnames), function(x) {
  tags$div(id=paste0("div.",x), sliderInput(x, x, varmin[x], varmax[x], c(varmin[x], varinit[x]), 
              round = -2))
})

ui <- fluidPage(

  titlePanel("Dynamic sliders"),

  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("ConditioningVariables", "Conditioning variables (choose one or more):",
                         varnames,inline = TRUE),
      # add an action button
      actionButton("add", "Update UI elements")
    ),

    mainPanel(
      uiOutput("plot_out")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$add, {

    insertUI(
      selector ='#add',
      where = "afterEnd",
      ui = allControls[setdiff(input$ConditioningVariables,ListofSelVars)]
    )

    ListofRemoval <- setdiff(ListofSelVars,input$ConditioningVariables)

    for (item in ListofRemoval) {
      item = gsub(".", "\.", item, fixed=TRUE)
      item = paste0("#div\.", item)
      removeUI(item)
    }

    ListofSelVars <<- input$ConditioningVariables

  })

}
shinyApp(ui, server)

使用 removeUI 删除多个元素/使用 tags$div() 为每个变量分配一个 id 包装多个元素

Removing multiple elements with removeUI / wrapping multiple elements with tags$div() assigning an id for each variable

html

css

widget

dynamic

shiny