Merge pull request #1 from dfe-analytical-services/AddYear

Add year to shiny app

R/dashboard_panels.R

@@ -57,8 +57,8 @@ homepage_panel <- function() {
               div(
                 class = "panel-body",
                 h3("Context and purpose"),
-                p("To use the 16-18 Transition Matrices tool click onto the '16-18 TM tool' tab found on the left panel. Please then
-                select a qualification, subject and subject size from the dropdown boxes. 
+                p("To use the 16-18 Transition Matrices tool click onto the 'Dashboard' tab found on the left panel. Please then
+                select a report year (the year students finished 16-18 study), qualification, subject and subject size from the dropdown boxes. 
                 Use the 'Numbers data' and 'Percentage Data' options to switch the 
                 table view between number of students and percentage of students."),
                 br(),
@@ -130,11 +130,21 @@ dashboard_panel <- function() {
             class = "well",
             style = "min-height: 100%; height: 100%; overflow-y: visible",
             gov_row(
+              column(
+                width = 6,
+                selectizeInput(
+                  inputId = "ReportYr_select",
+                  label = "1. Select a report year",
+                  choices = unique(qual_lookup$ReportYr), # list(ReportYr = sort(unique(qual_lookup$ReportYr))),
+                  selected = max(qual_lookup$ReportYr)
+                )
+              ),
+
               column(
                 width = 6,
                 selectizeInput(
                   inputId = "qual_select",
-                  label = "1. Select a qualification",
+                  label = "2. Select a qualification",
                   choices = list(Qualifications = sort(unique(qual_lookup$Qual_Description))),
                   selected = "GCE A level"
                 )
@@ -144,7 +154,7 @@ dashboard_panel <- function() {
                 width = 6,
                 selectizeInput(
                   inputId = "subj_select",
-                  label = "2. Select a subject",
+                  label = "3. Select a subject",
                   choices = list(Subjects = sort(unique(qual_lookup$Subject))),
                   selected = "Mathematics"
                 )
@@ -154,7 +164,7 @@ dashboard_panel <- function() {
                 width = 6,
                 selectizeInput(
                   inputId = "size_select",
-                  label = "3. Select a size",
+                  label = "4. Select a size",
                   choices = list(Sizes = sort(qual_lookup$SIZE))
                 )
               ),
@@ -163,15 +173,15 @@ dashboard_panel <- function() {
                 width = 6,
                 selectizeInput(
                   inputId = "grade_structure_select",
-                  label = "4. Select a grade structure",
+                  label = "5. Select a grade structure",
                   choices = list(GradeStructures = sort(qual_lookup$gradeStructure))
                 )
               ),
 
               column(
                 width = 12,
                 radioButtons(inputId="format", 
-                             label="5. Select format of data: ", 
+                             label="6. Select format of data: ", 
                              choices=c("Numbers data", "Percentage data")
                 ),
                 uiOutput("chart_band_appear")

background_scripts/data_processing.R

@@ -33,7 +33,7 @@ current_year <- "2022A"
 
 # establish connection to server
 con <- DBI::dbConnect(odbc::odbc(), driver = "SQL Server",
-                      server = "3dcpri-pdb16\\acsqls")
+                      server = "VMT1PR-DHSQL02")
 
 
 # Select data from SQL tables
@@ -150,14 +150,35 @@ grades_ordered_lookup <- bind_rows(grades_char, grades_num) %>%
 
 
 
+# -----------------------------------------------------------------------------------------------------------------------------
+# ---- add academic year to data ---- 
+# -----------------------------------------------------------------------------------------------------------------------------
+
+student_numbers <- student_numbers %>% 
+  mutate(ReportYr = 2022) %>% 
+  select(ReportYr, everything())
+
+student_percentages <- student_percentages %>% 
+  mutate(ReportYr = 2022) %>% 
+  select(ReportYr, everything())
+
+qual_lookup <- qual_lookup %>% 
+  mutate(ReportYr = 2022) %>% 
+  select(ReportYr, everything())
+
+grades_ordered_lookup <- grades_ordered_lookup %>% 
+  mutate(ReportYr = 2022) %>% 
+  select(ReportYr, everything())
 
 
 # grade_list %>% filter(SUBLEVNO == 253, SUBJ == 20596, ASIZE == 1)
 
+
 # -----------------------------------------------------------------------------------------------------------------------------
 # ---- Saving Data ---- 
 # -----------------------------------------------------------------------------------------------------------------------------
 
+
 saveRDS(student_numbers, "./data/all_student_numbers.rds")
 saveRDS(student_percentages, "./data/all_student_percentages.rds")
 

global.R

@@ -55,7 +55,7 @@ tidy_code_function <- function() {
 # -----------------------------------------------------------------------------------------------------------------------------
 
 # Returns a table from the Student Numbers CSV
-number_select_function <- function(qual, subj, size, grade_structure) {
+number_select_function <- function(ReportYr_sel, qual, subj, size, grade_structure) {
   filter_selection <- paste0(qual, subj, size, grade_structure)
   qual_grades <- filter(
     grade_lookup,
@@ -66,7 +66,7 @@ number_select_function <- function(qual, subj, size, grade_structure) {
   grade_list <- qual_grades$GRADE
 
   table <- stud_numbers %>%
-    filter(QUAL_ID == filter_selection) %>%
+    filter(ReportYr == ReportYr_sel & QUAL_ID == filter_selection) %>%
     select(PRIOR_BAND, grade_list)
 
   return(table)
@@ -77,15 +77,15 @@ number_select_function <- function(qual, subj, size, grade_structure) {
 # -----------------------------------------------------------------------------------------------------------------------------
 
 # Returns a table from the Student Percentages CSV
-percentage_select_function <- function(qual, subj, size, grade_structure) {
+percentage_select_function <- function(ReportYr_sel, qual, subj, size, grade_structure) {
   filter_selection <- paste0(qual, subj, size, grade_structure)
   qual_grades <- filter(grade_lookup, SUBLEVNO == qual & SUBJ == subj & SIZE == size & gradeStructure == grade_structure)
 
   # Grades already sorted so just need to extract list of grades
   grade_list <- qual_grades$GRADE
 
   table <- stud_percentages %>%
-    filter(QUAL_ID == filter_selection) %>%
+    filter(ReportYr == ReportYr_sel & QUAL_ID == filter_selection) %>%
     select(PRIOR_BAND, grade_list)
 
   return(table)
@@ -166,12 +166,12 @@ grade_boundaries <- c("<1", "1-<2", "2-<3", "3-<4", "4-<5", "5-<6", "6-<7", "7-<
 
 # Create a fixed table for example table
 user_selection_example <- qual_lookup %>%
-  filter(Qual_Description == "GCE A level" & Subject == "Mathematics" & ASIZE == 1 & gradeStructure == "*,A,B,C,D,E") %>%
+  filter(ReportYr == max(ReportYr) & Qual_Description == "GCE A level" & Subject == "Mathematics" & ASIZE == 1 & gradeStructure == "*,A,B,C,D,E") %>%
   distinct()
 
 
 example_data <- number_select_function(
-  user_selection_example$SUBLEVNO, user_selection_example$SUBJ,
+  user_selection_example$ReportYr, user_selection_example$SUBLEVNO, user_selection_example$SUBJ,
   user_selection_example$SIZE, user_selection_example$gradeStructure
 ) %>%
   rename("Prior Band" = PRIOR_BAND) %>%

renv/settings.json

@@ -0,0 +1,19 @@
+{
+  "bioconductor.version": null,
+  "external.libraries": [],
+  "ignored.packages": [],
+  "package.dependency.fields": [
+    "Imports",
+    "Depends",
+    "LinkingTo"
+  ],
+  "ppm.enabled": null,
+  "ppm.ignored.urls": [],
+  "r.version": null,
+  "snapshot.type": "packrat",
+  "use.cache": true,
+  "vcs.ignore.cellar": true,
+  "vcs.ignore.library": true,
+  "vcs.ignore.local": true,
+  "vcs.manage.ignores": true
+}

server.R

@@ -49,7 +49,7 @@ server <- function(input, output, session) {
   # we need to identify which qualifications have only 1 subject option
   # use this output to update the qualification drop down box below
   single_subj <- qual_lookup %>%
-    group_by(SUBLEVNO) %>%
+    group_by(ReportYr, SUBLEVNO) %>%
     filter(n() == 1)
   # single_subj
 
@@ -59,12 +59,12 @@ server <- function(input, output, session) {
       label = NULL,
       if (input$qual_select %in% single_subj$Qual_Description) {
         choices <- qual_lookup %>%
-          filter(Qual_Description == input$qual_select) %>%
+          filter(ReportYr == input$ReportYr_select & Qual_Description == input$qual_select) %>%
           select(Subject) %>%
           as.character()
       } else {
         choices <- qual_lookup %>%
-          filter(Qual_Description == input$qual_select) %>%
+          filter(ReportYr == input$ReportYr_select & Qual_Description == input$qual_select) %>%
           select(Subject) %>%
           arrange(Subject)
       }
@@ -76,10 +76,10 @@ server <- function(input, output, session) {
   # we need to identify which subjects have multiple sizes
   # use this output to update the size select drop down box below
   multiple_sizes <- qual_lookup %>%
-    group_by(Qual_Description, SUBLEVNO, Subject, SUBJ) %>%
+    group_by(ReportYr, Qual_Description, SUBLEVNO, Subject, SUBJ) %>%
     count() %>%
     filter(n > 1) %>%
-    mutate(qual_subj_combined = paste0(Qual_Description, " - ", Subject))
+    mutate(qual_subj_combined = paste0(ReportYr, " - ", Qual_Description, " - ", Subject))
   # multiple_sizes
 
 
@@ -88,9 +88,10 @@ server <- function(input, output, session) {
     updateSelectInput(session,
       inputId = "size_select",
       label = NULL,
-      if (paste0(input$qual_select, " - ", input$subj_select) %in% multiple_sizes$qual_subj_combined) {
+      if (paste0(input$ReportYr_select, " - ", input$qual_select, " - ", input$subj_select) %in% multiple_sizes$qual_subj_combined) {
         choices <- qual_lookup %>%
           filter(
+            ReportYr == input$ReportYr_select,
             Qual_Description == input$qual_select,
             Subject == input$subj_select
           ) %>%
@@ -99,6 +100,7 @@ server <- function(input, output, session) {
       } else {
         choices <- qual_lookup %>%
           filter(
+            ReportYr == input$ReportYr_select,
             Qual_Description == input$qual_select,
             Subject == input$subj_select
           ) %>%
@@ -114,10 +116,10 @@ server <- function(input, output, session) {
   # we need to identify which subject and sizes have multiple grade structures
   # use this output to update the grade select drop down box below
   multiple_gradestructures <- qual_lookup %>%
-    group_by(Qual_Description, SUBLEVNO, Subject, SUBJ, SIZE) %>%
+    group_by(ReportYr, Qual_Description, SUBLEVNO, Subject, SUBJ, SIZE) %>%
     count() %>%
     filter(n > 1) %>%
-    mutate(qual_subj_size_combined = paste0(Qual_Description, " - ", Subject, " - ", SIZE))
+    mutate(qual_subj_size_combined = paste0(ReportYr, " - ", Qual_Description, " - ", Subject, " - ", SIZE))
   # multiple_gradestructures
 
 
@@ -126,9 +128,10 @@ server <- function(input, output, session) {
     updateSelectInput(session,
       inputId = "grade_structure_select",
       label = NULL,
-      if (paste0(input$qual_select, " - ", input$subj_select, " - ", input$size_select) %in% multiple_gradestructures$qual_subj_size_combined) {
+      if (paste0(input$ReportYr_select, " - ", input$qual_select, " - ", input$subj_select, " - ", input$size_select) %in% multiple_gradestructures$qual_subj_size_combined) {
         choices <- qual_lookup %>%
           filter(
+            ReportYr == input$ReportYr_select,
             Qual_Description == input$qual_select,
             Subject == input$subj_select,
             SIZE == input$size_select
@@ -138,6 +141,7 @@ server <- function(input, output, session) {
       } else {
         choices <- qual_lookup %>%
           filter(
+            ReportYr == input$ReportYr_select,
             Qual_Description == input$qual_select,
             Subject == input$subj_select,
             SIZE == input$size_select
@@ -155,7 +159,7 @@ server <- function(input, output, session) {
     renderUI({
       req(input$format == "Percentage data")
       selectInput("chart_band",
-        label = tags$span(style = "color: white;", "6. Select a KS4 prior attainment band to display in the plot"),
+        label = tags$span(style = "color: white;", "7. Select a KS4 prior attainment band to display in the plot"),
         list(bands = sort(prior_band_chart()))
       )
     })
@@ -171,10 +175,12 @@ server <- function(input, output, session) {
     req(input$qual_select)
     stud_percentages %>%
       left_join(lookup_characters, by = c(
+        "ReportYr",
         "Qual_Description", "SUBLEVNO", "Subject", "SUBJ",
         "ASIZE", "GSIZE", "SIZE", "gradeStructure"
       )) %>%
-      subset(Qual_Description == input$qual_select &
+      subset(ReportYr == input$ReportYr_select &
+        Qual_Description == input$qual_select &
         Subject == input$subj_select &
         SIZE == input$size_select &
         gradeStructure == input$grade_structure_select) %>%
@@ -197,7 +203,8 @@ server <- function(input, output, session) {
   ## Try and streamline the original code using reactive tables to prevent repetition
   lookup_selection <- reactive({
     qual_lookup %>%
-      filter(Qual_Description == input$qual_select &
+      filter(ReportYr == input$ReportYr_select &
+        Qual_Description == input$qual_select &
         Subject == input$subj_select &
         SIZE == input$size_select &
         gradeStructure == input$grade_structure_select) %>%
@@ -212,19 +219,19 @@ server <- function(input, output, session) {
   # Create a reactive table for numbers table -----------------------------------------------
   # the function on the last line removes columns that are empty
   numbers_data <- reactive({
-    req(c(lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure))
+    req(c(lookup_selection()$ReportYr, lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure))
 
-    number_select_function(lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
+    number_select_function(lookup_selection()$ReportYr, lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
       rename("Prior Band" = PRIOR_BAND)
   })
 
 
 
   # Create a reactive table for percentage table -----------------------------------------------
   percentage_data <- reactive({
-    req(c(lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure))
+    req(c(lookup_selection()$ReportYr, lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure))
 
-    percentage_select_function(lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
+    percentage_select_function(lookup_selection()$ReportYr, lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
       mutate_all(list(~ str_replace(., "NA%", ""))) %>%
       rename("Prior Band" = PRIOR_BAND)
   })
@@ -307,7 +314,7 @@ server <- function(input, output, session) {
 
 
   percentage_chart_data <- reactive({
-    percentage_select_function(lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
+    percentage_select_function(lookup_selection()$ReportYr, lookup_selection()$SUBLEVNO, lookup_selection()$SUBJ, lookup_selection()$SIZE, lookup_selection()$gradeStructure) %>%
       filter(PRIOR_BAND == input$chart_band) %>%
       # Now we have our selected row data it needs cleaning up because these values are characters
       # First we'll turn it into a list

tests/shinytest.R

@@ -1,2 +1,2 @@
 library(shinytest)
-shinytest::testApp("./")
+shinytest::testApp("../")