Как я могу создать несколько входов в моем блестящем приложении с обновлением и множественным выбором?

Question

Я строю приложение flex dashboard/shiny с datatable и пытаюсь построить в два входа в качестве выбора для этого datatable с выбором «Все» для каждого выбора. Первый вопрос: как я могу ограничить второй выбор "user" по выбору первого выбора "team"?

Затем, используя эти входы, я хотел бы подмножить свои данные в любой комбинации двух вариантов ex. Team Все, пользователь «Darwin D» будет возвращать одну DataTable строку с его именем, команды и другие показатели, которые будут добавлены и т.д.

Все код для гибкого уценки документа ниже:

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

```{r setup, include=FALSE} 
library(shiny) 
library(shinydashboard) 
library(flexdashboard) 
library(magrittr) 
library(feather) 
library(anytime) 
library(data.table) 
library(DT) 
library(datasets) 


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) 
users <- data.frame(Name,Team) 
remove(Name,Team) 
``` 



Inputs {.sidebar} 
======================================================================= 

### Input Variables 

```{r global_input} 
# input variable to call selection, name of field, selections/options variable 
dateRangeInput('dateRange', 
    label = 'Date range input: yyyy-mm-dd', 
    start = Sys.Date() - 8, 
    end = Sys.Date() - 1, 
    min = "2013-01-01", 
    max = Sys.Date() -1 
    ) 

selectInput("teaminput","Team", c("All",unique(users$Team))) 

observe({ 
    if(input$teaminput == "All") { 
     subDT <- copy(users) 
    } else { 
     subDT <- users[ users$Team == input$teaminput, ] 
    } 

    updateSelectInput(
     "userinput", 
     label = "User Name", 
     choices = c("All", unique(subDT$Name)) 
    ) 
}) 
``` 

### Intake Coordinator KPIs 

```{r daily_table} 
# reactive data object based on inputs above 
daily_dt <- reactive({ 
    if(input$teaminput == "All"){ 
     subDT 
} else{ 
    subset(subDT$Team == input$teaminput) 
} 
    }) 

# render DT datatable object with sorts/search 
renderDataTable(daily_dt()) 
``` 

Answer 1

Вы можете использовать 2 reactive, первый фильтровать data.frame команды, второй для фильтрации результата первого по имени:

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

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

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), stringsAsFactors = FALSE) 
``` 

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

```{r global_input} 
selectInput("teaminput","Team",c("All", unique(users$Team)), selected="All") 
selectInput("userinput","User Name", c("All", unique(users$Name)), selected="All") 

teamFiltered <- reactive(users[input$teaminput=="All" | users$Team==input$teaminput,]) 

observe(updateSelectInput(session,"userinput", choices = c("All", unique(teamFiltered()$Name)), selected="All")) 
``` 

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

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

renderDataTable(userFiltered()) 
``` 

Answer 2

Примечание я могу 't проверить это, если вы не представите воспроизводимый пример, но что-то в этом направлении должно работать. Вам нужна реактивная функция в вашем server, которая включает в себя этап подмножества и вызов updateSelectInput. Это приведет к обновлению ввода в вашем ui в любое время, когда срабатывает реакция.

observe({ 
    if(input$team == "All") { 
     subDT <- copy(DT) 
    } else { 
     subDT <- DT[ Team == input$team, ] 
    } 

    updateSelectInput(
     "user", 
     label = "User Name", 
     choices = c("All", unique(subDT$Name)) 
    ) 

}) 

Так в любое время input$team меняется, мы создаем подмножество на основе этого выбора, и использовать это подмножество, чтобы обновить поле ввода user.