這是一個實現應該這樣做(更多詳情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))
})
})}
))
更新1(保留先前的選擇 - 粗糙的版本):
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()))
})
})
}
))

更新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
})
}
))
更新3:(2016) 閃亮不再允許添加值會話所以這裏也是一樣與反應:
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
})
}
))
https://stackoverflow.com/questions/25894525/shiny-reactiveui-reseting-value-on-reload可用於產生相同的最終結果,但它不是清潔方面的解決方案或GUI如何響應。 – TheComeOnMan 2015-02-07 09:42:50