更改选择选项，但保留先前选择的值

Question

题

我有两个下拉菜单，dd2中可用的选择取决于dd1中选择的选项。我无法弄清楚如何更改下拉菜单2的选项，但保留已进行的选择。我还应该能够通过下拉菜单2删除先前选择的项目。

例

假设dd1是国家/地区：印度，英国，美国和dd2中的相应选项，城市：（新德里，孟买），（伦敦，伯明翰），（纽约，华盛顿特区）。我首先选择印度，然后选择孟买，然后选择英格兰，保留孟买，然后添加伦敦。然后，我以类似的方式添加纽约。现在，我意识到我不需要孟买，所以我将其删除，离开了纽约。

尝试失败

我正在尝试将选择附加到先前存在的向量上，并将两个向量的交集传递给“ selected”参数，但这似乎不起作用。我猜测这样做的循环性质可能会导致问题。

基本代码

为了节省您一些时间，并允许我们提供相同的参考-

# 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"
        )

    })


}

Answer 1

如果有人仍在寻找一个简单的示例来更新选择，同时保持先前选择的值：

#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())

Answer 2

这是应该做到这一点的一种实现（更多详细信息请参见此处）：

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） Shiny 不再允许向会话添加值，因此这里与 React 相同：

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

  })   
}
))