Фильтр данных в Shiny

Question

Я немного застрял с проблемой в Shiny.Проблема заключается в следующем: у меня есть два фильтра, которые используются для фильтрации данных (в интерактивном режиме).

• Когда первый фильтр имеет значение, а второй фильтр пуст, кадр данных фильтруется на основе первого фильтра.
• Когда второй фильтр имеет значение, а первый фильтр пуст, кадр данных фильтруется на основе второго значения.
• Когда первый и второй фильтры имеют значения, кадр данных фильтруется на основе двух значений.

Последнее условие - это то, которое в данный момент не работает.

Вот код основного скрипта app.R:

## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
library(writexl)

Mesure <- c('Mesure 1', 'Mesure 2', 'Mesure 3')
Media <- c('TV', 'Radio', 'PQ')
Variable <- c(1,2,3)
postTestsData <- data.frame(Mesure, Media, Variable)


if(interactive()){

    shinyApp(

    ui <- dashboardPage(
      dashboardHeader(
        title = "Aless' Data"
      ),

      dashboardSidebar(
        sidebarMenu(
          menuItem("Database", tabName = "database", icon = icon("fas fa-database")),
          menuItem("Post-tests", tabName = "posttests", icon = icon("fas fa-vial"), menuSubItem('Table of data', tabName = 'datapost'), menuSubItem('Graphs', tabName = 'graphspost'))
        )
      ),

      dashboardBody(
        tabItems(
          tabItem(
            tabName = "database", 
            fluidRow(
              box(
                title = "Télécharger la base de données", downloadButton("dl", "Télécharger"), solidHeader = TRUE, status = 'primary'
              ),
              box(
                title = "Filtrer la base de données", 
                selectInput(
                  "variable", "Variables : ", choices = namesCol
                  , multiple = TRUE
                ), solidHeader = TRUE, status = 'primary'
              )
            ),
            fluidRow(
              box(
                dataTableOutput("data"), width = 100
              )
            )
          ),
          tabItem(
            tabName = "datapost", 
            fluidPage(
              box(
                title = "Filtrer les mesures",
                selectInput("mesures", "Mesures : ", choices = namesMesure, multiple = TRUE),
                solidHeader = TRUE, 
                status = 'primary'
              ),
              box(
                title = "Filtrer les médias",
                selectInput("medias", "Média : ", choices = namesMedia, multiple = TRUE),
                solidHeader = TRUE, 
                status = 'primary'
              )
            ),
            fluidRow(
              box(
                dataTableOutput("posttestsdata"), width = 100
              )
            )
          ),
          tabItem(
            tabName = "graphspost",
            fluidRow(
              box(
                title = "Filter les mesures"
              )
            )
          )
        )
      )
    ),

    server <- function(input, output) {

        # Filter the post tests table
        observeEvent(input$medias,{
          vals$mesures=FALSE
          vals$medias=TRUE
        })

        observeEvent(input$mesures,{
          vals$mesures=TRUE
          vals$medias=FALSE
        })

        posttestsdata <- eventReactive(c(vals$mesures, vals$medias, input$mesures, input$medias),{
          if(vals$mesures == TRUE){
            str(vals$mesures)
            tempData <- subset(postTestsData, Mesure %in% as.character(input$mesures))
            print('step 1')
          }
          else if (vals$medias == TRUE){
            str(vals$medias)
            tempData <- subset(postTestsData, Media %in% as.character(input$medias))
            print('step 2')
          }
          else if((vals$mesures == TRUE) & (vals$medias == TRUE)) {
            tempData <- filter(postTestsData, (Media %in% as.character(input$medias)) & (Mesure == input$mesures))
            print('step 3') 
          } 

          return(tempData)

        })

        output$posttestsdata <- renderDataTable({
          posttestsdata()
        })

        # Select the column of the database that the user wants to see
        output$data <- DT::renderDataTable(
          data[, c("ID", input$variable), drop = FALSE],
          options = list(scrollX = TRUE),
          filter = 'top',
          rownames = FALSE
        )

        # Download database
        output$dl <- downloadHandler(
          filename = function() {"test.xlsx"},
          content = function(file) {write_xlsx(data, path = file)}
        )
      }
    )
  }

Заранее спасибо за помощь,

Реми

Answer 1

Это может быть просто до этой строки:

filter(postTestsData, (Media %in% as.character(input$medias)) & (Mesure == input$mesures)

Вы пытаетесь использовать dplyr::filter? Если это так, вы можете просто дать имя столбца и переменную, по которой вы хотите фильтровать, что-то вроде этого:

dplyr::filter(postTestsData, Media == !!input$medias, Mesure == !!input$mesures)

Как дополнительное примечание, я не думаю, что вам действительно нужны реактивные значения для флагов истина / ложь, поскольку вы обычно можете проверить, установлен ли вход с помощью is.null.

Надеюсь, это поможет.