R/Shiny應用程序中的三個相互依賴的selectInput

Question

我正在研究R/Shiny應用程序，其功能之一應該是基於某些過濾器導出數據。但是過濾器依賴於彼此。考慮一個公司名單，每個公司都有一些團隊或部門，這些公司可能位於不同的國家。用戶可以通過三個下拉菜單（selectInput）過濾要導出的數據，但我希望當選擇一個維度（即組）時，其他兩個維度（即部門和國家/地區）的下拉列表中的選擇）相應地更新。然而，第二維（即部門）上的過濾應該縮小選擇範圍，而不是更新所有selectInput的選擇。

下面的代碼是最接近我可以得到所需的輸出。 但是有兩個問題。首先，在第二維 上過濾不會縮小選擇範圍，但也會更新第一個選定維度的選項 。其次，即使選擇 已更新，選擇也不會保留在輸入字段中，而該字段仍然爲 爲空。

任何想法如何解決這個問題？

編輯

下面的代碼幾乎工作。現在無論首先選擇哪個維度，剩餘兩個維度的選擇都會正確更新，而第二個維度上的篩選會縮小選擇的範圍。不過，即使multiple = TRUE，我也無法爲每個selectInput選擇多個項目。

有關如何解決此問題的任何想法？

library(shiny) 
library(dplyr) 

## Create dataframe 
group <- rep(toupper(letters[1:3]),each=3) 
department <- c("a","b","c","a","b","d","b","c","d") 
country <- c("IT","FR","DE","IT","DE","HU","HU","FR","FR") 
df <- data.frame(group, department, country) 


## Simple user interface with 3 selectInput 
ui <- fluidPage(
    selectInput('group', 'Group:', df$group, multiple=TRUE, selectize=T), 
    selectInput('dept', 'Department:', df$department, multiple=TRUE, selectize=T), 
    selectInput('country', 'Country:', df$country, multiple=TRUE, selectize=T), 
    tableOutput("table1") 
) 


filter_names <- c("input$group", "input$dept", "input$country") 
filters <- c("group %in% input$group", "department %in% input$dept","country %in% input$country") 
checknull <- NULL 


server=function(input,output,session) { 

    ## reactive block to update the choices in the select input fields 
    choices <- reactive({ 
    for (i in seq_along(filter_names)) { 
     checknull[i] <- eval(parse(text=paste0("!is.null(", filter_names[i], ")",sep=""))) 
    } 

    req(filters[checknull]) 
    tmp <- eval(parse(text=paste0("filter(df, ", paste0(filters[checknull], collapse = " & "), ")"))) 
    return(tmp) 
    }) 

    ## updateSelectInput 
    observe({ 
    updateSelectInput(session,'group', choices=sort(unique(choices()$group)), selected = input$group) 
    updateSelectInput(session,'dept', choices=sort(unique(choices()$department)), selected = input$dept) 
    updateSelectInput(session,'country', choices=sort(unique(choices()$country)), selected = input$country) 
    }) 

output$table1 <- renderTable({df}) 
} 

shinyApp(ui,server) 

Answer 1

我一直在尋找類似問題的解決方案，並遇到此問題。

感謝您幾乎可以工作的例子！我剛剛切換到selectizeInput，它似乎爲我工作。如果您仍在研究此問題，這是否符合您的需求？

但是，一個問題是，沒有辦法回來和重新篩選，因爲選擇已經消失。我添加了一個重置​​過濾器按鈕來解決這個問題。

library(shiny) 
library(dplyr) 

## Create dataframe 
group <- rep(toupper(letters[1:3]),each=3) 
department <- c("a","b","c","a","b","d","b","c","d") 
country <- c("IT","FR","DE","IT","DE","HU","HU","FR","FR") 
df <- data.frame(group, department, country) 


## Simple user interface with 3 selectInput 
ui <- fluidPage(
    selectizeInput('group', 'Group:', df$group, selected=df$group, multiple=TRUE), 
    selectizeInput('dept', 'Department:', df$department, selected=df$department, multiple=TRUE), 
    selectizeInput('country', 'Country:', df$country, selected=df$country, multiple=TRUE), 
    actionButton("reset_filters", "Reset filters"), 
    tableOutput("table1") 
) 


filter_names <- c("input$group", "input$dept", "input$country") 
filters <- c("group %in% input$group", "department %in% input$dept","country %in% input$country") 
checknull <- NULL 


server=function(input,output,session) { 

    ## reactive block to update the choices in the select input fields 
    choices <- reactive({ 
    for (i in seq_along(filter_names)) { 
     checknull[i] <- eval(parse(text=paste0("!is.null(", filter_names[i], ")",sep=""))) 
    } 

    req(filters[checknull]) 
    tmp <- eval(parse(text=paste0("filter(df, ", paste0(filters[checknull], collapse = " & "), ")"))) 
    return(tmp) 
    }) 

    ## updateSelectInput 
    observe({ 
    updateSelectizeInput(session,'group', choices=sort(unique(choices()$group)), selected=sort(unique(choices()$group))) 
    updateSelectizeInput(session,'dept', choices=sort(unique(choices()$department)), selected=sort(unique(choices()$department))) 
    updateSelectizeInput(session,'country', choices=sort(unique(choices()$country)), selected=sort(unique(choices()$country))) 
    }) 

    ## reset filters 
    observeEvent(input$reset_filters, { 
    updateSelectizeInput(session,'group', choices=df$group, selected=df$group) 
    updateSelectizeInput(session,'dept', choices=df$department, selected=df$department) 
    updateSelectizeInput(session,'country', choices=df$country, selected=df$country) 
    }) 

    output$table1 <- renderTable({choices()}) 
} 

shinyApp(ui,server)