0

I have two filters that are used to filter a dataframe (interactively).

  • When the first filter has a value and the second filter is empty, the dataframe is filtered based on the first filter.
  • When the second filter has a value and the first filter is empty, the dataframe is filtered based on the second value.
  • When the first and second filters have values, the dataframe is filtered based on the two values.

The last condition is the one that is currently not working.

Here is the code of the main app.R script :

## 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)}
        )
      }
    )
  }
desertnaut
  • 57,590
  • 26
  • 140
  • 166
Rémi Pts
  • 59
  • 1
  • 7
  • You will increase the likelihood of getting proper answers if you provide a **minimal** and **reproducible** example of your problem. See also: [how to give a reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example). I for my part could help, but your code is unfortunately not reproducible for me. – thothal Mar 07 '19 at 12:22
  • @thothal I just updated the post and added a sample dataframe at the beginning. – Rémi Pts Mar 07 '19 at 12:41

1 Answers1

0

It might simply be down to this line:

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

Are you trying to use the dplyr::filter? If so you can simply give the column name and the variable you want to filter on, something like this:

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

As an additional note, I don't think you really need the reactiveValues for the true/false flags as you can usually check whether an input is set via is.null.

Hope this helps.

Harvey Ellis
  • 596
  • 1
  • 3
  • 12