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

↘锁芯ラ 提交于 2019-12-12 03:06:06

问题


I was suggested using 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 gave some clues, i.e., tags$div(id="sepal.width.div", sliderInput("sepal.width.slider", ...)), but my lack of HTML/CSS knowledge stops me going forward. I'm looking at (a) wrapping multiple widget element(s) with tags$div() assigning a unique id for each variable, which will be used in removeUI; (b) calling multiple elements via 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)

回答1:


Here is the working code. The main issue is with the names here, i.e. Sepal.Width. I wrapped each slider with a div with id like div.Sepal.Width so that it is easier to remove. removeUI requires a jQuery selector, so it appears that something like #div.Sepal.Width would work, except that it does not, because . is itself a jQuery selector that means class, so we need to double escape the .. Of course you can also remove the . when you first create the divs, thus avoiding the trouble...

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)


来源:https://stackoverflow.com/questions/40457622/removing-multiple-elements-with-removeui-wrapping-multiple-elements-with-tags

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!