diff --git a/R/industry_flow.R b/R/industry_flow.R index 972e37f..8905ae7 100644 --- 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 index 13ea1f5..335abee 100644 --- 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 index 3847512..3d4317a 100644 --- 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) + ) ) ),