Refactor

NEWS.md

@@ -1,6 +1,6 @@
 # od 0.3.2 (2021-12)
 
-* `od_disaggregate()` can now take route networks as inputs (experimental)
+* `od_disaggregate()` can now take route networks as inputs
 
 # od 0.3.1 (2021-07)
 

R/aggregate.R

@@ -82,8 +82,7 @@ od_disaggregate = function(od,
                            integer_outputs = FALSE
                            ) {
 
-  nrow_od_disag = ceiling(od[[population_column]] / max_per_od)
-  nr = sum(nrow_od_disag)
+  od$nrow_disag = od_disag_rows(od, population_column, max_per_od)
   azn = paste0(names(z)[1], code_append)
 
   # is the input od data an sf object? tell the user and convert to df if so
@@ -96,13 +95,16 @@ od_disaggregate = function(od,
     message("Creating randomly sampled origin and destination points.")
     # from jitter.R
     # todo: consider splitting this out into new function
-    od_disag_indices = rep(x = seq(nrow(od)), nrow_od_disag)
+    od_disag_indices = rep(x = seq(nrow(od)), od$nrow_disag)
     od_disag_ids = od[od_disag_indices, c(1:2)]
-    id_zones = c(od_disag_ids[[1]], od_disag_ids[[2]])
+    id_zones = od_zoneids(od_disag_ids)
     points_per_zone = data.frame(table(id_zones))
     z = z[z[[1]] %in% points_per_zone[[1]], ]
     freq = points_per_zone$Freq
-    subpoints_df = data.frame(id = as.character(seq(nr * 2)), azn = sort(id_zones))
+    subpoints_df = data.frame(
+      id = as.character(seq(sum(od$nrow_disag) * 2)),
+      azn = sort(id_zones)
+      )
     names(subpoints_df)[2] = azn
     subpoints = sf::st_sf(subpoints_df, geometry = sf::st_sample(z, freq))
   }
@@ -127,16 +129,16 @@ od_disaggregate = function(od,
   }
 
   if (methods::is(subpoints, "sfc")) {
-    if(length(subpoints) > nr * 2) {
+    if(length(subpoints) > sum(od$nrow_disag) * 2) {
       # from jitter.R
       # todo: consider splitting this out into new function
-      od_disag_indices = rep(x = seq(nrow(od)), nrow_od_disag)
-      od_disag_ids = od[od_disag_indices, c(1:2)]
-      id_zones = c(od_disag_ids[[1]], od_disag_ids[[2]])
-      points_per_zone = data.frame(table(id_zones))
+      points_per_zone = od_points_per_zone(od, od$nrow_disag)
       z = z[z[[1]] %in% points_per_zone[[1]], ]
       freq = points_per_zone$Freq
-      subpoints_df = data.frame(id = as.character(seq(nr * 2)), azn = sort(id_zones))
+      subpoints_df = data.frame(
+        id = as.character(seq(sum(od$nrow_disag) * 2)),
+        azn = sort(points_per_zone[[1]])
+        )
       subpoints_joined = sf::st_join(sf::st_sf(subpoints), z[1])
       sel_list = lapply(1:nrow(points_per_zone), function(i) {
         sample(
@@ -148,12 +150,10 @@ od_disaggregate = function(od,
       names(subpoints_df)[2] = azn
       subpoints = sf::st_sf(subpoints_df, geometry = subpoints[sel])
     } else {
-      suppressMessages({
-        subpoints = sf::st_sf(
-          id = as.character(seq(nr * 2)),
-          geometry = subpoints
-        )
-      })
+      subpoints = sf::st_sf(
+        id = as.character(seq(sum(od$nrow_disag) * 2)),
+        geometry = subpoints
+      )
     }
   }
 
@@ -315,3 +315,22 @@ od_sample_vertices = function(x, fraction = 1) {
   }
   x_point
 }
+
+#' @examples
+#' \dontrun{
+#' od_points_per_zone(od::od_data_df)
+#' }
+od_points_per_zone = function(od, nrow_od_disag) {
+  od_disag_indices = rep(x = seq(nrow(od)), nrow_od_disag)
+  od_disag_ids = od[od_disag_indices, c(1:2)]
+  id_zones = od_zoneids(od_disag_ids)
+  data.frame(table(id_zones))
+}
+
+od_zoneids = function(od) {
+  c(od[[1]], od[[2]])
+}
+
+od_disag_rows = function(od, population_column, max_per_od) {
+  ceiling(od[[population_column]] / max_per_od)
+}