Selecting multiple values from checkboxGroupInput and plotting

Question

Hi all and happy new year,

with the below code, I am trying to have it so that the user can filter data to look at whatever combination of days of the week they desire, so, for example, they will be able to select the data from 'Mondays' and 'Thursdays'. Currently the ggplot plots just the data from the first value checked, so, for example, if 'Mondays' and 'Thursdays' are both checked only the data from 'Mondays' will be shown. N.B there's also a checkbox in the code which is working fine.

    ui <- fluidPage(
  titlePanel("Transfers Analysis App"),


  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("Day", "Days of Week", c("All", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), selected="All"),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
             plotOutput("plot1", height = "600px", width = "100%",
             hover = hoverOpts(id = "plot_hover")),
       verbatimTextOutput("hover_info")

)))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage


    if(Day == "Monday")
      data<-data[data$day == "Monday"]
    if(Day == "Tuesday")
      data<-data[data$day == "Tuesday"]
    if(Day == "Wednesday")
      data<-data[data$day == "Wednesday"]
    if(Day == "Thursday")
      data<-data[data$day == "Thursday"]
    if(Day == "Friday")
      data<-data[data$day == "Friday"]
    if(Day == "Saturday")
      data<-data[data$day == "Saturday"]

    #ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #plot(data$Date,data$NUMBER_OF_TRANSFERS, xlab = "Date", ylab = "Transfers") 

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
      #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })

Answer 1

There is wonderful %in% operator which will do what you want:

library(ggplot2)
library(shiny)

ui <- fluidPage(
  titlePanel("Transfers Analysis App"),


  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("Day", "Days of Week", c("All", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), selected="All"),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
      plotOutput("plot1", height = "600px", width = "100%",
                 hover = hoverOpts(id = "plot_hover")),
      verbatimTextOutput("hover_info")

    )))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage
    if(input$Day != "All"){
      data <- data[data$day %in% input$Day,]
    }

    #ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #plot(data$Date,data$NUMBER_OF_TRANSFERS, xlab = "Date", ylab = "Transfers") 

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })
}

shinyApp(ui, server)

I also really like the shinyWidgets package which has the Select All feature in its pickerInput:

library(ggplot2)
library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  titlePanel("Transfers Analysis App"),

  sidebarLayout(
    sidebarPanel(
      pickerInput(inputId = "Day", 
                  label = "Days of Week", 
                  choices = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"), options = list(`actions-box` = TRUE), 
                  multiple = T),
      checkboxInput("Outage", "Highlight Days when an Outage Occured", FALSE)),

    mainPanel(
      plotOutput("plot1", height = "600px", width = "100%",
                 hover = hoverOpts(id = "plot_hover")),
      verbatimTextOutput("hover_info")

    )))


server <- function(input, output) {

  output$plot1 <- renderPlot({
    Day <- input$Day
    Month <- input$Month
    Outage <- input$Outage
    data[data$day %in% input$Day,]

    if(Outage == TRUE)
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS, colour = Incident)) + geom_point() + scale_colour_manual(values=c( "red", "black"))

    else
      ggplot(data, aes(Date, NUMBER_OF_TRANSFERS)) + geom_point()
    #points(data$Date[data$Quantity == "1"],data$NUMBER_OF_TRANSFERS[data$Quantity == "1"], col='red')
  })
}

shinyApp(ui, server)