2015-02-07 38 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())