更新多个相关的 selectizeInput() 控制通过这些输入选择过滤的反应数据集
Posted
技术标签:
【中文标题】更新多个相关的 selectizeInput() 控制通过这些输入选择过滤的反应数据集【英文标题】：Update multiple related selectizeInput() controlling a reactive dataset filtered through these inputs choices 【发布时间】：2021-04-26 03:57:29 【问题描述】：我有一个简单的闪亮应用程序，当我启动它时会加载一个数据集。该应用程序有不同的selectizeInput()，用户可以在其中选择一个或多个不同变量的值，他/她可以使用这些值过滤数据集。在以下可重现的示例中，我在过滤时在服务器中创建的反应性数据集通过表格显示：
library(dplyr)
library(shiny)
dataset <- data.frame("Letters" = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C"),
"Numbers" = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9),
"LettersNumbers" = c("G5", "G5", "G5", "G5", "G5", "G5", "F7", "F7", "F7", "F7", "F7", "F7", "E9", "E9", "E9", "E9", "E9", "E9"))
ui <- fluidPage(
br(),
fluidRow(
column(width = 4,
selectizeInput(inputId = "letters",
label = "Letters",
choices = unique(dataset$Letters),
multiple = TRUE),
br(),
selectizeInput(inputId = "numbers",
label = "Numbers",
choices = unique(dataset$Numbers),
multiple = TRUE),
br(),
selectizeInput(inputId = "lettersnumbers",
label = "Letters & Numbers",
choices = unique(dataset$LettersNumbers),
multiple = TRUE)
),
column(width = 4,
tableOutput(outputId = "table")
),
column(width = 4,
textOutput(outputId = "text")
)
)
)
server <- function(input, output, session)
# Filter the initial dataset
dataset_filtered <- reactive(
dataset_filtered <- dataset
if (!is.null(input$letters))
dataset_filtered <- dataset_filtered %>%
filter(Letters %in% c(input$letters))
if (!is.null(input$numbers))
dataset_filtered <- dataset_filtered %>%
filter(Numbers %in% c(input$numbers))
if (!is.null(input$lettersnumbers))
dataset_filtered <- dataset_filtered %>%
filter(LettersNumbers %in% c(input$lettersnumbers))
return(dataset_filtered)
)
# Display filtered table
output$table <- renderTable(
dataset_filtered()
)
# Display warning message
output$text <- renderText(
if (nrow(dataset_filtered()) == 0)
print("No combinations available")
)
shinyApp(ui = ui, server = server)
问题：三个变量的重要性完全相同。现在让我们举一个过滤的例子：假设我选择值 A 和 B。从表中可以看出，在 Numbers 列中，我只有从 1 到 8 的值，而不是 9。现在，在第二个selectizeInput() (Numbers) 中，我选择了 9，并且表格如预期的那样有 0 行，并显示警告消息。
但是，如果从同一个 selectizeInput() 我同时选择 9 和 1 一些值将显示，因为过滤器考虑 1在创建的反应向量中可用，并为此过滤。
在我看来，对这个接口进行编程的最佳方式是在选择其中任何一个时响应更新每个selectizeInput()。换句话说，如果我从第一个输入中选择 A 和 B，则数字 9 应该不会在第二个输入中可用。 这应该对我所有的输入都有效，没有比其他输入更重要的输入。
我尝试了几种解决方案，也使用updateSelectizeInput()，但似乎没有任何效果。你有什么建议吗？谢谢！
【问题讨论】：
【参考方案1】：updateSelectizeInput() 和observeEvent() 的组合应该满足您的要求。试试这个：
dataset <- data.frame("Letters" = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C"),
"Numbers" = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9),
"LettersNumbers" = c("G5", "G5", "G5", "G5", "G5", "G5", "F7", "F7", "F7", "F7", "F7", "F7", "E9", "E9", "E9", "E9", "E9", "E9"))
ui <- fluidPage(
br(),
fluidRow(
column(width = 4,
selectizeInput(inputId = "letters",
label = "Letters",
choices = unique(dataset$Letters),
multiple = TRUE),
br(),
selectizeInput(inputId = "numbers",
label = "Numbers",
choices = unique(dataset$Numbers),
multiple = TRUE),
br(),
selectizeInput(inputId = "lettersnumbers",
label = "Letters & Numbers",
choices = unique(dataset$LettersNumbers),
multiple = TRUE)
),
column(width = 4,
tableOutput(outputId = "table")
),
column(width = 4,
textOutput(outputId = "text")
)
)
)
server <- function(input, output, session)
# Filter the initial dataset
dataset_filtered <- reactive(
dataset_filtered <- dataset
if (is.null(input$letters) & is.null(input$numbers) & is.null(input$lettersnumbers))
dataset_filtered <- dataset
updateSelectizeInput(session, inputId="letters",choices=dataset$Letters, selected=NULL)
updateSelectizeInput(session, inputId="numbers",choices=dataset$Numbers, selected=NULL)
updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset$LettersNumbers, selected=NULL)
else
if (!is.null(input$letters))
dataset_filtered <- dataset_filtered %>%
filter(Letters %in% c(input$letters))
if (!is.null(input$numbers))
dataset_filtered <- dataset_filtered %>%
filter(Numbers %in% c(input$numbers))
if (!is.null(input$lettersnumbers))
dataset_filtered <- dataset_filtered %>%
filter(LettersNumbers %in% c(input$lettersnumbers))
return(dataset_filtered)
)
observeEvent(input$letters,
updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset_filtered()$LettersNumbers, selected=NULL)
updateSelectizeInput(session, inputId="numbers",choices=dataset_filtered()$Numbers, selected=NULL)
)
observeEvent(input$numbers,
updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset_filtered()$LettersNumbers, selected=NULL)
updateSelectizeInput(session, inputId="letters",choices=dataset_filtered()$Letters, selected=NULL)
)
observeEvent(input$lettersnumbers,
updateSelectizeInput(session, inputId="letters",choices=dataset_filtered()$Letters, selected=NULL)
updateSelectizeInput(session, inputId="numbers",choices=dataset_filtered()$Numbers, selected=NULL)
)
# Display filtered table
output$table <- renderTable(
dataset_filtered()
)
# Display warning message
output$text <- renderText(
if (nrow(dataset_filtered()) == 0)
print("No combinations available")
)
shinyApp(ui = ui, server = server)
【讨论】：
以上是关于更新多个相关的 selectizeInput() 控制通过这些输入选择过滤的反应数据集的主要内容，如果未能解决你的问题，请参考以下文章
R Shiny：使用 Leaflet Map Click 更新多个相关下拉菜单
Shiny：根据选择更新 selectizeInput 选择
Shiny：基于选定级别的 SelectizeInput 条件更新