我正在使用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)
答案 0 :(得分: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)