Question
I have two dropdowns, the choices available in dd2 are conditional on option selected in dd1. I"m unable to figure out how to change the options of dropdown 2 but retain whatever selection has already been made. I should also be able to drop items from previous selection through dropdown 2.
Example
let's say dd1 is Country: India, England, USA and the respective options in dd2, City: (New Delhi, Mumbai), (London, Birmingham), (New York, Washington DC). I first select India, then Mumbai, then select England, retain Mumbai, and add London. Then I add New York in a similar manner. I now realise that I didn't need Mumbai so I remove it leaving me with London, New York.
Failed Attempts
I'm trying things like appending selections to previously existing vectors and passing the intersection of two vectors to the 'selected' argument but it seems to not work. I'm guessing the circular nature of doing that probably causes problems.
Basic code
To save you guys some time and allow us to have the same reference -
# server.r
library(shiny)
library(data.table)
countrycity = data.table(
country = c('India','India','England','England','USA','USA'),
city = c('New Delhi','Mumbai','London','Birmingham','New York','Washington DC')
)
shinyServer(function(input, output) {
# dd1: country
output$chooseCountry <- renderUI({
selectizeInput(
"countrSelected",
"Country",
as.list(c('All',unique(unique(countrycity$country)))),
options = list(create = TRUE),
selected = c('All'),
multiple = TRUE,
width="120px"
)
})
# filtering list of cities based on the country selected
citiestoshow = reactive({
countryselected = if ( is.null(input$countryselected) ) {
unique(countrycity$country)
} else if ( 'All' %in% input$countryselected ) {
unique(countrycity$country)
} else {
input$countryselected
}
countrycity[country %in% countryselected, city]
})
# dd2: city
output$choosecities <- renderUI({
selectizeInput(
'cityselected',
label = 'City',
choices = as.list(c('All',citiestoshow())),
options = list(create = TRUE),
multiple = TRUE,
width="120px"
)
})
}
If anyone is still looking for a simple example for updating the selections while maintaining previously selected value:
#in ui.R you have a selectInput that you want to update
selectInput(inputId = "mymenu", label = "My Menu",
choices = c("A" = "a","B" = "b","C" = "c"),
selected = c("A" = "a"))
# in server.R create reactiveVal
current_selection <- reactiveVal(NULL)
# now store your current selection in the reactive value
observeEvent(input$mymenu, {
current_selection(input$mymenu)
})
#now if you are updating your menu
updateSelectInput(session, inputId = "mymenu",
choices = c("A" = "a","B" = "b","C" = "c", "D" = "d"),
selected = current_selection())
Here is one implementation that should do it (more details here):
runApp(list(ui={shinyUI(pageWithSidebar(
headerPanel("shinyUI"),
sidebarPanel(
uiOutput("choose_country"),
uiOutput("choose_city")
),
mainPanel(
headerPanel("mainPanel")
)
))},
server={
#Consider creating a file.
countries <- c('India','England','USA')
countrycity<-list()
countrycity[[countries[1]]]<-c('New Delhi','Mumbai')
countrycity[[countries[2]]]<-c('London','Birmingham')
countrycity[[countries[3]]]<-c('New York','Washington DC')
shinyServer(function(input, output) {
# Drop-down selection box for which data set
output$choose_country <- renderUI({
selectInput("choose_country", "Select Country", as.list(countries))
})
# Check boxes
output$choose_city <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$choose_country))
return()
# Get the data set with the appropriate name
selected_country <- input$choose_country
cities<-countrycity[[selected_country]]
# Create the checkboxes and select them all by default
selectInput("choose_city", "Choose city",
choices = as.list(cities))
})
})}
))
Update 1 (Keep previous selections - rough version) :
runApp(list(ui={
library(shiny)
#ui.R
ui.r<-shinyUI(pageWithSidebar(
headerPanel("shinyUI"),
sidebarPanel(
uiOutput("choose_country"),
uiOutput("choose_city")
,actionButton('add','Add City')
),
mainPanel(
headerPanel("mainPanel")
, checkboxGroupInput('currentselection', 'Current Selection', choices = c('None'),selected=c(''))
)
))
},
server={
library(shiny)
#server.R
countries <- c('India','England','USA')
countrycity<-list()
countrycity[[countries[1]]]<-c('New Delhi','Mumbai')
countrycity[[countries[2]]]<-c('London','Birmingham')
countrycity[[countries[3]]]<-c('New York','Washington DC')
#Alphabetize (Optional)
order_cities<-order(countries)
countries<-countries[order_cities]
countrycity<-countrycity[order_cities]
countrycity<-lapply(countrycity,sort)
server.ui<-shinyServer(function(input, output,session) {
# Drop-down selection box for Country Selection
output$choose_country <- renderUI({
selectInput("choose_country", "Select Country", as.list(countries))
})
# City Selection
output$choose_city <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$choose_country))
return()
# Get the data set with the appropriate name
selected_country <- input$choose_country
cities<-countrycity[[selected_country]]
# Create the drop-down menu for the city selection
selectInput("choose_city", "Choose city",
choices = as.list(cities))
})
##Keep previous selections in a session
lvl<-reactive(unlist(input$currentselection))
observe({
if(input$add==0) return()
isolate({
current_selection<-paste(input$choose_city,input$choose_country,sep=", ")
updateCheckboxGroupInput(session, "currentselection", choices = c(current_selection,lvl())
,selected=c(current_selection,lvl()))
})#iso
})#obs
observe({
updateCheckboxGroupInput(session, "currentselection", choices = unique(c(lvl()))
,selected=c(lvl()))
})
})
}
))
Update 2:
runApp(list(ui={
library(shiny)
#ui.R
ui.r<-shinyUI(
pageWithSidebar(
headerPanel("shinyUI"),
sidebarPanel(
uiOutput("choose_country"),
uiOutput("choose_city")
),
mainPanel(
headerPanel("mainPanel")
#, checkboxGroupInput('currentselection', 'Current Selection', choices = c('None'),selected=c(''))
)
))
},
server={
library(shiny)
#server.R
countries <- c('India','England','USA')
countrycity<-list()
countrycity[[countries[1]]]<-c('None','New Delhi','Mumbai')
countrycity[[countries[2]]]<-c('None','London','Birmingham')
countrycity[[countries[3]]]<-c('None','New York','Washington DC')
#Alphabetize (Optional)
order_cities<-order(countries)
countries<-countries[order_cities]
countrycity<-countrycity[order_cities]
countrycity<-lapply(countrycity,sort)
server.ui<-shinyServer(function(input, output,session) {
session$countrycitySelection<-list()
for(country in countries){
session$countrycitySelection[[country]]<-'None'
}
# Drop-down selection box for Country Selection
output$choose_country <- renderUI({
selectInput("choose_country", "Select Country", as.list(countries))
})
# City Selection
output$choose_city <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$choose_country))
return()
# Get the data set with the appropriate name
selected_country <- input$choose_country
cities<-countrycity[[selected_country]]
# Create the drop-down menu for the city selection
selectInput("choose_city", "Choose city",
choices = as.list(cities),selected = NULL, multiple = FALSE,
selectize = TRUE, width = NULL)
})
#changing country selection
observe({
country <- input$choose_country
if(is.null(country)) return()
isolate({
updateSelectInput(session, "choose_city", choices = countrycity[[country]]
,selected = session$countrycitySelection[[country]] )
})#iso
})#obs
#changing city selection
observe({
city <- input$choose_city
if(is.null(city)) return()
isolate({
country<-input$choose_country
session$countrycitySelection[[country]]<-city
})#iso
})#obs
})
}
))
Update 3: (2016) Shiny no longer allows adding values to session so here is the same with reactive :
runApp(list(ui={
library(shiny)
#ui.R
ui.r<-shinyUI(
pageWithSidebar(
headerPanel("shinyUI"),
sidebarPanel(
uiOutput("choose_country"),
uiOutput("choose_city")
),
mainPanel(
headerPanel("mainPanel")
#, checkboxGroupInput('currentselection', 'Current Selection', choices = c('None'),selected=c(''))
)
))
},
server={
library(shiny)
#server.R
countries <- c('India','England','USA')
countrycity<-list()
countrycity[[countries[1]]]<-c('None','New Delhi','Mumbai')
countrycity[[countries[2]]]<-c('None','London','Birmingham')
countrycity[[countries[3]]]<-c('None','New York','Washington DC')
#Alphabetize (Optional)
order_cities<-order(countries)
countries<-countries[order_cities]
countrycity<-countrycity[order_cities]
countrycity<-lapply(countrycity,sort)
countrycitySelection<-list()
for(country in countries){
countrycitySelection[[country]]<-'None'
}
server.ui<-shinyServer(function(input, output,session) {
values <- reactiveValues(countrycitySelection = countrycitySelection)
# Drop-down selection box for Country Selection
output$choose_country <- renderUI({
selectInput("choose_country", "Select Country", as.list(countries))
})
# City Selection
output$choose_city <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$choose_country))
return()
# Get the data set with the appropriate name
selected_country <- input$choose_country
cities<-countrycity[[selected_country]]
# Create the drop-down menu for the city selection
selectInput("choose_city", "Choose city",
choices = as.list(cities),selected = NULL, multiple = FALSE,
selectize = TRUE, width = NULL)
})
#changing country selection
observe({
country <- input$choose_country
if(is.null(country)) return()
isolate({
updateSelectInput(session, "choose_city", choices = countrycity[[country]]
,selected = values$countrycitySelection[[country]] )
})#iso
})#obs
#changing city selection
observe({
city <- input$choose_city
if(is.null(city)) return()
isolate({
country<-input$choose_country
values$countrycitySelection[[country]]<-city
})#iso
})#obs
})
}
))
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With