Date filter in reactive function does not work.

kuttan98 · August 14, 2022, 4:51pm

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

Region
Cluster
School
Enumerator
Date

All the inputs are working as required, but the output is not reactive to date input. I am unable to figure out the issue with this. Can someone help me resolve it?

library(tidyverse)
library(shiny)
library(janitor)

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
)


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),multiple = T)
    ),
    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,
             survey_date==input$date)
    
  })
  
  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-14 by the reprex package (v2.0.1)

dvetsch75 · August 15, 2022, 12:23pm

Can you be more specific about the problem you are having? I ran your code and didn't see a problem, other than that it looks like a few plots depended on data.frames you had not actually defined in your reprex. My assumption was that those data.frames were defined elsewhere in your broader code?

kuttan98 · August 15, 2022, 1:29pm

Yeah I did not reprex the entire code. The issue I am facing is that when I give survey_date==input$date in the filter (inside reactive function), my graphs don't appear. It appears as shown in the screenshot.

dvetsch75 · August 15, 2022, 1:47pm

The issue is you haven't yet supplied a value for input$date when you launch the app. So if you were to look at input$date when this screenshot is from, you would get NULL. You can get around this by either giving a default value to selectInput or put req(input$date) at the top of your reactive expression. I would recommend the req option if you expect your user to change dates frequently because it will mean that you won't have to wait for all of the graphs to render at startup for a date that you didn't want to look at in the first place.

kuttan98 · August 15, 2022, 2:14pm

Thank you for your help.
I put the req(input$date) at the beginning of reactive expression, but still I am not getting the desired thing.
My process is as follows:
I will select the region, then the cluster, then the school and finally the date. After date selection, the output will display. But it doesn't behave in that manner. For clarity sake with the changed code the reprex is below. The first and second plot doesn't show up and it depends on that particular reactive function.

library(tidyverse)
library(shiny)
library(janitor)

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
)


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),multiple = T)
    ),
    mainPanel(
      plotOutput("plot1"),
      plotOutput("plot2"),
      plotOutput("plot3"),
      plotOutput("plot4"),
      plotOutput("plot5"),
      plotOutput("plot6"),
      plotOutput("plot7")
    )
  )
)

server<-function(input,output,session){
  filtered<-reactive({
    combined_lvl1 %>% 
      req(input$date) %>% 
      filter(selectedregionid == input$region,
             selectedclusterid == input$cluster,
             selectedschoolid==input$school,
             survey_date==input$date)
    
  })
  
  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))
    
  })
}
  
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-15 by the reprex package (v2.0.1)

dvetsch75 · August 15, 2022, 5:31pm

kuttan98:

  filtered<-reactive({
    combined_lvl1 %>% 
      req(input$date) %>% 
      filter(selectedregionid == input$region,
             selectedclusterid == input$cluster,
             selectedschoolid==input$school,
             survey_date==input$date)
  })

I would suggest reading the docs on req. It has some examples of doing exactly what you are trying to do. req returns a boolean value, not a data.frame, so combined_lvl1 %>% req(input$date) doesn't really mean anything. Instead, put the req at the start of the expression block, then try your dplyr code.

filtered<-reactive({
        req(input$date)
        
        combined_lvl1 %>% 
            filter(selectedregionid == input$region,
                   selectedclusterid == input$cluster,
                   selectedschoolid==input$school,
                   survey_date==input$date)
        
    })

kuttan98 · August 16, 2022, 5:09am

Ok sure.. thanks for the help. I will read on it.

Regards,
kuttan

system · September 6, 2022, 5:10am

This topic was automatically closed 21 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.