Multiple selection not possible when "Select All" option is given in the filter

[kuttan98]

Hi,
I am having a data used for monitoring surveys. I am checking the scores of few supervisors over a period of time till the completion of the project. Basically I want a line graph that can help me do it. In the app I have built, when I select all the supervisors, the app shows error. I have 3 supervisors here in the sample. When first one is selected, the graph is shown correctly. But when I select the second and third one, error message comes up. The reprex and the screenshot of the error is given below.

library(tidyverse)
library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box
library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
data<-tibble::tribble(
  ~date, ~supervisor, ~score,
  "27-08-2022",     "Jyoti",    92L,
  "28-08-2022",     "Jyoti",    86L,
  "29-08-2022",     "Jyoti",    85L,
  "30-08-2022",     "Jyoti",    88L,
  "31-08-2022",     "Jyoti",    61L,
  "01-09-2022",     "Jyoti",    60L,
  "02-09-2022",   "Veeresh",    78L,
  "27-08-2022",   "Veeresh",    75L,
  "28-08-2022",   "Veeresh",    70L,
  "29-08-2022",   "Veeresh",    66L,
  "30-08-2022",   "Veeresh",   100L,
  "31-08-2022",   "Veeresh",    82L,
  "01-09-2022",   "Veeresh",    53L,
  "02-09-2022",  "Prashant",    74L,
  "27-08-2022",  "Prashant",    60L,
  "28-08-2022",  "Prashant",    80L,
  "29-08-2022",  "Prashant",    89L,
  "30-08-2022",  "Prashant",    90L,
  "31-08-2022",  "Prashant",    83L,
  "01-09-2022",  "Prashant",    64L,
  "02-09-2022",  "Prashant",    50L
)

ui<-dashboardPage(
  skin = "red",
  dashboardHeader(title = "Dashboard Test"),
  dashboardSidebar("Choose your inputs here",
                   selectInput("supervisor","Select the Supervisor",choices = c("All",unique(data$supervisor)),multiple = T)),
  dashboardBody(
    tabsetPanel(
      tabPanel(plotOutput("plot1",width = 500,height = 500))
    )
  ))

server<-function(input,output,session){
  
  field_sup_avg<-reactive({
    req(input$supervisor)
    
    if(input$supervisor %in% "All"){
      tmp <- data
    } else{
      tmp <- data[data$supervisor %in% input$supervisor, ]
    }
    
    tmp %>% 
      group_by(date,supervisor) %>% 
      summarise(avg_score=mean(score)) %>% 
      filter(supervisor %in% input$supervisor|input$supervisor %in% "All")
  })
  
  output$plot1<-renderPlot({
    req(field_sup_avg())
    
    ggplot(field_sup_avg(),aes(date,avg_score,group=supervisor))+
      geom_line(size=1.5)+
      geom_point(size=2)+
      theme_minimal()
  })
}

shinyApp(ui,server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents
Created on 2022-09-11 by the reprex package (v2.0.1)

[scottyd22]

The app appears to work as intended after updating two lines in the server section, as shown below (identified with "# UPDATE").

server<-function(input,output,session){
  
  field_sup_avg<-reactive({
    req(input$supervisor)
    
    if("All" %in% input$supervisor){ # UPDATE
      tmp <- data
    } else{
      tmp <- data[data$supervisor %in% input$supervisor, ]
    }
    
    tmp %>% 
      group_by(date,supervisor) %>% 
      summarise(avg_score=mean(score)) # %>%   
      # filter(supervisor %in% input$supervisor|input$supervisor %in% "All") # UPDATE: remove this line
  })
  
  output$plot1<-renderPlot({
    req(field_sup_avg())
    
    ggplot(field_sup_avg(),aes(date,avg_score,group=supervisor))+
      geom_line(size=1.5)+
      geom_point(size=2)+
      theme_minimal()
  })
}

[kuttan98]

Thank you very much. Hence, if I give the if else condition, there is no need for filter again inside the reactive function?

[scottyd22]

Correct, the if statement is serving as your filter.

[kuttan98]

ok thanks again .

Regards,
NP