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)}
)
}
)
}