在 Flexdashboard 中使用选择和复选框过滤数据

Question

在 flexdashboard 中，我想通过将 selectInput() 与 checkboxGroupInput() 结合来允许选择。但是数据没有正确更新，我不知道出了什么问题。

我使用了这个 SO-example [LINK] 中的玩具示例，并包含了一个复选框。似乎 Checkbox 仍然被忽略并弄乱了代码的其他部分。

如果有人可以调整代码以便选择可以基于团队、名称或年份三列之一，那就太好了。

---
title: "example"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    runtime: shiny
---

```{r setup, include=FALSE}
library(DT)
library(shiny)

users <- data.frame(
  Name = c("Allan A","Barbara B","Charles C","Darwin D","Evelyn E","Frank F","Greg G","Hans H"),
  Team = c(1,2,3,3,2,1,2,2),
  Year = c(1999,1999,1999,2000,2000,2000,2003,2003), 
  stringsAsFactors = FALSE)
```

Inputs {.sidebar}
=======================================================================
### Input Variables

```{r global_input}

### selection Input based on columns Team and Name
selectInput("teaminput","Team",c("All", unique(users$Team)), selected="All")
selectInput("userinput","User Name", c("All", unique(users$Name) ), selected="All")

### Add Input from CheckboxGroup based on Year starting with all
checkboxGroupInput("yearinput", label = "Year",choices =  unique(users$Year), selected=unique(users$Year), inline = TRUE)


### Filter Team based on one of the three choices (Team, Name, Year)
teamFiltered <- reactive(users[input$teaminput=="All" | 
                                 users$Team==input$teaminput |
                                 users$Year ==input$yearinput,])

### Observe if userinput changes based on SELECTION
observe(updateSelectInput(session,"userinput", 
                          choices = c( unique(teamFiltered()$Name)), 
                          selected="All"))

### Observe if yearinput changes based on CHECK BOX
observe(updateCheckboxGroupInput(session,"yearinput", 
                                  choices =  teamFiltered()$Year,
                                  selected="All"))

```

Results
=======================================================================
### Intake Coordinator KPIs

```{r daily_table}
userFiltered <- reactive(teamFiltered()[input$userinput=="All" | 
                         teamFiltered()$Name==input$userinput | 
                         teamFiltered()$Year==input$yearinput,])

renderDataTable(userFiltered())
```

Answer 1

试试这个

library(DT)
library(shiny)

users <- data.frame(
  Name = c("Allan A","Barbara B","Charles C","Darwin D","Evelyn E","Frank F","Greg G","Hans H"),
  Team = c(1,2,3,3,2,1,2,2),
  Year = c(1999,1999,1999,2000,2000,2000,2003,2003),
  stringsAsFactors = FALSE)

ui <- fluidPage(

### selection Input based on columns Team and Name
selectInput("teaminput","Team",c("All", unique(users$Team)), selected= "All", multiple = TRUE),
selectInput("userinput","User Name", c("All", unique(users$Name) ), selected="All", multiple = TRUE),

### Add Input from CheckboxGroup based on Year starting with all
checkboxGroupInput("yearinput", label = "Year",choices =  unique(users$Year), selected=unique(users$Year), inline = TRUE),
DTOutput("t1")

)

server <- function(input, output, session) {
### Filter Team based on one of the three choices (Team, Name, Year)
teamFiltered <- reactive(users["All" %in% input$teaminput |
                                 users$Team %in% input$teaminput,])

### Observe if userinput changes based on SELECTION
observeEvent(c(input$yearinput,input$teaminput), {
  updateSelectInput(session,"userinput", choices = c( unique(teamFiltered()$Name)), selected=unique(teamFiltered()$Name)
                    )
  })

### Observe if yearinput changes based on CHECK BOX
observeEvent(c(input$userinput,input$teaminput), {
  updateCheckboxGroupInput(session,"yearinput", choices =  unique(teamFiltered()$Year),
                                 selected=unique(teamFiltered()$Year))
  })

  ### Intake Coordinator KPIs

userFiltered <- reactive(teamFiltered()[ "All" %in% input$userinput |
                                          teamFiltered()$Name %in% input$userinput &
                                          teamFiltered()$Year %in% input$yearinput,])

output$t1 <- renderDT(userFiltered())

}

shinyApp(ui, server)