Update README.md to include workflow diagram

README.md

@@ -9,6 +9,17 @@ There are 4 main script files.
 - `analysis.R` undertakes an accessibility analysis and an underutilisation analysis of the results of adding the additional destination locations.
 - `intervention cycling speed.R` alters the network by reducing cycling speed on residential streets.
 
+```mermaid
+flowchart TD
+    subgraph Workflow
+        direction LR 
+        baseline.R --> a(intervention cycling speed.R)
+        baseline.R --> b(intervention destinations.R)
+        b --> analysis.R
+    end
+    Workflow<-- imports as required ---c(functions/*.R)
+```
+
 # Input files
 The code requires the following input files, which are available [to authorised users] at [*insert location when known*].  The code assumes that the input files are located in a `data` directory ("../data/") which sits beside the directory in which the script files are located .
 

analysis.R

@@ -20,6 +20,7 @@ library(igraph)
 library(doSNOW)
 library(parallel)
 library(foreach)
+library(openxlsx)
 
 
 ## 1.2 Functions ----
@@ -98,7 +99,7 @@ for (i in 1:length(intervention.destinations[[1]])) {
 
 # local government areas
 LGAs <- read_zipped_GIS(zipfile = "../data/original/LGAs.zip",
-                         subpath = "/mga94_55/esrishape/whole_of_dataset/victoria/VMADMIN")
+                        subpath = "/mga94_55/esrishape/whole_of_dataset/victoria/VMADMIN")
 
 # SA2s
 SA2s <- read_zipped_GIS(zipfile = "../data/original/1270055001_sa2_2016_aust_shape.zip") %>%
@@ -158,7 +159,7 @@ if (find.accessibility.node.distances) {
   #                               multiple.destinations,
   #                               mode = "walk")
 
-
+  
   # cycle
   baseline.node.distances.cycle <-
     addressDestinationDistances(baseline.destinations,
@@ -231,7 +232,7 @@ if (find.accessibility.node.distances) {
 
   # save output
   write.csv(intervention.node.distances.cycle, "./output/node_distances_intervention_cycle.csv", row.names = FALSE)
-
+  
 }
 
 ## 2.2 Read in node distances and calculate scores ----
@@ -332,7 +333,7 @@ walk.scores <- read.xlsx(accessibility.tables.location,
                 score_single_hard_base, score_single_hard_int,
                 score_single_hard_diff, score_single_hard_rank)
 cycle.scores <- read.xlsx(accessibility.tables.location,
-                         sheet = "LGA accessibility scores cycle") %>%
+                          sheet = "LGA accessibility scores cycle") %>%
   dplyr::select(group, LGA, 
                 score_single_hard_base, score_single_hard_int,
                 score_single_hard_diff, score_single_hard_rank)
@@ -531,11 +532,11 @@ addDestType <- function(people.served) {
       attribute == "bus"                    ~ "bus",
       attribute == "tram"                   ~ "tram",  # OMIT
       str_detect(dest_class, "train")       ~ "train",  # OMIT
-     )) %>%
+    )) %>%
     filter(!dest_type %in% c("restaurant", "library", "tram", "train"))
 }
 
-# for each new destination, dwellings served / dwelling requirement
+# for each new destination, people served / population requirement
 utilisation.new.walk <- people.served.new.walk %>%
   left_join(pop.reqts, by = "dest_type") %>%
   mutate(utilisation = served / pop_reqt)
@@ -656,7 +657,7 @@ LGA.ac.dwel <- residential.addresses %>%
   group_by(NAME, group) %>%
   summarise(dwel = sum(dwel_wt)) %>%
   ungroup()
-  
+
 # area of ACs in LGAs
 LGA.ac.area <- ac.catchment.polygons %>%
   summarise() %>%
@@ -675,11 +676,11 @@ LGA.density <- LGA.ac.dwel %>%
 meanUtilScore <- function(underutilisation.tables.location, sheet.name, LGA.density) {
 
   output <- read.xlsx(underutilisation.tables.location, sheet = sheet.name) %>%
-           # calculate mean of the individual destination values
-           mutate(mean_util = rowMeans(select(., -c(NAME, LGA, group)), na.rm = TRUE)) %>%
-           # remove the individual destination utilisations, and join density
-           dplyr::select(NAME, LGA, group, mean_util) %>%
-           left_join(LGA.density %>% dplyr::select(NAME, dwel_ha), by = "NAME")
+    # calculate mean of the individual destination values
+    mutate(mean_util = rowMeans(select(., -c(NAME, LGA, group)), na.rm = TRUE)) %>%
+    # remove the individual destination utilisations, and join density
+    dplyr::select(NAME, LGA, group, mean_util) %>%
+    left_join(LGA.density %>% dplyr::select(NAME, dwel_ha), by = "NAME")
 
   return(output)
 }
