为什么使用多个反应式表达式过滤反应式数据框不起作用?

时间:2019-03-28 09:21:44

标签: r dplyr flexdashboard

我正在尝试比较 flexdashboard 中两个数据框之间的差异。为了帮助解决这个问题,我允许用户过滤某些属性。我遇到的问题是“ all”过滤器的实现,我使用与here类似的技术来实现。此代码与我的代码之间的区别在于,我没有更新selectizeInput对象,而是将过滤器项存储在另一个反应式表达式中(下面的selected_gearselected_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)
        )
      })

0 个答案:

没有答案