Merge pull request #65 from dfe-analytical-services/fix-allcountszero

Added logic to deal with if SanKey chart has no data.
dfe-analytical-services · May 10, 2022 · 6983ac6 · 6983ac6
2 parents 9417089 + 0e12bab
commit 6983ac6
Show file tree

Hide file tree

Showing 3 changed files with 133 additions and 111 deletions.
diff --git a/R/industry_flow.R b/R/industry_flow.R
@@ -12,156 +12,159 @@ sankey_chart <- function(subjectinput, sexinput, qualinput) {
 
   cohort_sankey1 <- na.omit(cohort_sankey1)
   cohort_sankey2 <- na.omit(cohort_sankey2)
+  if (all(cohort_sankey1$count == 0) | all(is.na(cohort_sankey1$count))) {
+    return(NULL)
+  } else {
 
-  # Choose top 9 SIC section names and label all others as 'OTHER' based on counts for 1 YAG
+    # Choose top 9 SIC section names and label all others as 'OTHER' based on counts for 1 YAG
 
-  section_names1 <- cohort_sankey1 %>%
-    group_by(SECTIONNAME.x) %>%
-    dplyr::summarise(count = sum(count)) %>%
-    arrange(., -count)
+    section_names1 <- cohort_sankey1 %>%
+      group_by(SECTIONNAME.x) %>%
+      dplyr::summarise(count = sum(count)) %>%
+      arrange(., -count)
 
-  section_names2 <- cohort_sankey1 %>%
-    group_by(SECTIONNAME.y) %>%
-    dplyr::summarise(count = sum(count)) %>%
-    arrange(., -count)
+    section_names2 <- cohort_sankey1 %>%
+      group_by(SECTIONNAME.y) %>%
+      dplyr::summarise(count = sum(count)) %>%
+      arrange(., -count)
 
-  section_names <- section_names1 %>%
-    full_join(section_names2, by = c("SECTIONNAME.x" = "SECTIONNAME.y"))
-  section_names$count.x[is.na(section_names$count.x) == TRUE] <- 0
-  section_names$count.y[is.na(section_names$count.y) == TRUE] <- 0
-  section_names$count <- section_names$count.x + section_names$count.y
+    section_names <- section_names1 %>%
+      full_join(section_names2, by = c("SECTIONNAME.x" = "SECTIONNAME.y"))
+    section_names$count.x[is.na(section_names$count.x) == TRUE] <- 0
+    section_names$count.y[is.na(section_names$count.y) == TRUE] <- 0
+    section_names$count <- section_names$count.x + section_names$count.y
 
-  section_names <- section_names[, -c(2, 3)] %>%
-    arrange(., -count)
+    section_names <- section_names[, -c(2, 3)] %>%
+      arrange(., -count)
 
-  section_names$ID <- 1:nrow(section_names)
-  section_names$SECTIONNAME_NEW <- section_names$SECTIONNAME.x
-  section_names$SECTIONNAME_NEW[section_names$ID > 9] <- "Other"
+    section_names$ID <- 1:nrow(section_names)
+    section_names$SECTIONNAME_NEW <- section_names$SECTIONNAME.x
+    section_names$SECTIONNAME_NEW[section_names$ID > 9] <- "Other"
 
-  names(section_names) <- c("old", "count", "ID", "new")
+    names(section_names) <- c("old", "count", "ID", "new")
 
-  # re-calculate counts using new section names variable
+    # re-calculate counts using new section names variable
 
-  cohort_sankey1 <- cohort_sankey1 %>%
-    left_join(section_names, by = c("SECTIONNAME.x" = "old"))
-  cohort_sankey1$SECTIONNAME.x <- cohort_sankey1$new
-  cohort_sankey1 <- cohort_sankey1[, -c(10, 11, 12)]
+    cohort_sankey1 <- cohort_sankey1 %>%
+      left_join(section_names, by = c("SECTIONNAME.x" = "old"))
+    cohort_sankey1$SECTIONNAME.x <- cohort_sankey1$new
+    cohort_sankey1 <- cohort_sankey1[, -c(10, 11, 12)]
 
-  cohort_sankey1 <- cohort_sankey1 %>%
-    left_join(section_names, by = c("SECTIONNAME.y" = "old"))
-  cohort_sankey1$SECTIONNAME.y <- cohort_sankey1$new
-  cohort_sankey1 <- cohort_sankey1[, -c(10, 11, 12)]
+    cohort_sankey1 <- cohort_sankey1 %>%
+      left_join(section_names, by = c("SECTIONNAME.y" = "old"))
+    cohort_sankey1$SECTIONNAME.y <- cohort_sankey1$new
+    cohort_sankey1 <- cohort_sankey1[, -c(10, 11, 12)]
 
-  # The following line had disappeared from my branch compared to main branch.
-  # I didn't mean to delete it and assuming no-one else has been on the branch,
-  # so assuming it was an accidental deletion.
-  cohort_sankey1$SECTIONNAME.y[is.na(cohort_sankey1$SECTIONNAME.y) == TRUE] <- "Other"
+    # The following line had disappeared from my branch compared to main branch.
+    # I didn't mean to delete it and assuming no-one else has been on the branch,
+    # so assuming it was an accidental deletion.
+    cohort_sankey1$SECTIONNAME.y[is.na(cohort_sankey1$SECTIONNAME.y) == TRUE] <- "Other"
 
-  cohort_sankey1 <- cohort_sankey1 %>%
-    group_by(sex.x, subject_name.x, YAG.x, SECTIONNAME.x, YAG.y, SECTIONNAME.y) %>%
-    dplyr::summarise(count = sum(count.x)) %>%
-    arrange(., -count)
+    cohort_sankey1 <- cohort_sankey1 %>%
+      group_by(sex.x, subject_name.x, YAG.x, SECTIONNAME.x, YAG.y, SECTIONNAME.y) %>%
+      dplyr::summarise(count = sum(count.x)) %>%
+      arrange(., -count)
 
-  # re-calculate counts using new section names variable
+    # re-calculate counts using new section names variable
 
-  cohort_sankey2 <- cohort_sankey2 %>%
-    left_join(section_names, by = c("SECTIONNAME.x" = "old"))
-  cohort_sankey2$SECTIONNAME.x <- cohort_sankey2$new
-  cohort_sankey2 <- cohort_sankey2[, -c(10, 11, 12)]
+    cohort_sankey2 <- cohort_sankey2 %>%
+      left_join(section_names, by = c("SECTIONNAME.x" = "old"))
+    cohort_sankey2$SECTIONNAME.x <- cohort_sankey2$new
+    cohort_sankey2 <- cohort_sankey2[, -c(10, 11, 12)]
 
-  cohort_sankey2 <- cohort_sankey2 %>%
-    left_join(section_names, by = c("SECTIONNAME.y" = "old"))
-  cohort_sankey2$SECTIONNAME.y <- cohort_sankey2$new
-  cohort_sankey2 <- cohort_sankey2[, -c(10, 11, 12)]
+    cohort_sankey2 <- cohort_sankey2 %>%
+      left_join(section_names, by = c("SECTIONNAME.y" = "old"))
+    cohort_sankey2$SECTIONNAME.y <- cohort_sankey2$new
+    cohort_sankey2 <- cohort_sankey2[, -c(10, 11, 12)]
 
-  cohort_sankey2$SECTIONNAME.y[is.na(cohort_sankey2$SECTIONNAME.y) == TRUE] <- "Other"
-  cohort_sankey2$SECTIONNAME.x[is.na(cohort_sankey2$SECTIONNAME.x) == TRUE] <- "Other"
+    cohort_sankey2$SECTIONNAME.y[is.na(cohort_sankey2$SECTIONNAME.y) == TRUE] <- "Other"
+    cohort_sankey2$SECTIONNAME.x[is.na(cohort_sankey2$SECTIONNAME.x) == TRUE] <- "Other"
 
-  cohort_sankey2 <- cohort_sankey2 %>%
-    group_by(sex.x, subject_name.x, YAG.x, SECTIONNAME.x, YAG.y, SECTIONNAME.y) %>%
-    dplyr::summarise(count = sum(count.x)) %>%
-    arrange(., -count)
+    cohort_sankey2 <- cohort_sankey2 %>%
+      group_by(sex.x, subject_name.x, YAG.x, SECTIONNAME.x, YAG.y, SECTIONNAME.y) %>%
+      dplyr::summarise(count = sum(count.x)) %>%
+      arrange(., -count)
 
-  # Now name nodes
+    # Now name nodes
 
-  nodes <- data.frame("name" = c(
-    unique(cohort_sankey1$SECTIONNAME.x),
-    unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x)),
-    unique(cohort_sankey2$SECTIONNAME.y)
-  ))
+    nodes <- data.frame("name" = c(
+      unique(cohort_sankey1$SECTIONNAME.x),
+      unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x)),
+      unique(cohort_sankey2$SECTIONNAME.y)
+    ))
 
