首页 文章

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

提问于
浏览 次
0

我正在研究R / Shiny应用程序，它的一个功能应该是基于某些过滤器导出数据 . 但是过滤器相互依赖 . 考虑公司列表，每个公司都有一些团队或部门，这些可以位于不同的国家 . 用户可以通过三个下拉菜单（selectInput）过滤要导出的数据，但我希望在选择一个维度（即组）时，在下拉列表中为其他两个维度（即部门和国家/地区）选择）相应更新 . 但是，对第二维（即部门）进行过滤应缩小选择范围，而不是更新所有selectInput的选择 .

下面的代码是我可以获得所需输出的最接近的代码 . 但是有两个问题 . 首先，对第二维进行过滤不会缩小选择范围，但也会更新第一个选定维的选项 . 其次，即使选项被更新，选择也不会保留在输入字段中，而输入字段仍为空白 .

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

Edit

下面的代码几乎正常工作 . 现在没有问题首先选择哪个维度，其余两个维度的选择是否正确更新，而第二个维度的筛选确实缩小了选择范围 . 但是，尽管multiple = TRUE，但我无法为每个selectInput选择多个项目 .

Any idea on how to solve this problem ?

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)
r shiny reactive-programming

1 回答

  • 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)
    回复于

相关问题