R/Shiny 应用程序中的三个相互依赖的 selectInput

Posted 2023-03-24

【中文标题】R/Shiny 应用程序中的三个相互依赖的 selectInput

【英文标题】：three interdependent selectInput in R/Shiny application

【发布时间】：2017-07-15 04:31:38

【问题描述】：

我正在开发一个 R/Shiny 应用程序，它的功能之一应该是基于某些过滤器导出数据。然而，过滤器相互依赖。考虑一个公司列表，每个公司都有一些团队或部门，这些团队或部门可以位于不同的国家。 The user can filter the data to export through three drop-down menus (selectInput), but I would like that when one dimension (ie group) is selected the choices in the drop-down list for the other two dimensions (ie departments and countries ) 相应更新。但是，在第二个维度（即部门）上进行过滤应该缩小选择范围，而不是更新所有 selectInput 的选择。

下面的代码是我能得到的最接近所需输出的代码。 然而有两个问题。首先，在第二个维度上过滤 不会缩小选择范围，但也会更新选择 第一个选定的维度。其次，即使选择是 更新选择不保留在输入字段中 空白。

知道如何解决这个问题吗？

编辑

下面的代码几乎可以工作了。现在，无论首先选择哪个维度，其余两个维度的选择都会正确更新，并且在第二个维度上进行过滤确实会缩小选择范围。但是，尽管多个 = 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)

【问题讨论】：

我猜this 和你想要的有点相似。

谢谢，但这不是我想要的。当您选择专员时，社区的选择会更新，但实践的选择不会更新。同样，如果你从街区开始，做法会更新，但专员不会更新。最后，如果你从实践开始，什么都不会更新。我基本上希望有可能从任何维度开始并在级联中更新所有其他维度。

【参考方案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)