Use insertUI to create different kind of 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. The issue is that I would like to set a diffrent widget for specific columns. Let's say that I would like to set those with numeric values as sliderInput(). I have 2 versions below of the same app. So if any solution is applicable to on of them it would be ok.

app1

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)

app2

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)

Answer 1

Check if the selected variable is numeric or character and assign the appropriate widget. Try this code.

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)
      ),
      #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){
        if (is.numeric(dt[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt[x]), max=max(dt[[x]]), value=min(dt[[x]]))
        }
        else if (is.character(dt[[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)