Use insertUI to create different kind of shiny widgets - r

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)