Почему фильтрация реактивного кадра данных с использованием нескольких реактивных выражений не работает? - PullRequest
0 голосов
/ 28 марта 2019

Я пытаюсь сравнить различия между двумя фреймами данных в flexdashboard .Чтобы помочь с этим, я разрешаю пользователю фильтровать определенные атрибуты.Проблема, с которой я столкнулся, связана с реализацией фильтра «все», что я и сделал, используя технику, аналогичную здесь .Разница между этим и моим кодом заключается в том, что вместо обновления объекта selectizeInput я сохраняю термин фильтра в другом реактивном выражении (selected_gear и selected_carb ниже).

С одним термином фильтра панель управления работает какожидается;с двумя кажется, что приборная панель сдается и сохраняет только первое значение.

Есть идеи?


    ---
    title: "SO question"
    author: "RDavey"
    date: "27 March 2019"
    output:
      flexdashboard::flex_dashboard:
      runtime: shiny
    ---

    ```{r global, include=FALSE}
    # load data in 'global' chunk so it can be shared by all users of the dashboard
    library(shiny)
    library(shinythemes)
    library(DT)
    library(tidyverse)

    theme_set(theme_minimal())
    theme_update(text = element_text(size = 14),
                 panel.grid.major.y = element_blank(),
                 panel.grid.minor.y = element_blank())

    # split mtcars in two
    idx_split <- sample(1:nrow(mtcars),nrow(mtcars)/2)
    mtcars1 <- mtcars[idx_split,]
    mtcars2 <- mtcars[-idx_split,]

    ```

    Column {.sidebar}
    =======================================================================

    Results comparison tool.
    ```{r}

    choices_gear <- c("ALL",paste(unique(unique(mtcars1$gear), unique(mtcars2$gear)), sep = ","))
    choices_carb <- c("ALL", paste(unique(unique(mtcars1$carb), unique(mtcars1$carb)), sep = ","))

    selectizeInput("gear", label = "Gear:",
                choices = choices_gear, 
                selected = "ALL",
                #selectize = T,
                multiple = T)

    selectizeInput("carb", label = "Carb:",
                choices = choices_carb, 
                selected = "ALL", 
                #selectize = T,
                multiple = T)

    # This handles the "ALL" option and becomes the term used for filtering the dataframe ----
    selected_gear <- reactive({
      ifelse("ALL" %in% input$gear,{
        # choose all the choices _except_ "ALL"
        selected_gear <- setdiff(choices_gear, "ALL")
      }, {
        selected_gear <- input$gear
      })
    })

    # Same for site
    selected_carb <- reactive({
      ifelse("ALL" %in% input$carb,{
        # choose all the choices _except_ "ALL"
        selected_carb <- setdiff(choices_carb, "ALL")
        # Decided not to update the selectInput object as this could be too busy for multiple choices
        #updateSelectInput(session, "scenario", selected = selected_scenario)
      }, {
        selected_carb <- input$carb
      })
    })
    #-----------

    # Reactive expression for dataframes to compare ----
    show_mtcars1 <- reactive({
      mtcars1 %>%
        filter(gear %in% selected_gear()) %>%
        filter(carb %in% selected_carb())
    })

    show_mtcars2 <- reactive({
      mtcars2 %>%
        filter(gear %in% selected_gear()) %>%
        filter(carb %in% selected_carb())
    })

    show_diff <- reactive({
      setdiff(show_mtcars1(), show_mtcars2())
    })

    ```

    Data
    =======================================================================
    Column {.tabset}
    -----------------------------------------------------------------------

    ### Mtcars1

    ```{r}
    renderDT({
      datatable(data = show_mtcars1(),
                  #filter = "top",
                  selection = "none",
                  rownames = FALSE, 
                  editable = F,
                  style = "bootstrap",
                  options = list(scrollX = T)
      )
    })
    ```

    ### Mtcars2
    ```{r}
    renderDT({
      datatable(data = show_mtcars2(),
                  #filter = "top",
                  selection = "none",
                  rownames = FALSE, 
                  editable = F,
                  style = "bootstrap",
                  options = list(scrollX = T)
      )
    })
    ```

    ### Difference
    ```{r}
      renderDT({
        datatable(data = show_diff(),
                  #filter = "top",
                  selection = "none",
                  rownames = FALSE, 
                  editable = F,
                  style = "bootstrap",
                  options = list(scrollX = T)
        )
      })

...