R/Shiny 应用程序中的三个相互依赖的 selectInput [英] three interdependent selectInput in R/Shiny application

问题描述

我正在开发一个 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 的选择.

I'm working on a R/Shiny application and one of its features should be to export data based on some filters. However the filters depends on each other. Consider a list of companies, each companies has some teams or departments and these can be located in different countries. The user can filter the data to export through three drop-down menus (selectInput), but I would like that when one dimension (i.e. group) is selected the choices in the drop-down list for the other two dimensions (i.e. departments and countries) are updated accordingly. However filtering on a second dimension (i.e. departments) should narrow down the selection rather than updating all the selectInput's choices.

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

The code below is the closest I could get to the desired output. However there are two problems. First, filtering on a second dimension does not narrow down the selection, but updates also the choices for the first selected dimension. Second, even though the choices are updated the selection is not kept in the input field which remains blank.

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

Any idea how to approach this problem ?

编辑

下面的代码几乎可以工作了.现在无论首先选择哪个维度，其余两个维度的选择都会正确更新，并且对第二个维度进行过滤确实缩小了选择范围.但是，尽管 multiple = TRUE，但我无法为每个 selectInput 选择多个项目.

The code below is almost working. Right now no matters which dimension is selected first, the choices for the remaining two dimensions are correctly updated and filtering on a second dimension does narrow down the selection. However, I'm not able to select more than one item per selectInput despite the multiple = TRUE.

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

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)

推荐答案

我一直在寻找类似问题的解决方案，但遇到了这个问题.

I've been looking for a solution for a similar problem and came across this.

感谢几乎可以工作的示例！我刚刚切换到 selectizeInput 并且它似乎对我有用.如果您还在研究这个，这是否满足您的需求?

Thanks for the almost-working example! I just switched to selectizeInput and it seems to work for me. Does this meet your need if you are still looking into this?

但是，有一个问题是无法返回并重新过滤，因为选择已经消失了.我添加了一个重置​​过滤器按钮来解决这个问题.

One problem, though, is that there's no way of coming back and re-filter because the choices would have been gone. I added a reset filter button to get around that.

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)

这篇关于R/Shiny 应用程序中的三个相互依赖的 selectInput的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！