Putting "All" option in filter, but unable to make the output reactive

shiny
1

Hi,
I have a shiny app where I want it to use for survey monitoring purposes. In this app, I have the following filters:

  1. Region
  2. Cluster
  3. School
  4. Enumerator
  5. Date

I have 2 issues:

  1. I have added option "All" in Region, cluster, school and enumerator. But I am unable to figure out how to link the "All" option with the graphs.
  2. I am also unable to add the option multiple in selectInput. The app does not work when I add the option.
library(tidyverse)
library(shiny)
library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-tibble::tribble(
  ~student_id, ~duration_min, ~enumerator,            ~en_name, ~selectedregionid, ~selectedclusterid,                   ~selectedschoolid,              ~survey_date, ~child_age2, ~total_point_l1, ~total_nr_ratio_l1,
  "8S5G43",   50.76666667,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             40L,        7.352941176,
  "98UBYO",   31.71666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             61L,        4.411764706,
  "ON2C1L",          23.1,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             17L,        30.88235294,
  "17OX3D",   24.11666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             55L,        4.411764706,
  "0FAV2F",   54.01666667,    "BEN083",    "Divya Neelagar",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             43L,        17.64705882,
  "KBFAIF",          46.4,    "BEN015",    "Kartik Nippani",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             50L,        1.470588235,
  "EUY3V4",   25.66666667,    "BEN001",   "Laxman kutaband",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             65L,                  0
)


library(tidyverse)
library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box
library(janitor)
library(gridExtra)
#> Warning: package 'gridExtra' was built under R version 4.1.3
#> 
#> Attaching package: 'gridExtra'
#> The following object is masked from 'package:dplyr':
#> 
#>     combine
windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-combined_lvl1 %>% 
  separate(selectedschoolid,into = c("school_code","selectedschoolid","disecode"),sep = "-")


day_wise_nr<-combined_lvl1 %>% 
  group_by(survey_date) %>% 
  summarise(no_response=mean(total_nr_ratio_l1)) %>% 
  adorn_rounding(digits = 1,rounding="half to even")

combined_lvl1<-combined_lvl1 %>% 
  mutate(level="Level 1")

ui<-fluidPage(
  titlePanel(title = "EarlySpark Assessment Dashboard (Age 6: Level-1)"),
  sidebarLayout(
    sidebarPanel(
      selectInput("region","Select the region",choices = c("All",unique(combined_lvl1$selectedregionid))),
      selectInput("cluster","Select the cluster",choices = NULL),
      selectInput("school","Select the school",choices = NULL),
      selectInput("enumerator","Select the enumerator",choices = NULL),
      selectInput("date","Select the survey date",choices = unique(combined_lvl1$survey_date))
    ),
    mainPanel(
      plotOutput("plot1"),
      plotOutput("plot2"),
      plotOutput("plot3"),
      plotOutput("plot4"),
      plotOutput("plot5"),
      plotOutput("plot6"),
      plotOutput("plot7")
    )
  )
)

