Use consistent code style - styler::style_pkg()

R/SpatialLinesNetwork.R

@@ -107,19 +107,19 @@ SpatialLinesNetwork.Spatial <- function(sl, uselonglat = FALSE, tolerance = 0.00
   # line lengths:
   # If uselonglat == FALSE then checks if sl uses longlat coordinate
   # system/projection. If so, passes longlat=TRUE.
-  sl$length <- sapply(sl@lines, function(x)
+  sl$length <- sapply(sl@lines, function(x) {
     sp::LineLength(x@Lines[[1]], longlat = ifelse(
       uselonglat == TRUE, TRUE, ifelse(length(grep(
         "proj=longlat", sp::proj4string(sl)
       )) > 0, TRUE, FALSE)
-    )))
+    ))
+  })
   igraph::E(g)$weight <- sl$length
   new("SpatialLinesNetwork", sl = sl, g = g, nb = gdata$nb, weightfield = "length")
 }
 #' @export
 SpatialLinesNetwork.sf <- function(sl, uselonglat = FALSE, tolerance = 0.000) {
-
-    nodecoords <- as.data.frame(sf::st_coordinates(sl)) %>%
+  nodecoords <- as.data.frame(sf::st_coordinates(sl)) %>%
     dplyr::group_by(.data$L1) %>%
     dplyr::mutate(nrow = dplyr::n(), rownum = 1:dplyr::n()) %>%
     dplyr::filter(.data$rownum == 1 | .data$rownum == (!!dplyr::quo(nrow))) %>%
@@ -151,7 +151,7 @@ SpatialLinesNetwork.sf <- function(sl, uselonglat = FALSE, tolerance = 0.000) {
   igraph::E(g)$weight <- sl$length
   # check it is a single graph
   is_connected <- igraph::is_connected(g)
-  if(!is_connected) {
+  if (!is_connected) {
     warning("Graph composed of multiple subgraphs, consider cleaning it with sln_clean_graph().")
   }
   # largest_group = names(which.max(graph_membership_table))
@@ -169,12 +169,12 @@ SpatialLinesNetwork.sf <- function(sl, uselonglat = FALSE, tolerance = 0.000) {
 #' @export
 sln_clean_graph <- function(sln) {
   g <- sln@g
-  graph_membership = igraph::components(g)$membership
-  graph_membership_table = table(graph_membership)
-  if(length(graph_membership_table) > 1) {
+  graph_membership <- igraph::components(g)$membership
+  graph_membership_table <- table(graph_membership)
+  if (length(graph_membership_table) > 1) {
     message("Input sln composed of ", length(graph_membership_table), " graphs. Selecting the largest.")
-    }
-  largest_group = names(which.max(graph_membership_table))
+  }
+  largest_group <- names(which.max(graph_membership_table))
   connected_vertexes <- igraph::V(g)[which(graph_membership == largest_group)]
   connected_edges <- igraph::E(g)[.inc(connected_vertexes)]
   temp_sl <- sln@sl[as.numeric(connected_edges), ]
@@ -736,9 +736,9 @@ sln2points <- function(sln) {
 #' sln_sf <- SpatialLinesNetwork(route_network_sf)
 #' plot(sln_sf)
 #' nodes_df <- data.frame(
-#'     start = rep(c(1, 2, 3, 4, 5), each = 4),
-#'     end = rep(c(50, 51, 52, 33), times = 5)
-#'   )
+#'   start = rep(c(1, 2, 3, 4, 5), each = 4),
+#'   end = rep(c(50, 51, 52, 33), times = 5)
+#' )
 #' weightfield(sln_sf) # field used to determine shortest path
 #' library(sf)
 #' shortpath_sf <- sum_network_links(sln_sf, nodes_df)

R/catchmentArea.R

@@ -66,7 +66,7 @@
 #' plot(testcycleway, col = "red", add = TRUE)
 #' sa1income <- sf::read_sf("smallsa1.shp")
 #' testcycleway <- sf::read_sf("testcycleway.shp")
-#' f = list.files(".", "testcycleway|smallsa1")
+#' f <- list.files(".", "testcycleway|smallsa1")
 #' file.remove(f)
 #' cway_catch <- calc_catchment(
 #'   polygonlayer = sa1income,
@@ -128,10 +128,12 @@ calc_catchment.Spatial <- function(
     rgeos::gIntersection(polygonlayer, targetbuffer, byid = TRUE)
   targetintersect <- sp::SpatialPolygonsDataFrame(targetintersect,
     data = data.frame(
-      calc_catchment_charid = sapply(targetintersect@polygons, function(x)
-        x@ID),
-      row.names = sapply(targetintersect@polygons, function(x)
-        x@ID)
+      calc_catchment_charid = sapply(targetintersect@polygons, function(x) {
+        x@ID
+      }),
+      row.names = sapply(targetintersect@polygons, function(x) {
+        x@ID
+      })
     )
   )
 
@@ -168,7 +170,7 @@ calc_catchment.Spatial <- function(
     targetintersectd <- rgeos::gUnaryUnion(targetintersect, id = targetintersect$calc_catchment_targetid)
     targetcols <- colnames(targetlayer@data)
     targetcols <- targetcols[which(targetcols != "calc_catchment_charid")]
-    targetintersect@data[targetcols] <- lapply(targetcols, function(x){
+    targetintersect@data[targetcols] <- lapply(targetcols, function(x) {
       as.character(targetintersect@data[[x]])
     })
     targetintersectd_data <- as.data.frame(

R/geo_projected.R

@@ -74,7 +74,7 @@ geo_select_aeq.sfc <- function(shp) {
 #' lib_versions <- sf::sf_extSoftVersion()
 #' lib_versions
 #' # fails on some systems (with early versions of PROJ)
-#' if(lib_versions[3] >= "6.3.1") {
+#' if (lib_versions[3] >= "6.3.1") {
 #'   shp <- routes_fast_sf[2:4, ]
 #'   geo_projected(shp, sf::st_buffer, dist = 100)
 #' }
@@ -161,7 +161,7 @@ gprojected <- geo_projected.Spatial
 #' @examples
 #' lib_versions <- sf::sf_extSoftVersion()
 #' lib_versions
-#' if(lib_versions[3] >= "6.3.1") {
+#' if (lib_versions[3] >= "6.3.1") {
 #'   buff_sf <- geo_buffer(routes_fast_sf, dist = 50)
 #'   plot(buff_sf$geometry, add = TRUE)
 #'   geo_buffer(routes_fast_sf$geometry, dist = 50)
@@ -195,7 +195,7 @@ geo_buffer.Spatial <- function(shp, ...) {
 #' @examples
 #' lib_versions <- sf::sf_extSoftVersion()
 #' lib_versions
-#' if(lib_versions[3] >= "6.3.1") {
+#' if (lib_versions[3] >= "6.3.1") {
 #'   geo_length(routes_fast)
 #'   geo_length(routes_fast_sf)
 #' }

R/gps.R

@@ -1 +1 @@
-# Eventually this will contain functions with gps functions
+# Eventually this will contain functions with gps functions

R/line_breakup.R

@@ -11,7 +11,7 @@
 #' @export
 #' @examples
 #' library(sf)
-#' z = zones_sf$geometry
+#' z <- zones_sf$geometry
 #' l <- routes_fast_sf$geometry[2]
 #' l_split <- line_breakup(l, z)
 #' l
@@ -26,4 +26,3 @@ line_breakup <- function(l, z) {
   l_split_linestring <- sf::st_collection_extract(l_split, type = "LINESTRING")
   l_split_linestring
 }
-

R/linefuns.R

@@ -75,7 +75,7 @@ is_linepoint <- function(l) {
 #' lib_versions <- sf::sf_extSoftVersion()
 #' lib_versions
 #' # fails on some systems (with early versions of PROJ)
-#' if(lib_versions[3] >= "6.3.1") {
+#' if (lib_versions[3] >= "6.3.1") {
 #'   bearings_sf_1_9 <- line_bearing(flowlines_sf[1:5, ])
 #'   bearings_sf_1_9 # lines of 0 length have NaN bearing
 #'   bearings_sp_1_9 <- line_bearing(flowlines[1:5, ])
@@ -101,7 +101,7 @@ line_bearing.sf <- function(l, bidirectional = FALSE) {
   p <- sf::st_geometry(line2points(l))
   i_s <- 1:length(sf::st_geometry(l)) * 2 - 1
   bearing_radians <- sapply(i_s, function(i) lwgeom::st_geod_azimuth(p[i:(i + 1)]))
-  bearing = bearing_radians * 180 / (pi)
+  bearing <- bearing_radians * 180 / (pi)
   if (bidirectional) {
     bearing <- make_bidirectional(bearing)
   }
@@ -128,9 +128,9 @@ line_bearing.sf <- function(l, bidirectional = FALSE) {
 #' lib_versions <- sf::sf_extSoftVersion()
 #' lib_versions
 #' # fails on some systems (with early versions of PROJ)
-#' if(lib_versions[3] >= "6.3.1") {
+#' if (lib_versions[3] >= "6.3.1") {
 #'   # Find all routes going North-South
-#'   lines_sf = od2line(od_data_sample, zones = zones_sf)
+#'   lines_sf <- od2line(od_data_sample, zones = zones_sf)
 #'   angle_diff(lines_sf[2, ], angle = 0)
 #'   angle_diff(lines_sf[2:3, ], angle = 0)
 #'   a <- angle_diff(flowlines, angle = 0, bidirectional = TRUE, absolute = TRUE)

R/loadABS.R

@@ -25,10 +25,10 @@
 #' @examples
 #' data_dir <- system.file("extdata", package = "stplanr")
 #' t1 <- read_table_builder(file.path(data_dir, "SA1Population.csv"))
-#' if(requireNamespace("openxlsx")) {
+#' if (requireNamespace("openxlsx")) {
 #'   t2 <- read_table_builder(file.path(data_dir, "SA1Population.xlsx"),
 #'     filetype = "xlsx", sheet = 1, removeTotal = TRUE
-#' )
+#'   )
 #' }
 #' f <- file.path(data_dir, "SA1Population.csv")
 #' sa1pop <- read.csv(f, stringsAsFactors = TRUE, header = FALSE)
@@ -41,7 +41,7 @@ read_table_builder <- function(dataset, filetype = "csv", sheet = 1, removeTotal
     tbfile <- dataset
   } else if (is.character(dataset)) {
     if (filetype == "xlsx") {
-      if(requireNamespace("openxlsx", quietly = TRUE)) {
+      if (requireNamespace("openxlsx", quietly = TRUE)) {
         tbfile <- openxlsx::readWorkbook(dataset, sheet = sheet, colNames = FALSE)
       } else {
         stop("Please install openxlsx for this to work")

R/od-funs.R

@@ -54,7 +54,6 @@ od2odf <- function(flow, zones) {
 #' od_coords(flowlines[1:3, ])
 #' od_coords(flowlines_sf[1:3, ])
 od_coords <- function(from = NULL, to = NULL, l = NULL) {
-
   if (is(object = from, class2 = "sf")) {
     is_sf_line <- all(sf::st_geometry_type(from) == "LINESTRING")
   } else {
@@ -91,7 +90,6 @@ od_coords <- function(from = NULL, to = NULL, l = NULL) {
   }
 
   as.matrix(coord_matrix)
-
 }
 
 #' Convert origin-destination coordinates into desire lines
@@ -111,24 +109,24 @@ od_coords <- function(from = NULL, to = NULL, l = NULL) {
 #' odlines <- od_coords2line(odf)
 #' odlines <- od_coords2line(odf, crs = 4326)
 #' plot(odlines)
-#' x_coords = 1:3
-#' n = 50
-#' d = data.frame(lapply(1:4, function(x) sample(x_coords, n, replace = TRUE)))
-#' names(d) = c("fx", "fy", "tx", "ty")
-#' l = od_coords2line(d)
+#' x_coords <- 1:3
+#' n <- 50
+#' d <- data.frame(lapply(1:4, function(x) sample(x_coords, n, replace = TRUE)))
+#' names(d) <- c("fx", "fy", "tx", "ty")
+#' l <- od_coords2line(d)
 #' plot(l)
 #' nrow(l)
-#' l_with_duplicates = od_coords2line(d, remove_duplicates = FALSE)
+#' l_with_duplicates <- od_coords2line(d, remove_duplicates = FALSE)
 #' plot(l_with_duplicates)
 #' nrow(l_with_duplicates)
 od_coords2line <- function(odc, crs = 4326, remove_duplicates = TRUE) {
   # check for illegal NAs in coordinates
   odm_check(odc)
   odc_unique <- odc[!duplicated(odc[, 1:4, drop = FALSE]), , drop = FALSE]
-  if(nrow(odc_unique) < nrow(odc) && remove_duplicates) {
+  if (nrow(odc_unique) < nrow(odc) && remove_duplicates) {
     message("Duplicate OD pairs identified, removing ", nrow(odc) - nrow(odc_unique), " rows")
     odc <- odc_unique
-    odc_unique$n = dplyr::group_size(dplyr::group_by_all(as.data.frame(odc[, 1:4])))
+    odc_unique$n <- dplyr::group_size(dplyr::group_by_all(as.data.frame(odc[, 1:4])))
   }
   odm <- as.matrix(odc)
   linestring_list <- lapply(seq(nrow(odm)), function(i) {
@@ -227,20 +225,18 @@ od2line.sf <- function(flow, zones, destinations = NULL,
     dest_matches <- match(flow[[dest_code]], zones[[zone_code]])
     od_matches_check(dest_matches, flow[[dest_code]], type = "destination")
     dest_points <- coords_o[dest_matches, ]
-
   } else {
-    if(is.na(zone_code_d)) {
+    if (is.na(zone_code_d)) {
       zone_code_d <- names(destinations)[1]
     }
     coords_d <- sf::st_coordinates(destinations)[, 1:2]
     dest_points <- coords_d[match(flow[[dest_code]], destinations[[zone_code_d]]), ]
   }
 
-  odm = cbind(origin_points, dest_points)
+  odm <- cbind(origin_points, dest_points)
 
   odsfc <- od_coords2line(odm, crs = sf::st_crs(zones), remove_duplicates = FALSE)
   sf::st_sf(flow, geometry = odsfc$geometry)
-
 }
 #' @export
 od2line.Spatial <- function(flow, zones, destinations = NULL,
@@ -556,9 +552,12 @@ line2route <-
 
     rc <- as.list(rep(NA, length(l)))
     for (i in 1:n_ldf) {
-      rc[[i]] <- tryCatch({
-        FUN(from = c(ldf$fx[i], ldf$fy[i]), to = c(ldf$tx[i], ldf$ty[i]), ...)
-      }, error = error_fun)
+      rc[[i]] <- tryCatch(
+        {
+          FUN(from = c(ldf$fx[i], ldf$fy[i]), to = c(ldf$tx[i], ldf$ty[i]), ...)
+        },
+        error = error_fun
+      )
       perc_temp <- i %% round(n_ldf / n_print)
       # print % of distances calculated
       if (!is.na(perc_temp) & perc_temp == 0) {
@@ -569,7 +568,7 @@ line2route <-
 
     class_out <- sapply(rc, function(x) class(x)[1])
     most_common_class <- names(sort(table(class_out), decreasing = TRUE)[1])
-    if(most_common_class == "sf") {
+    if (most_common_class == "sf") {
       message("Output is sf")
       rc_is_sf <- class_out == "sf"
       rc_sf <- rc[rc_is_sf]
@@ -652,7 +651,7 @@ line2routeRetry <- function(lines, pattern = "^Error: ", n_retry = 3, ...) {
 
         routes@data[idx_to_replace, ] <- routes_retry@data[idx_retry, ]
         routes@lines[[idx_to_replace]] <-
-          Lines(routes_retry@lines[[idx_retry]]@Lines, row.names(routes_retry[idx_retry,]))
+          Lines(routes_retry@lines[[idx_retry]]@Lines, row.names(routes_retry[idx_retry, ]))
       }
     }
   }
@@ -841,14 +840,14 @@ points2line.matrix <- function(p) {
 #' @examples
 #' od_aggregate_from(flow)
 od_aggregate_from <- function(flow, attrib = NULL, FUN = sum, ..., col = 1) {
-  if(is.character(attrib)) {
+  if (is.character(attrib)) {
     attrib_lgl <- grepl(pattern = attrib, x = names(flow))
-    if(sum(attrib_lgl) == 0){
+    if (sum(attrib_lgl) == 0) {
       stop("No columns match the attribute ", attrib)
     }
-    attrib = which(attrib_lgl)
+    attrib <- which(attrib_lgl)
   }
-  if(!is.null(attrib)) {
+  if (!is.null(attrib)) {
     flow <- flow[attrib]
   }
   flow_grouped <- dplyr::group_by_at(flow, col)
@@ -869,14 +868,14 @@ od_aggregate_from <- function(flow, attrib = NULL, FUN = sum, ..., col = 1) {
 #' @examples
 #' od_aggregate_to(flow)
 od_aggregate_to <- function(flow, attrib = NULL, FUN = sum, ..., col = 2) {
-  if(is.character(attrib)) {
+  if (is.character(attrib)) {
     attrib_lgl <- grepl(pattern = attrib, x = names(flow))
-    if(sum(attrib_lgl) == 0){
+    if (sum(attrib_lgl) == 0) {
       stop("No columns match the attribute ", attrib)
     }
-    attrib = which(attrib_lgl)
+    attrib <- which(attrib_lgl)
   }
-  if(!is.null(attrib)) {
+  if (!is.null(attrib)) {
     flow <- flow[attrib]
   }
   flow_grouped <- dplyr::group_by_at(flow, col)
@@ -942,26 +941,28 @@ odmatrix_to_od <- function(odmatrix) {
 
 # Check for NAs in matrix
 odm_check <- function(odc) {
-  if(any(is.na(odc[, 1:2]))) {
+  if (any(is.na(odc[, 1:2]))) {
     na_row <- which(is.na(odc[, 1]) | is.na(odc[, 1]))
     stop("NAs detected in the origin coordinates on row number ", na_row, call. = FALSE)
   }
-  if(any(is.na(odc[, 3:4]))) {
+  if (any(is.na(odc[, 3:4]))) {
     na_row <- which(is.na(odc[, 3]) | is.na(odc[, 4]))
     stop("NAs detected in the origin coordinates on row number ", na_row, call. = FALSE)
   }
 }
 
 # Check for NAs in od matching
 od_matches_check <- function(origin_matches, origin_codes, type = "origin") {
-  if(anyNA(origin_matches)) {
+  if (anyNA(origin_matches)) {
     n_failing <- sum(is.na(origin_matches))
     first_offending_row <- which(is.na(origin_matches))[1]
-    stop(call. = FALSE,
-         n_failing, " non matching IDs in the ", type, ". ",
-         "ID on row ",
-         first_offending_row,
-         " does not match any zone.\n",
-         "The first offending id was ", origin_codes[first_offending_row])
+    stop(
+      call. = FALSE,
+      n_failing, " non matching IDs in the ", type, ". ",
+      "ID on row ",
+      first_offending_row,
+      " does not match any zone.\n",
+      "The first offending id was ", origin_codes[first_offending_row]
+    )
   }
 }