2015-02-07 58 views
2

问题变化Selectize选择,但保留先前选定值

我有两个下拉列表,在DD2可用的选择是在DD1所选选项的条件。我“米无法弄清楚如何改变下拉2的选项,但保留已经作出什么选择,我也应该能够通过下拉菜单下降,由以前的选择项目2.

假设dd1是国家:印度,英国,美国以及dd2,城市:(新德里,孟买),(伦敦,伯明翰),(纽约,华盛顿DC)的相应选项。我首先选择印度,然后选择孟买,然后选择选择英格兰,保留孟买,并添加伦敦,然后我以类似的方式添加纽约,现在我意识到我并不需要孟买,所以我将它删除,留给我,伦敦,纽约。失败尝试

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

Basic代码

为了节省你们一些时间,让我们有相同的参考 -

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

    }) 


} 
+0

https://stackoverflow.com/questions/25894525/shiny-reactiveui-reseting-value-on-reload可用于产生相同的最终结果,但它不是清洁方面的解决方案或GUI如何响应。 – TheComeOnMan 2015-02-07 09:42:50

回答

1

这是一个实现应该这样做(更多详情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())) 
    }) 

    }) 
} 
)) 

Preview of the page from the second code. To the left is the menu and to the right are the selected cities.


更新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 

    }) 
} 
)) 
+0

我看到下拉选项更改,但您如何保留? – TheComeOnMan 2015-02-09 12:19:56

+0

修改后的版本是做你想要的吗? – Stanislav 2015-02-10 23:35:04

+0

在功能上是的,但就像我提到的,我希望在两个下拉本身内。按钮和复选框组是额外的。那可能吗? – TheComeOnMan 2015-02-14 01:02:22

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