server<-function(input,output,session){
  filtered<-reactive({
    combined_lvl1 %>% 
      filter(selectedregionid == input$region,
             selectedclusterid == input$cluster,
             selectedschoolid==input$school)
    
  })
  
  en_wise_duration<-reactive({
    combined_lvl1 %>% 
      filter(selectedregionid==input$region,
             selectedclusterid==input$cluster,
             selectedschoolid==input$school) %>% 
      group_by(en_name,duration_min) %>% 
      summarise(duration_en=mean(duration_min))
  })
  
  
  
  observe({
    x<-combined_lvl1 %>% 
      filter(selectedregionid==input$region) %>% 
      select(selectedclusterid)
    updateSelectInput(session,"cluster","Select the cluster",choices = c("All",x))
  })
  
  observe({
    y<-combined_lvl1 %>% 
      filter(selectedregionid==input$region&selectedclusterid==input$cluster) %>% 
      select(selectedschoolid)
    updateSelectInput(session,"school","Select the school",choices = c("All",y))
  })
  
  observe({
    z<-combined_lvl1 %>% 
      filter(selectedregionid==input$region&selectedclusterid==input$cluster&selectedschoolid==input$school) %>% 
      select(en_name)
    updateSelectInput(session,"enumerator","Select the enumerator",choices= c("All",z))
  })  
  
  output$plot1<-renderPlot({
    ggplot(filtered(),aes(total_point_l1,duration_min))+
      geom_point(size=2,color="orange",alpha=0.6)+
      geom_smooth(size=2,color="red",method = "lm",se=F)+
      theme_minimal()+
      labs(title = "Will giving more time to the student improve score?",
           x="Total Score (out of 74)",
           y="Duration (in minutes)")+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot2<-renderPlot({
    ggplot(filtered(),aes(total_nr_ratio_l1,duration_min))+
      geom_point(size=2.54,color="blue")+
      geom_smooth(color="red",size=2,method="lm",se=F,alpha=0.6)+
      labs(title = "Will giving more time to students reduce No Answer?",
           y="Duration (in minutes)",
           x="No Response ratio")+
      theme_minimal()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot3<-renderPlot({
    ggplot(day_wise_surveys,aes(survey_date,number_of_surveys))+
      geom_line(size=2,color="orange")+
      theme_minimal()+
      labs(title = "Day-wise Number of surveys",
           x="Survey Date",
           y="Number of Surveys (Level-1)")+
      geom_text(aes(label=number_of_surveys),vjust=0.5,size=7)+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot4<-renderPlot({
    ggplot(day_wise_nr,aes(survey_date,no_response))+
      geom_line(size=2,color="red")+
      theme_minimal()+
      labs(title = "Day-wise No Response ratio",
           x="Survey date",
           y="Average No response ratio")+
      geom_text(aes(label=no_response),size=6.5,vjust=-0.35)+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot5<-renderPlot({
    ggplot(pivot_data_section_nr,aes(survey_date,Values,color=Names))+
      geom_line(size=1.5)+
      theme_minimal()+
      labs(title = "Section-wise No Response ratio over the survey period",
           x= "Survey Date",
           y= "No response ratio")+
      geom_text(aes(label=Values),size=5,color="red",vjust=-0.49)+
      scale_color_discrete(labels=c("Cognitive","Early language","Early Numeracy","Socio-emotional"),name="Survey Sections")+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            legend.title = element_text(size=20),
            legend.text = element_text(size=15),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot6<-renderPlot({
    ggplot(filtered(),aes(en_name))+
      geom_bar(mapping = aes(fill=en_name),show.legend = F,width = 0.5)+
      theme_minimal()+
      labs(title = "Enumerator-wise Number of Surveys",
           x="Name of Enumerator",
           y="# of surveys")+
      geom_text(aes(label=..count..),stat='count',size=6.5)+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  output$plot7<-renderPlot({
    ggplot(en_wise_duration(),aes(en_name,duration_en))+
      geom_bar(mapping = aes(fill=en_name),width = .5,stat = "identity",show.legend = F)+
      theme_minimal()+
      labs(title = "Enumerator-wise duration of surveys",
           x="Name of Enumerator",
           y="Average Duration (in minutes)")+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  
}


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-08-13 by the reprex package (v2.0.1)
2

To get the All condition to work, try using an OR condition in the filter() condition.

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
DF <- data.frame(X=c(1,1,2,2),Y=c(3,4,5,6),G=c('a','q','a','q'))

FilterValueX <- 1
FilterValueY <- 3
DF |> filter(X==FilterValueX | FilterValueX == "All",
             Y==FilterValueY | FilterValueY == "All")
#>   X Y G
#> 1 1 3 a

FilterValueX <- "2"
FilterValueY <- "All" 
DF |> filter(X==FilterValueX | FilterValueX == "All",
             Y==FilterValueY | FilterValueY == "All")
#>   X Y G
#> 1 2 5 a
#> 2 2 6 q

Created on 2022-08-13 by the reprex package (v2.0.1)

3

Great.. Thanks for this. I have added the OR condition in reactive expression. Now I am able to select "All" and the graphs change accordingly.
But can you also shed light on my second question on using multiple option inside selectInput option, if possible?

4

This simple app has a selectInput with multiple selection turned on and it works for me. Does it work for you? It complains when I delete the All value, which is the default, as I select one or more values of Group, but it is otherwise functional.

library(tidyverse)
library(shiny)
#library(shinydashboard)
DF <- data.frame(Group = c("A", "A", "B", "B", "C", "C"),
                 X = c(1,2,1,2,1,2),
                 Y = c(1,2,3,4,5,6))

ui<-fluidPage(
  titlePanel(title = "EarlySpark Assessment Dashboard (Age 6: Level-1)"),
  sidebarLayout(
    sidebarPanel(
      selectInput("Grp","Select the Group",selected = "All",
                  choices = c("All",unique(DF$Group)),multiple = TRUE)
    ),
    mainPanel(
      plotOutput("plot1")
    )
  )
)

server<-function(input,output){
  FilteredData <- reactive({
    if (input$Grp == "All") {
      DF
    } else {
    DF[DF$Group %in% input$Grp, ]
    }
  })
  output$plot1<-renderPlot({
    ggplot(FilteredData(),aes(X, Y, color = Group))+
      geom_point() + geom_line() +
      theme_classic()}
  )
}

shinyApp(ui,server)
5

Thanks for this. When I give selected="All" and multiple=T, it works fine. But when it add multiple=T in my other filters, the app stops working. How can I resolve that?

6

multiple=T results in an input that can have multiple values, i.e. checking the values to filter on no longer makes sense to be done by == type comparison.
you can see this in a plain R script.


(a_df <- data.frame(a=1))

a_ <- 1
a_ == 1
filter(a_df,
       a == a_)

a_ <- 1:2
a_ == 1
filter(a_df,
       a == a_)
filter(a_df,
       a %in% a_)
7

Ok I got your point. So in the reactive function, I have put selectedregionid==input$region and that's why it doesn't work when I give multiple=T.
I tried giving the following edit to the reactive function, but again I am getting error. All other codes in my app are same as in my original help request.
How can I resolve it?

filtered<-reactive({
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region | input$region=="All",
            selectedclusterid %in% input$cluster | input$cluster=="All",
            selectedschoolid %in% input$school | input$school=="All")
8

If school takes multiple values, then this would break. It could be %in% as well

10

Thanks for that. That worked in getting the desired output. But that didn't change my problem with multiple=T option in selectInput.

12

Thank your for your response.
But even after bringing the changes as said, multiple=T does not work. I have changed the reactive function as follows:

filtered<-reactive({
 
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region|input$region %in% "All",
            selectedclusterid %in% input$cluster|input$cluster %in% "All",
            selectedschoolid %in% input$school|input$school %in% "All")            
      })

And my filters code are as follows:

selectInput("region","Select the region",choices = c("All",unique(combined_lvl1$selectedregionid)),multiple=T),
      selectInput("cluster","Select the cluster",choices = NULL,multiple=T),
      selectInput("school","Select the school",choices = NULL),
      selectInput("enumerator","Select the enumerator",choices = NULL),
      selectInput("date","Select the survey date",choices = unique(combined_lvl1$survey_date)

My doubt is whether the issues springs up due to the observe function I am using.

observe({
    x<-combined_lvl1 %>% 
      filter(selectedregionid == input$region) %>% 
      select(selectedclusterid)
    updateSelectInput(session,"cluster","Select the cluster",choices = c("All",x))
  })
  
  observe({
    y<-combined_lvl1 %>% 
      filter(selectedregionid == input$region&selectedclusterid == input$cluster) %>% 
      select(selectedschoolid)
    updateSelectInput(session,"school","Select the school",choices = c("All",y))
  })

  observe({
    z<-combined_lvl1 %>% 
      filter(selectedregionid == input$region&selectedclusterid == input$cluster&selectedschoolid == input$school) %>% 
      select(en_name)
    updateSelectInput(session,"enumerator","Select the enumerator",choices= c("All",z))
  })

I am getting an error message like shown in the screenshot.

Screenshot 2022-08-16 103641
Screenshot 2022-08-16 103641942×328 16.7 KB

13

This thread contains many fragments.
Can you make a single reprex showing a current state ?

14

I am putting it below:

library(tidyverse)
library(shiny)
library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-tibble::tribble(
  ~student_id, ~duration_min, ~enumerator,            ~en_name, ~selectedregionid, ~selectedclusterid,                   ~selectedschoolid,              ~survey_date, ~child_age2, ~total_point_l1, ~total_nr_ratio_l1,
  "8S5G43",   50.76666667,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             40L,        7.352941176,
  "98UBYO",   31.71666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             61L,        4.411764706,
  "ON2C1L",          23.1,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             17L,        30.88235294,
  "17OX3D",   24.11666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             55L,        4.411764706,
  "0FAV2F",   54.01666667,    "BEN083",    "Divya Neelagar",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             43L,        17.64705882,
  "KBFAIF",          46.4,    "BEN015",    "Kartik Nippani",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             50L,        1.470588235,
  "EUY3V4",   25.66666667,    "BEN001",   "Laxman kutaband",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             65L,                  0
)



windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-combined_lvl1 %>% 
  separate(selectedschoolid,into = c("school_code","selectedschoolid","disecode"),sep = "-")


day_wise_nr<-combined_lvl1 %>% 
  group_by(survey_date) %>% 
  summarise(no_response=mean(total_nr_ratio_l1)) %>% 
  adorn_rounding(digits = 1,rounding="half to even")

combined_lvl1<-combined_lvl1 %>% 
  mutate(level="Level 1")

ui<-fluidPage(
  titlePanel(title = "EarlySpark Assessment Dashboard (Age 6: Level-1)"),
  sidebarLayout(
    sidebarPanel(
      selectInput("region","Select the region",choices = c("All",unique(combined_lvl1$selectedregionid)),multiple = T),
      selectInput("cluster","Select the cluster",choices = NULL),
      selectInput("school","Select the school",choices = NULL),
      selectInput("enumerator","Select the enumerator",choices = NULL),
      selectInput("date","Select the survey date",choices = unique(combined_lvl1$survey_date))
    ),
    mainPanel(
      plotOutput("plot1"),
      plotOutput("plot2"),
      plotOutput("plot3"),
      plotOutput("plot4"),
      plotOutput("plot5"),
      plotOutput("plot6"),
      plotOutput("plot7")
    )
  )
)

server<-function(input,output,session){
  filtered<-reactive({
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region|input$region %in% "All",
             selectedclusterid %in% input$cluster|input$cluster %in% "All",
             selectedschoolid %in% input$school|input$school %in% "All")
    
  })
  
  en_wise_duration<-reactive({
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region,
             selectedclusterid %in% input$cluster,
             selectedschoolid %in% input$school) %>% 
      group_by(en_name,duration_min) %>% 
      summarise(duration_en=mean(duration_min))
  })
  
  
  
  observe({
    x<-combined_lvl1 %>% 
      filter(selectedregionid==input$region) %>% 
      select(selectedclusterid)
    updateSelectInput(session,"cluster","Select the cluster",choices = c("All",x))
  })
  
  observe({
    y<-combined_lvl1 %>% 
      filter(selectedregionid==input$region&selectedclusterid==input$cluster) %>% 
      select(selectedschoolid)
    updateSelectInput(session,"school","Select the school",choices = c("All",y))
  })
  
  observe({
    z<-combined_lvl1 %>% 
      filter(selectedregionid==input$region&selectedclusterid==input$cluster&selectedschoolid==input$school) %>% 
      select(en_name)
    updateSelectInput(session,"enumerator","Select the enumerator",choices= c("All",z))
  })  
  
  output$plot1<-renderPlot({
    ggplot(filtered(),aes(total_point_l1,duration_min))+
      geom_point(size=2,color="orange",alpha=0.6)+
      geom_smooth(size=2,color="red",method = "lm",se=F)+
      theme_minimal()+
      labs(title = "Will giving more time to the student improve score?",
           x="Total Score (out of 74)",
           y="Duration (in minutes)")+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot2<-renderPlot({
    ggplot(filtered(),aes(total_nr_ratio_l1,duration_min))+
      geom_point(size=2.54,color="blue")+
      geom_smooth(color="red",size=2,method="lm",se=F,alpha=0.6)+
      labs(title = "Will giving more time to students reduce No Answer?",
           y="Duration (in minutes)",
           x="No Response ratio")+
      theme_minimal()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot3<-renderPlot({
    ggplot(day_wise_surveys,aes(survey_date,number_of_surveys))+
      geom_line(size=2,color="orange")+
      theme_minimal()+
      labs(title = "Day-wise Number of surveys",
           x="Survey Date",
           y="Number of Surveys (Level-1)")+
      geom_text(aes(label=number_of_surveys),vjust=0.5,size=7)+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot4<-renderPlot({
    ggplot(day_wise_nr,aes(survey_date,no_response))+
      geom_line(size=2,color="red")+
      theme_minimal()+
      labs(title = "Day-wise No Response ratio",
           x="Survey date",
           y="Average No response ratio")+
      geom_text(aes(label=no_response),size=6.5,vjust=-0.35)+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot5<-renderPlot({
    ggplot(pivot_data_section_nr,aes(survey_date,Values,color=Names))+
      geom_line(size=1.5)+
      theme_minimal()+
      labs(title = "Section-wise No Response ratio over the survey period",
           x= "Survey Date",
           y= "No response ratio")+
      geom_text(aes(label=Values),size=5,color="red",vjust=-0.49)+
      scale_color_discrete(labels=c("Cognitive","Early language","Early Numeracy","Socio-emotional"),name="Survey Sections")+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            legend.title = element_text(size=20),
            legend.text = element_text(size=15),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot6<-renderPlot({
    ggplot(filtered(),aes(en_name))+
      geom_bar(mapping = aes(fill=en_name),show.legend = F,width = 0.5)+
      theme_minimal()+
      labs(title = "Enumerator-wise Number of Surveys",
           x="Name of Enumerator",
           y="# of surveys")+
      geom_text(aes(label=..count..),stat='count',size=6.5)+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  output$plot7<-renderPlot({
    ggplot(en_wise_duration(),aes(en_name,duration_en))+
      geom_bar(mapping = aes(fill=en_name),width = .5,stat = "identity",show.legend = F)+
      theme_minimal()+
      labs(title = "Enumerator-wise duration of surveys",
           x="Name of Enumerator",
           y="Average Duration (in minutes)")+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  
}


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-08-16 by the reprex package (v2.0.1)
15

Every issue I addressed in the code below has been discussed earlier in this thread

  1. use of %in% to compare values where multiple are possible rather than ==
  2. req() for guarding error states
  3. absent/undefined objects
library(tidyverse)
library(shiny)
library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-tibble::tribble(
  ~student_id, ~duration_min, ~enumerator,            ~en_name, ~selectedregionid, ~selectedclusterid,                   ~selectedschoolid,              ~survey_date, ~child_age2, ~total_point_l1, ~total_nr_ratio_l1,
  "8S5G43",   50.76666667,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             40L,        7.352941176,
  "98UBYO",   31.71666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             61L,        4.411764706,
  "ON2C1L",          23.1,    "BEN103", "Sarvamangala Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             17L,        30.88235294,
  "17OX3D",   24.11666667,    "BEN074",        "Jyoti Godi",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             55L,        4.411764706,
  "0FAV2F",   54.01666667,    "BEN083",    "Divya Neelagar",   "Dharwad Urban",          "NAVALUR", "SCH251-GMKPS NAVALURU-29090102801", "2022-07-04 00:00:10 UTC",          6L,             43L,        17.64705882,
  "KBFAIF",          46.4,    "BEN015",    "Kartik Nippani",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             50L,        1.470588235,
  "EUY3V4",   25.66666667,    "BEN001",   "Laxman kutaband",  "Hubballi Rural",         "BYAHATTI",  "SCH294-GMPS BYAHATTI-29090700904", "2022-07-04 00:00:10 UTC",          6L,             65L,                  0
)



windowsFonts(a=windowsFont("Times New Roman"))

combined_lvl1<-combined_lvl1 %>% 
  separate(selectedschoolid,into = c("school_code","selectedschoolid","disecode"),sep = "-")


day_wise_nr<-combined_lvl1 %>% 
  group_by(survey_date) %>% 
  summarise(no_response=mean(total_nr_ratio_l1)) %>% 
  adorn_rounding(digits = 1,rounding="half to even")

combined_lvl1<-combined_lvl1 %>% 
  mutate(level="Level 1")

ui<-fluidPage(
  titlePanel(title = "EarlySpark Assessment Dashboard (Age 6: Level-1)"),
  sidebarLayout(
    sidebarPanel(
      selectInput("region","Select the region",choices = c("All",unique(combined_lvl1$selectedregionid)),multiple = T),
      selectInput("cluster","Select the cluster",choices = NULL),
      selectInput("school","Select the school",choices = NULL),
      selectInput("enumerator","Select the enumerator",choices = NULL),
      selectInput("date","Select the survey date",choices = unique(combined_lvl1$survey_date))
    ),
    mainPanel(
      plotOutput("plot1"),
      plotOutput("plot2"),
      plotOutput("plot3"),
      plotOutput("plot4"),
      plotOutput("plot5"),
      plotOutput("plot6"),
      plotOutput("plot7")
    )
  )
)

server<-function(input,output,session){
  filtered<-reactive({
    req(input$region)
    req(input$cluster)
    req(input$school)
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region|input$region %in% "All",
             selectedclusterid %in% input$cluster|input$cluster %in% "All",
             selectedschoolid %in% input$school|input$school %in% "All")
    
  })
  
  en_wise_duration<-reactive({
    req(input$region)
    req(input$cluster)
    req(input$school)
    combined_lvl1 %>% 
      filter(selectedregionid %in% input$region,
             selectedclusterid %in% input$cluster,
             selectedschoolid %in% input$school) %>% 
      group_by(en_name,duration_min) %>% 
      summarise(duration_en=mean(duration_min))
  })
  
  
  
  observe({
    req(input$region)
    x<-combined_lvl1 %>% 
      filter(selectedregionid%in%input$region) %>% 
      select(selectedclusterid)
    updateSelectInput(session,"cluster","Select the cluster",choices = c("All",x))
  })
  
  observe({
    req(input$region)
    req(input$cluster)

    y<-combined_lvl1 %>% 
      filter(selectedregionid %in% input$region & selectedclusterid %in% input$cluster) %>% 
      select(selectedschoolid)
    updateSelectInput(session,"school","Select the school",choices = c("All",y))
  })
  
  observe({
    req(input$region)
    req(input$cluster)
    req(input$school)
    
    z<-combined_lvl1 %>% 
      filter(selectedregionid%in%input$region & selectedclusterid%in%input$cluster & selectedschoolid%in%input$school) %>% 
      select(en_name)
    updateSelectInput(session,"enumerator","Select the enumerator",choices= c("All",z))
  })  
  
  output$plot1<-renderPlot({
    req(filtered())
    ggplot(filtered(),aes(total_point_l1,duration_min))+
      geom_point(size=2,color="orange",alpha=0.6)+
      geom_smooth(size=2,color="red",method = "lm",se=F)+
      theme_minimal()+
      labs(title = "Will giving more time to the student improve score?",
           x="Total Score (out of 74)",
           y="Duration (in minutes)")+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  output$plot2<-renderPlot({
    req(filtered())
    ggplot(filtered(),aes(total_nr_ratio_l1,duration_min))+
      geom_point(size=2.54,color="blue")+
      geom_smooth(color="red",size=2,method="lm",se=F,alpha=0.6)+
      labs(title = "Will giving more time to students reduce No Answer?",
           y="Duration (in minutes)",
           x="No Response ratio")+
      theme_minimal()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15))
  })
  
  
  # missing "day_wise_surveys"
  # output$plot3<-renderPlot({
  #   req(day_wise_surveys)
  #   ggplot(day_wise_surveys,aes(survey_date,number_of_surveys))+
  #     geom_line(size=2,color="orange")+
  #     theme_minimal()+
  #     labs(title = "Day-wise Number of surveys",
  #          x="Survey Date",
  #          y="Number of Surveys (Level-1)")+
  #     geom_text(aes(label=number_of_surveys),vjust=0.5,size=7)+
  #     theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
  #           text = element_text(family="a"),
  #           axis.title = element_text(face = "bold",size=15))
  # })
  
  #day_wise_nr is just a number in a single column 
  # > day_wise_nr
  # no_response
  # 1    9.453782
  #so not going to try to plot it as though it was more
  # output$plot4<-renderPlot({
  #   ggplot(day_wise_nr,aes(survey_date,no_response))+
  #     geom_line(size=2,color="red")+
  #     theme_minimal()+
  #     labs(title = "Day-wise No Response ratio",
  #          x="Survey date",
  #          y="Average No response ratio")+
  #     geom_text(aes(label=no_response),size=6.5,vjust=-0.35)+
  #     theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
  #           text = element_text(family="a"),
  #           axis.title = element_text(face = "bold",size=15))
  #  })
  # 
  
  # missing "pivot_data_section_nr"
  # output$plot5<-renderPlot({
  #   ggplot(pivot_data_section_nr,aes(survey_date,Values,color=Names))+
  #     geom_line(size=1.5)+
  #     theme_minimal()+
  #     labs(title = "Section-wise No Response ratio over the survey period",
  #          x= "Survey Date",
  #          y= "No response ratio")+
  #     geom_text(aes(label=Values),size=5,color="red",vjust=-0.49)+
  #     scale_color_discrete(labels=c("Cognitive","Early language","Early Numeracy","Socio-emotional"),name="Survey Sections")+
  #     theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
  #           text = element_text(family="a"),
  #           legend.title = element_text(size=20),
  #           legend.text = element_text(size=15),
  #           axis.title = element_text(face = "bold",size=15))
  # })
  
  output$plot6<-renderPlot({
    req(filtered())
    ggplot(filtered(),aes(en_name))+
      geom_bar(mapping = aes(fill=en_name),show.legend = F,width = 0.5)+
      theme_minimal()+
      labs(title = "Enumerator-wise Number of Surveys",
           x="Name of Enumerator",
           y="# of surveys")+
      geom_text(aes(label=..count..),stat='count',size=6.5)+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  output$plot7<-renderPlot({
    req(en_wise_duration())
    ggplot(en_wise_duration(),aes(en_name,duration_en))+
      geom_bar(mapping = aes(fill=en_name),width = .5,stat = "identity",show.legend = F)+
      theme_minimal()+
      labs(title = "Enumerator-wise duration of surveys",
           x="Name of Enumerator",
           y="Average Duration (in minutes)")+
      coord_flip()+
      theme(plot.title = element_text(face="bold",hjust=0.5,size=20),
            text = element_text(family="a"),
            axis.title = element_text(face = "bold",size=15),
            axis.text = element_text(size = 20))
    
  })
  
  
}


shinyApp(ui,server)
16

Thanks for this. I had changed the == to %in% in all places except the observe function.
req I missed it completely.
I actually had the objects defined, but did not put it in the reprex.
Sorry for the pestering..

Regards,
Kuttan

17

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.