Use insertUI method to create different shiny widgets

Question

I have the shiny app below in which the user may select between one or more column names from the data frame.

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

Then for every selection he makes the relative pickerInput() may be displayed below. Maybe I could use if for every case but the issue is that my real dataset may be much bigger and has different column names every time so Im looking for a way to instantly connect the pickerInput() selected name with the creation of the relative pickerInput() which will include the column values. For example if someone select all 4 column names 4 pickerInput() should be created with the relative column name as label.

My method is the insertUI method but I have to find a way to create widget with different choices and label every time and also remove it when de-select the relative value of the 1st pickerInput().

library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            pickerInput(
                inputId = "p1",
                label = "Select Column headers",
                choices = colnames( dt),
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            )

            
        ),
        
        mainPanel(
        )
    )
)

# server()
server <- function(input, output) {
    
    observeEvent(input$p1, {
        insertUI(
            selector = "#p1",
            where = "afterEnd",
            ui = pickerInput(
                inputId = #The colname of selected column
                    ,
                label = #The colname of selected column
                    ,
                choices = #all rows of selected column
                    ,
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            )
        )
    })

    
    
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

Answer 1

I don't really like using lapply to create input element in shiny, because when you add an element, the input UIs for the already existing (selected) inputs get overwritten, and so everything is set back to the defaults and previously chosen values for these inputs get lost.

You can pair insertUI with removeUI and a variable to keep track of the previously selected columns. Then you can dynamically add/remove UI elements and keep the other inputs unchanged.

library(shiny)
library(shinyWidgets)
library(DT)

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
      tags$div(id = "add_ui_here")
      
      
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  # store currently selected columns
  selected_columns <- c()
  
  observeEvent(input$p1, {
    
    # determine pickerInputs to remove
    input_remove <- !selected_columns %in% input$p1
    input_remove <- selected_columns[input_remove]
    
    # remove inputs
    if (!is.null(input_remove) && length(input_remove) > 0) {
      for (input_element in input_remove) {
        removeUI(selector = paste0("#", input_element, "_remove_id"))
      }
    }
    
    # determine pickerInputs to add
    input_add <- !input$p1 %in% selected_columns
    input_add <- input$p1[input_add]
    
    # add inputs
    if (length(input_add) > 0) {
      for (input_element in input_add) {
        insertUI(
          selector = "#add_ui_here",
          where = "afterEnd",
          ui = tags$div(id = paste0(input_element, "_remove_id"),
                        pickerInput(
                          inputId = input_element
                          ,
                          label = input_element
                          ,
                          choices = dt[, input_element]
                          ,
                          multiple = TRUE,
                          options = list(`actions-box` = TRUE)
                        ))
        )
      }
    }
    
    # update the currently stored column variable
    selected_columns <<- input$p1
  },
  ignoreNULL = FALSE)
  
  
  
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

I've wrapped the inserted pickerInputs in a div, so it's easier to remove them. Also, you need to set ignoreNULL = FALSE for the observer, so that it also get triggered if all elements get deselected.

Answer 2

A possible solution is to generate the pickerInput list and to render it using tagList in renderUI:

# Data
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)


# App
library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("pickers")
      
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  pickers <- colnames(dt)
  output$pickers <- renderUI({
    l <- list()
    for (i in 1:length(pickers)) {
       l[[i]] <- pickerInput(pickers[i],pickers[i],dt[[pickers[i]]])
    }
    tagList(l)
   })

}

# shinyApp()
shinyApp(ui = ui, server = server)

Answer 3

You can use lapply with renderUI instead of insertUI

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
#Add stringsAsFactor=F to correctly display options of name and add
dt<-data.frame(name,value1,add,value2,stringsAsFactors = F)

library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
#Add the output for new pickers
      uiOutput("pickers")
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  observeEvent(input$p1, {
#Create the new pickers 
    output$pickers<-renderUI({
      
      div(lapply(input$p1, function(x){
        pickerInput(
          inputId = x#The colname of selected column
            ,
          label = x #The colname of selected column
            ,
          choices = dt[,x]#all rows of selected column
            ,
          multiple = TRUE,
          options = list(`actions-box` = TRUE)
        )
      }))
    })
  })
}

# shinyApp()
shinyApp(ui = ui, server = server)