динамическая / условная фильтрация в блестящем режиме выбора нескольких входов (selectizeInput, множественный = ИСТИНА) - PullRequest
0 голосов
/ 07 октября 2019

Как правильно подходить к динамической / условной фильтрации в блестящих входах (selectizeInput), где multiple = TRUE?

В этом примере я пытаюсь показать родительские фильтры, ограниченные фильтром прародителя (любым, all, none), а затем дочерние фильтры, ограниченные родительским фильтром.

Ошибка в .getReactiveEnvironment () $ currentContext: Операция не разрешена без активного реактивного контекста. (Вы пытались сделать что-то, что можно сделать только из реактивного выражения или наблюдателя.)

---
title: "Example"
runtime: shiny
output:
  flexdashboard::flex_dashboard:
  vertical_layout: fill
---


```{r}
library(tidyverse)
library(flexdashboard)
library(shinyWidgets)
```

```{r global, include=FALSE}
filter_df <- data.frame(filter_GP = c("gpA", "gpA", "gpA", "gpB", "gpB", "gpB"),
                        filter_P = c("p1", "p1", "p2", "p3", "p4", "p4"),
                        filter_C = c("g", "h", "i", "j", "k", "l"))

data_df <- data.frame(y = seq(from=1, to=12),
                      filter_C = c("g", "g", "h", "h", "i", "i", "j", "j", "k", "k", "l", "l"))

data_df <- 
data_df %>%
  left_join(filter_df, by="filter_C")
```


Sidebar {.sidebar}
=====================================

```{r}
# grandparents
  selectizeInput("GP", label = "Grandparents (multi-select):", 
                 choices = unique(filter_df$filter_GP), 
                 multiple = TRUE,
                 selected = "")

# parents
  selectizeInput("P", label = "Parents (multi-select):",
                 choices = unique(filter_df[filter_df$filter_GP %in% input$GP, "filter_P"]), 
                 multiple = TRUE,
                 selected = "")

# children
  selectizeInput("C", 'Children (multi-select):', 
                 choices = unique(filter_df[filter_df$filter_P %in% input$P, "filter_C"]), 
                 multiple = TRUE,
                 selected = "")
```



Test 
=====================================

Обновление

Вот версия flexdashboardрешения от @ heds1:

---
title: "Example"
runtime: shiny
output:
  flexdashboard::flex_dashboard:
  vertical_layout: fill
---


```{r}
library(tidyverse)
library(flexdashboard)
library(shinyWidgets)
```

```{r global, include=FALSE}
filter_df <- data.frame(filter_GP = c("gpA", "gpA", "gpA", "gpB", "gpB", "gpB"),
                        filter_P = c("p1", "p1", "p2", "p3", "p4", "p4"),
                        filter_C = c("g", "h", "i", "j", "k", "l"))

data_df <- data.frame(y = seq(from=1, to=12),
                      filter_C = c("g", "g", "h", "h", "i", "i", "j", "j", "k", "k", "l", "l"))

data_df <- 
data_df %>%
  left_join(filter_df, by="filter_C")
```


Sidebar {.sidebar}
=====================================

```{r}
# grandparents
  selectizeInput("GP", label = "Grandparents (multi-select):", 
                 choices = unique(filter_df$filter_GP), 
                 multiple = TRUE,
                 selected = "")

# parents
  output$P <- renderUI({
        df <- data_df[data_df$filter_GP %in% input$GP, ]
        selectizeInput(
                    'P', 'Parents', choices = unique(df$filter_P), multiple = TRUE
                )
    })

  uiOutput("P")

# children
  output$C <- renderUI({
        df <- data_df[data_df$filter_GP %in% input$GP, ]
        df <- df[df$filter_P %in% input$P, ]
        selectizeInput(
                    'C', 'Children', choices = unique(df$filter_C), multiple = TRUE
                )
    })

  uiOutput("C")
```



Test 
=====================================

1 Ответ

1 голос
/ 08 октября 2019

Вы можете сделать это, используя uiOutput с selectizeInput. Я не знаю, что такое flexdashboard и ceramicWidgets, но используя саму себе, вы можете сделать это следующим образом:

library(shiny)
library(tidyverse)

filter_df <- data.frame(filter_GP = c("gpA", "gpA", "gpA", "gpB", "gpB", "gpB"),
                        filter_P = c("p1", "p1", "p2", "p3", "p4", "p4"),
                        filter_C = c("g", "h", "i", "j", "k", "l"))

data_df <- data.frame(y = seq(from=1, to=12),
                      filter_C = c("g", "g", "h", "h", "i", "i", "j", "j", "k", "k", "l", "l"))

data_df <- 
data_df %>%
  left_join(filter_df, by="filter_C")

ui <- {
    fluidPage(
        # grandparents
        selectizeInput("GP", label = "Grandparents (multi-select):", 
                            choices = unique(filter_df$filter_GP), 
                            multiple = TRUE,
                            selected = ""),
        uiOutput("P"),
        uiOutput("C")
    )
}

server <- function(input, output, session) {

    output$P <- renderUI({
        df <- data_df[data_df$filter_GP %in% input$GP, ]
        selectizeInput(
                    'P', 'Parents', choices = unique(df$filter_P), multiple = TRUE
                )
    })

    output$C <- renderUI({
        df <- data_df[data_df$filter_GP %in% input$GP, ]
        df <- df[df$filter_P %in% input$P, ]
        selectizeInput(
                    'C', 'Children', choices = unique(df$filter_C), multiple = TRUE
                )
    })
}

shinyApp(ui, server)

ans

...