-  nodes$ID <- 0:(nrow(nodes) - 1)
+    nodes$ID <- 0:(nrow(nodes) - 1)
 
-  # View nodes and separate into 3 sections to join the ID numbers into links.
+    # View nodes and separate into 3 sections to join the ID numbers into links.
 
-  nodes1 <- nodes[1:length(unique(cohort_sankey1$SECTIONNAME.x)), ]
-  nodes2 <- nodes[(length(unique(cohort_sankey1$SECTIONNAME.x)) + 1):((length(unique(cohort_sankey1$SECTIONNAME.x))) + length(unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x)))), ]
-  nodes3 <- nodes[((length(unique(cohort_sankey1$SECTIONNAME.x))) + length(unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x))) + 1):nrow(nodes), ]
+    nodes1 <- nodes[1:length(unique(cohort_sankey1$SECTIONNAME.x)), ]
+    nodes2 <- nodes[(length(unique(cohort_sankey1$SECTIONNAME.x)) + 1):((length(unique(cohort_sankey1$SECTIONNAME.x))) + length(unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x)))), ]
+    nodes3 <- nodes[((length(unique(cohort_sankey1$SECTIONNAME.x))) + length(unique(c(cohort_sankey1$SECTIONNAME.y, cohort_sankey2$SECTIONNAME.x))) + 1):nrow(nodes), ]
 