@@ -688,11 +689,11 @@ meanUtilScore <- function(underutilisation.tables.location, sheet.name, LGA.dens
 LGA.util.new.walk <- meanUtilScore(underutilisation.tables.location,
                                    "LGA new walk", LGA.density)
 LGA.util.new.cycle <- meanUtilScore(underutilisation.tables.location,
-                                   "LGA new cycle", LGA.density)
+                                    "LGA new cycle", LGA.density)
 LGA.util.existing.walk <- meanUtilScore(underutilisation.tables.location,
-                                   "LGA existing walk", LGA.density)
+                                        "LGA existing walk", LGA.density)
 LGA.util.existing.cycle <- meanUtilScore(underutilisation.tables.location,
-                                   "LGA existing cycle", LGA.density)
+                                         "LGA existing cycle", LGA.density)
 
 # plot density against utilisation
 utilPlot <- function(LGA.util.data) {

functions/addressDestinationDistances.R

@@ -82,8 +82,9 @@ addressDestinationDistances <- function(destinations,
   # loop to find distances for each destination
   # ---------------------------------#
 
-  for (i in 1:length(destination.types)) {
-  # for (i in c(14:16)) {
+  # for (i in 1:length(destination.types)) {
+  for (i in c(13:length(destination.types), 1:12)) {  # park first because needs most memory!
+  # for (i in c(13:16)) {
 
     # load destinations
     # ---------------------------------#

intervention destinations.R

@@ -79,9 +79,9 @@ BUFFDIST.SMALL <- 400  # distance to buffer small ACs
 BUFFDIST.MED.LARGE <- 800  # distance to buffer medium and large ACs
 
 # ordering parameter - select one
-# processing.order <- "neediest-first"
+processing.order <- "neediest-first"
 # processing.order <- "least-needy-first"
-processing.order <- "small-first"
+# processing.order <- "small-first"
 # processing.order <- "large-first"
 
 
@@ -181,7 +181,7 @@ intervention.tables.location <- "./output/intervention tables.xlsx"
 
 for (i in 1:length(destination.types)) {
 # for (i in 2:4) { 
-# for (i in c(1, 14, 13)) {
+# for (i in c(13:16)) {
 
   # set up intervention location (to write results)
   # -----------------------------------#
@@ -304,7 +304,7 @@ for (i in 1:length(destination.types)) {
       mutate(size_group = ifelse(size == "small", "small", "large"))%>%
       mutate(size_group = factor(size_group, levels = c("small", "large"))) %>%
       # small to large, then neediest
-      arrange(dessc(size_group), get(destination.field), desc(no.addresses))
+      arrange(desc(size_group), get(destination.field), desc(no.addresses))
   }  
 
   # for park (polygons), find entry nodes for baseline locations (see findEntryNodes.R for details)
@@ -442,34 +442,6 @@ for (i in 1:length(destination.types)) {
 
 ## 2.2 Assemble final locations ----
 ## -----------------------------------------------------------------------------#
-# Option if final locations are being assembled from 'small-first' and 'large-first'
-# (adapt if assembled in some other way)
-
-for (i in 1:length(destination.types)) {
-  destination.type <- destination.types[i]
-
-  # read in the relevant layer
-  if (destination.type %in% c("convenience_store", "restaurant_cafe", "park", "bus")) {
-    if (destination.type %in% st_layers(intervention.location.small.first)$name) {
-      dest.layer <- st_read(intervention.location.small.first, layer = destination.type)
-
-      # write to final location
-      st_write(dest.layer,
-               intervention.location.final, layer = destination.type,
-               delete_layer = TRUE)
-    }
-  }  else {
-    if (destination.type %in% st_layers(intervention.location.large.first)$name) {
-      dest.layer <- st_read(intervention.location.large.first, layer = destination.type)
-
-      # write to final location
-      st_write(dest.layer,
-               intervention.location.final, layer = destination.type,
-               delete_layer = TRUE)
-    }
-  }
-}
-
 # Using neediest-first as final
 for (i in 1:length(destination.types)) {
   destination.type <- destination.types[i]
@@ -485,7 +457,37 @@ for (i in 1:length(destination.types)) {
   }
 }
 
-# BUT ALSO CONSIDER doing the comparison table in 3.2, then assembling the final from the lowest?
+# # Another option if final locations are being assembled from 'small-first' and 'large-first'
+# # (adapt if assembled in some other way)
+# 
+# for (i in 1:length(destination.types)) {
+#   destination.type <- destination.types[i]
+#   
+#   # read in the relevant layer
+#   if (destination.type %in% c("convenience_store", "restaurant_cafe", "park", "bus")) {
+#     if (destination.type %in% st_layers(intervention.location.small.first)$name) {
+#       dest.layer <- st_read(intervention.location.small.first, layer = destination.type)
+#       
+#       # write to final location
+#       st_write(dest.layer,
+#                intervention.location.final, layer = destination.type,
+#                delete_layer = TRUE)
+#     }
+#   }  else {
+#     if (destination.type %in% st_layers(intervention.location.large.first)$name) {
+#       dest.layer <- st_read(intervention.location.large.first, layer = destination.type)
+#       
+#       # write to final location
+#       st_write(dest.layer,
+#                intervention.location.final, layer = destination.type,
+#                delete_layer = TRUE)
+#     }
+#   }
+# }
+# 
+# # Also considered - doing the comparison table in 3.2, then assembling the final 
+# # from the lowest result for each destination type (would require some re-working
+# # of the order of 2.2 and 3)
 
 
 # 3 Output tables ----
@@ -577,10 +579,10 @@ order.comparison.table <- neediest.first.table %>%
                                        "total"))) %>%
   arrange(dest_type)
 
-##  would it be good to add a final column saying which is the lowest?  testing
+# add a final column saying which is the lowest
 for (i in 1:nrow(order.comparison.table)) {
   row <- order.comparison.table[i, ] %>% dplyr::select(-dest_type)
-  lowest.col <- colnames(row)[which.min(row[1, ])]  # not quite sure about this - do I need the 1?
+  lowest.col <- colnames(row)[which.min(row[1, ])]  
   order.comparison.table[i, "lowest"] <- lowest.col
 }