Style package with styler.equals::style_pkg()

R/aggregate.R

@@ -61,7 +61,7 @@
 #' subzones = od_data_zones_small
 #' try(od_disaggregate(od, zones, subzones))
 #' od_disag = od_disaggregate(od, zones, subzones, max_per_od = 500)
-#' ncol(od_disag) -3 == ncol(od) # same number of columns, the same...
+#' ncol(od_disag) - 3 == ncol(od) # same number of columns, the same...
 #' # Except disag data gained geometry and new agg ids:
 #' sum(od_disag[[3]]) == sum(od[[3]])
 #' sum(od_disag[[4]]) == sum(od[[4]])
@@ -81,12 +81,11 @@ od_disaggregate = function(od,
                            population_column = 3,
                            max_per_od = 5,
                            keep_ids = TRUE,
-                           integer_outputs = FALSE
-                           ) {
+                           integer_outputs = FALSE) {
   od$nrows = od_nrows(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
-  if(methods::is(object = od, class2 = "sf")) {
+  if (methods::is(object = od, class2 = "sf")) {
     message("Input object is sf, attempting to convert to a data frame")
     od = sf::st_drop_geometry(od)
   }
@@ -134,7 +133,7 @@ od_disaggregate = function(od,
       max_n_od = ceiling(od[[population_column]][i] / max_per_od)
       o_options = subpoints[[1]][subpoints[[azn]] == od[[1]][i]]
       d_options = subpoints[[1]][subpoints[[azn]] == od[[2]][i]]
-      if(max_n_od > length(o_options) || max_n_od > length(d_options)) {
+      if (max_n_od > length(o_options) || max_n_od > length(d_options)) {
         warning("Insufficient subzones/points to prevent duplicate desire lines")
         message("Sampling may fail. Try again with larger max_per_od")
       }
@@ -145,17 +144,17 @@ od_disaggregate = function(od,
       odn_list = lapply(od[i, -c(1, 2)], function(x) x / nrow(od_new))
       odns = as.data.frame(odn_list)[rep(1, nrow(od_new)), , drop = FALSE]
       names(odns) = numeric_col_names
-      if(integer_outputs) {
+      if (integer_outputs) {
         odns[] = apply(odns, 2, function(x) smart.round(x))
       }
       od_new = cbind(od_new, odns)
-      if(keep_ids) {
+      if (keep_ids) {
         od_new$o_agg = od[[1]][i]
         od_new$d_agg = od[[2]][i]
       }
       od_new_sf = od::od_to_sf(od_new, subpoints, silent = TRUE)
       # Remove sampled points from 'universe' of available points
-      if(i < nrow(od)) {
+      if (i < nrow(od)) {
         subpoints <<- subpoints[!subpoints[[1]] %in% c(o, d), ]
       }
       od_new_sf
@@ -225,7 +224,7 @@ od_split = od_disaggregate
 
 smart.round = function(x) {
   y = floor(x)
-  indices = utils::tail(order(x-y), round(sum(x)) - sum(y))
+  indices = utils::tail(order(x - y), round(sum(x)) - sum(y))
   y[indices] = y[indices] + 1
   y
 }
@@ -240,7 +239,7 @@ smart.round = function(x) {
 #' \dontrun{
 #' u = "https://github.com/ITSLeeds/od/releases/download/v0.3.1/road_network_min.Rds"
 #' f = basename(u)
-#' if(!file.exists(f)) download.file(u, f)
+#' if (!file.exists(f)) download.file(u, f)
 #' road_network_min = readRDS(f)
 #' od_sample_vertices(road_network_min)
 #' }
@@ -292,7 +291,7 @@ od_sample_points = function(subpoints, subdf, z, per_zone, azn = "azn") {
   subpoints_joined = sf::st_join(sf::st_sf(subpoints), z[1])
   sel_list = lapply(1:nrow(per_zone), function(i) {
     which_points = which(subpoints_joined[[1]] == per_zone[[1]][i])
-    if(length(which_points) == 0) {
+    if (length(which_points) == 0) {
       return(NULL)
     }
     sample(which_points, size = per_zone[[2]][i])

R/jitter.R

@@ -67,30 +67,30 @@
 #' # plot(dlr3[od$all > 200, 1])
 #' # mapview::mapview(od_sf$geometry[od$all > 200])
 od_jitter = function(
-  od,
-  z,
-  subpoints = NULL,
-  code_append = "_ag",
-  population_column = 3,
-  max_per_od = 100000,
-  keep_ids = TRUE,
-  integer_outputs = FALSE,
-  # od_jitter-specific arguments (and zd)
-  zd = NULL,
-  subpoints_o = NULL,
-  subpoints_d = NULL,
-  disag = FALSE
-  ) {
-
+    od,
+    z,
+    subpoints = NULL,
+    code_append = "_ag",
+    population_column = 3,
+    max_per_od = 100000,
+    keep_ids = TRUE,
+    integer_outputs = FALSE,
+    # od_jitter-specific arguments (and zd)
+    zd = NULL,
+    subpoints_o = NULL,
+    subpoints_d = NULL,
+    disag = FALSE) {
   if (!methods::is(od, "sf")) {
     # the data structure to reproduce for matching OD pairs
     od = od::od_to_sf(od, z = z, zd = zd)
   }
   disag = all(is.null(zd), is.null(subpoints_o), is.null(subpoints_d), disag)
-  if(disag) {
+  if (disag) {
     message("Using od_disaggregate") # todo remove once tested
-    return(od_disaggregate(od, z, subpoints, code_append, population_column,
-                           max_per_od, keep_ids, integer_outputs))
+    return(od_disaggregate(
+      od, z, subpoints, code_append, population_column,
+      max_per_od, keep_ids, integer_outputs
+    ))
   }
   odc_new = odc_original = od::od_coordinates(od)
   od = sf::st_drop_geometry(od)
@@ -101,7 +101,7 @@ od_jitter = function(
   names(points_per_zone)[1] = names(z)[1]
   points_per_zone_joined = merge(sf::st_drop_geometry(z), points_per_zone)
   # unique_zone_codes = points_per_zone_joined[[1]]
-  zo = z[match(points_per_zone[[1]], z[[1]], nomatch = FALSE) ,]
+  zo = z[match(points_per_zone[[1]], z[[1]], nomatch = FALSE), ]
   # browser()
   if (is.null(subpoints_o)) {
     subpoints_o = sf::st_sample(zo, size = points_per_zone_joined$Freq)
@@ -118,18 +118,19 @@ od_jitter = function(
   for (i in unique_zones) {
     # total number of origins and destinations
     n_origins = sum(od[[1]] == i)
-    if (n_origins == 0)
+    if (n_origins == 0) {
       next()
+    }
     sel_sj = which(sj_df$geo_code == i)
-    if(n_origins > length(sel_sj)) {
+    if (n_origins > length(sel_sj)) {
       sel_sj_o = sel_sj[sample(length(sel_sj), size = n_origins, replace = TRUE)]
     } else {
       sel_sj_o = sel_sj[sample(length(sel_sj), size = n_origins)]
     }
     odc_new[od[[1]] == i, "ox"] = sj_df$x[sel_sj_o]
     odc_new[od[[1]] == i, "oy"] = sj_df$y[sel_sj_o]
     # remove those random points from the list of options
-    sj_df = sj_df[-sel_sj_o,]
+    sj_df = sj_df[-sel_sj_o, ]
   }
 
   if (is.null(zd)) {
@@ -140,7 +141,7 @@ od_jitter = function(
 
   id_destinations = od[[2]]
   points_per_zone = data.frame(table(id_destinations))
-  zd = zd[match(points_per_zone[[1]], zd[[1]], nomatch = FALSE) ,]
+  zd = zd[match(points_per_zone[[1]], zd[[1]], nomatch = FALSE), ]
   if (is.null(subpoints_d)) {
     names(points_per_zone)[1] = names(zd)[1]
     points_per_zone_joined_d = merge(sf::st_drop_geometry(zd), points_per_zone)
@@ -159,19 +160,20 @@ od_jitter = function(
   i = unique_zones_d[1]
   for (i in unique_zones_d) {
     n_destinations = sum(od[[2]] == i)
-    if (n_destinations == 0)
+    if (n_destinations == 0) {
       next()
+    }
     # when there are subpoints
     sel_sj = which(sj_df_d$geo_code == i)
-    if(n_destinations > length(sel_sj)) {
+    if (n_destinations > length(sel_sj)) {
       sel_sj_d = sel_sj[sample(length(sel_sj), size = n_destinations, replace = TRUE)]
     } else {
       sel_sj_d = sel_sj[sample(length(sel_sj), size = n_destinations)]
     }
     odc_new[od[[2]] == i, "dx"] = sj_df_d$x[sel_sj_d]
     odc_new[od[[2]] == i, "dy"] = sj_df_d$y[sel_sj_d]
     # remove those random points from the list of options
-    sj_df = sj_df[-sel_sj_d,]
+    sj_df = sj_df[-sel_sj_d, ]
   }
   sf::st_sf(od, geometry = odc_to_sfc_sf(odc_new, crs = sf::st_crs(z)))
 }

R/network.R

@@ -37,20 +37,24 @@ od_to_network = function(x, z, zd = NULL, silent = TRUE, package = "sf", crs = 4
   #          g[sample(nrow(g), size = uoid[i]), ]
   #        })
   # i = 1
-  l_origin = lapply(seq(nrow(x)),
-                    function(i) {
-                      g = net_o[net_o[[z_nm]] == x[[1]][i], ]
-                      g[sample(nrow(g), size = 1), ]
-                    })
+  l_origin = lapply(
+    seq(nrow(x)),
+    function(i) {
+      g = net_o[net_o[[z_nm]] == x[[1]][i], ]
+      g[sample(nrow(g), size = 1), ]
+    }
+  )
   d_origin = do.call(rbind, l_origin)
   # d_origin$geo_code == x[[1]] TRUE
   odc_origin = sf::st_coordinates(d_origin)
 
-  l_destination = lapply(seq(nrow(x)),
-                         function(i) {
-                           g = net_d[net_d[[z_nm]] == x[[2]][i], ]
-                           g[sample(nrow(g), size = 1), ]
-                         })
+  l_destination = lapply(
+    seq(nrow(x)),
+    function(i) {
+      g = net_d[net_d[[z_nm]] == x[[2]][i], ]
+      g[sample(nrow(g), size = 1), ]
+    }
+  )
   d_destination = do.call(rbind, l_destination)
   odc_destination = sf::st_coordinates(d_destination)