-  # Create links for 1-3 YAG ------------------------------------------------
-
-  links1 <- as.data.frame(
-    cohort_sankey1[, c(4, 6, 7)],
-    byrow = TRUE, ncol = 3
-  )
+    # Create links for 1-3 YAG ------------------------------------------------
 
-  names(links1) <- c("source", "target", "value")
+    links1 <- as.data.frame(
+      cohort_sankey1[, c(4, 6, 7)],
+      byrow = TRUE, ncol = 3
+    )
 
-  # Change names in links to numbers
+    names(links1) <- c("source", "target", "value")
 
-  links1 <- links1 %>%
-    left_join(nodes1, by = c("source" = "name"))
-  links1$source <- links1$ID
-  links1 <- links1[, -4]
+    # Change names in links to numbers
 
-  links1 <- links1 %>%
-    left_join(nodes2, by = c("target" = "name"))
-  links1$target <- links1$ID
-  links1 <- links1[, -4]
+    links1 <- links1 %>%
+      left_join(nodes1, by = c("source" = "name"))
+    links1$source <- links1$ID
+    links1 <- links1[, -4]
 
+    links1 <- links1 %>%
+      left_join(nodes2, by = c("target" = "name"))
+    links1$target <- links1$ID
+    links1 <- links1[, -4]
 
-  # Create links for 3-5 YAG ------------------------------------------------
 
-  links2 <- as.data.frame(
-    cohort_sankey2[, c(4, 6, 7)],
-    byrow = TRUE, ncol = 3
-  )
+    # Create links for 3-5 YAG ------------------------------------------------
 
-  names(links2) <- c("source", "target", "value")
+    links2 <- as.data.frame(
+      cohort_sankey2[, c(4, 6, 7)],
+      byrow = TRUE, ncol = 3
+    )
 
-  # Change names in links to numbers
+    names(links2) <- c("source", "target", "value")
 
-  links2 <- links2 %>%
-    left_join(nodes2, by = c("source" = "name"))
-  links2$source <- links2$ID
-  links2 <- links2[, -4]
+    # Change names in links to numbers
 
-  links2 <- links2 %>%
-    left_join(nodes3, by = c("target" = "name"))
-  links2$target <- links2$ID
-  links2 <- links2[, -4]
+    links2 <- links2 %>%
+      left_join(nodes2, by = c("source" = "name"))
+    links2$source <- links2$ID
+    links2 <- links2[, -4]
 
+    links2 <- links2 %>%
+      left_join(nodes3, by = c("target" = "name"))
+    links2$target <- links2$ID
+    links2 <- links2[, -4]
 
-  # join the 2 links together
 
-  links <- links1 %>%
-    full_join(links2)
+    # join the 2 links together
 
-  links <- links %>%
-    mutate_at(
-      "value",
-      funs(ifelse(!is.na(as.numeric(.)), round_any(as.numeric(.), 5), .))
-    )
+    links <- links1 %>%
+      full_join(links2)
 
-  # Force a space between node names and values
-  nodes$name <- paste(nodes$name, " ")
+    links <- links %>%
+      mutate_at(
+        "value",
+        funs(ifelse(!is.na(as.numeric(.)), round_any(as.numeric(.), 5), .))
+      )
 
-  plot <- sankeyNetwork(
-    Links = links, Nodes = nodes,
-    Source = "source", Target = "target",
-    Value = "value", NodeID = "name", fontSize = 10, nodePadding = 20
-  )
+    # Force a space between node names and values
+    nodes$name <- paste(nodes$name, " ")
 
+    plot <- sankeyNetwork(
+      Links = links, Nodes = nodes,
+      Source = "source", Target = "target",
+      Value = "value", NodeID = "name", fontSize = 10, nodePadding = 20
+    )
+  }
   return(plot)
 }
 

diff --git a/server.R b/server.R
@@ -49,10 +49,20 @@ server <- function(input, output, session) {
       input$qualinput
     )
   )
+
   output$sankey <- renderSankeyNetwork({
     reactiveSankey()
   })
 
+  output$sankey_flag <- renderUI({
+    if (!type_sum(reactiveSankey()) == "snkyNtwr") {
+      tagList(br(), h3("No data found for the selected filters."))
+    } else {
+      NULL
+    }
+  })
+
+
   output$sankey_title <- renderText({
     sankey_title(input$indflow.subjectinput, input$sexinput, input$qualinput)
   })

diff --git a/ui.R b/ui.R
@@ -218,8 +218,17 @@ fluidPage(
                 4,
                 div("5 years after graduation", style = "text-align: right")
               ),
-              withSpinner(
-                sankeyNetworkOutput(outputId = "sankey", height = 800)
+              conditionalPanel(
+                condition = "!is.null(output$sankey_flag)",
+                withSpinner(
+                  uiOutput("sankey_flag")
+                )
+              ),
+              conditionalPanel(
+                condition = "is.null(output$sankey_flag)",
+                withSpinner(
+                  sankeyNetworkOutput(outputId = "sankey", height = 800)
+                )
               )
             ),