Update docs for od_aggregate and new function

NAMESPACE

@@ -59,6 +59,7 @@ export(overline)
 export(points2flow)
 export(points2line)
 export(points2odf)
+export(quadrant)
 export(read_stats19_ac)
 export(read_stats19_ca)
 export(read_stats19_ve)

R/aggregate_funs.R

@@ -37,13 +37,30 @@
 #' data(flow)
 #' data(zones)
 #' zones@data$region <- 1
-#' zones@data[c(2,5),c('region')] <- 2
+#' zones@data[c(2, 5), c('region')] <- 2
 #' aggzones <- SpatialPolygonsDataFrame(rgeos::gUnaryUnion(
 #'  zones,
-#'  id = zones@data$region),data.frame(region=c(1,2))
+#'  id = zones@data$region), data.frame(region=c(1, 2))
 #' )
 #' zones@data$region <- NULL
 #' od_aggregate(flow, zones, aggzones)
+#' # another example with more zones and plots
+#' zones$quadrant = quadrant(zones, number_out = TRUE)
+#' aggzones <- SpatialPolygonsDataFrame(
+#' rgeos::gUnaryUnion(
+#'  zones,
+#'  id = zones@data$quadrant), data.frame(region = c(1:4))
+#' )
+#' od = od_aggregate(flow, zones, aggzones)
+#' od_sp = od2line(flow, zones)
+#' zones@data = cbind(1:nrow(zones), zones@data)
+#' od_sp_agg = od2line(od, zones, aggzones)
+#' # plot results
+#' plot(aggzones, lwd = 5)
+#' plot(zones, border = "red", add = TRUE)
+#' plot(od_sp, add = TRUE, col = "yellow")
+#' lwd = od_sp_agg$All / 50
+#' plot(od_sp_agg, lwd = lwd, add = TRUE)
 od_aggregate <- function(flow, zones, aggzones, cols = FALSE, aggcols = FALSE,
                          FUN = sum,
                          prop_by_area = ifelse(identical(FUN, mean) == FALSE, TRUE, FALSE),
@@ -125,7 +142,6 @@ od_aggregate <- function(flow, zones, aggzones, cols = FALSE, aggcols = FALSE,
 
 }
 
-
 #' Aggregate SpatialPolygonsDataFrame to new geometry.
 #'
 #' @section Details:
@@ -154,10 +170,10 @@ od_aggregate <- function(flow, zones, aggzones, cols = FALSE, aggcols = FALSE,
 #' data(flow)
 #' data(zones)
 #' zones@data$region <- 1
-#' zones@data[c(2,5),c('region')] <- 2
+#' zones@data[c(2, 5), c('region')] <- 2
 #' aggzones <- SpatialPolygonsDataFrame(rgeos::gUnaryUnion(
 #'  zones,
-#'  id = zones@data$region),data.frame(region=c(1,2))
+#'  id = zones@data$region), data.frame(region=c(1, 2))
 #' )
 #' zones@data$region <- NULL
 #' zones@data$exdata <- 5

R/line_match.R

@@ -34,7 +34,7 @@ line_match <- function(l1, l2, threshold = 0.01, return_sp = FALSE){
     if(is(l2, "SpatialLinesDataFrame")) {
       l2matched$match <- match_num
     } else {
-      l2matched <- SpatialLinesDataFrame(l2matched2, data = data.frame(match_num), match.ID = FALSE)
+      l2matched <- SpatialLinesDataFrame(l2matched, data = data.frame(match_num), match.ID = FALSE)
     }
     return(l2matched)
   } else {

R/quadrants.R

@@ -0,0 +1,38 @@
+#' Split a spatial object into quadrants
+#'
+#' Split a spatial object (initially tested on SpatialPolygons) into quadrants.
+#'
+#' Returns a character vector of NE, SE, SW, NW corresponding to north-east, south-east
+#' quadrants respectively. If number_out is TRUE, returns numbers from 1:4, respectively.
+#'
+#' @param sp_obj Spatial object
+#' @param number_out Should the output be numbers from 1:4 (FALSE by default)
+#'
+#' @export
+#' @examples
+#' data(zones)
+#' sp_obj = zones
+#' (quads = quadrant(sp_obj))
+#' plot(sp_obj, col = factor(quads))
+#' points(rgeos::gCentroid(sp_obj), col = "white")
+#' # edge cases (e.g. when using rasters) lead to NAs
+#' sp_obj = raster::rasterToPolygons(raster::raster(ncol = 3, nrow = 3))
+#' (quads = quadrant(sp_obj))
+#' plot(sp_obj, col = factor(quads))
+quadrant <- function(sp_obj, number_out = FALSE) {
+  cent = rgeos::gCentroid(sp_obj)
+  cents = rgeos::gCentroid(sp_obj, byid = TRUE)
+  in_quadrant = rep(NA, length(sp_obj))
+  if(number_out) {
+    in_quadrant[cents@coords[,1] > cent@coords[,1] & cents@coords[,2] > cent@coords[,2]] = 1
+    in_quadrant[cents@coords[,1] > cent@coords[,1] & cents@coords[,2] < cent@coords[,2]] = 2
+    in_quadrant[cents@coords[,1] < cent@coords[,1] & cents@coords[,2] > cent@coords[,2]] = 3
+    in_quadrant[cents@coords[,1] < cent@coords[,1] & cents@coords[,2] < cent@coords[,2]] = 4
+  } else {
+    in_quadrant[cents@coords[,1] > cent@coords[,1] & cents@coords[,2] > cent@coords[,2]] = "NE"
+    in_quadrant[cents@coords[,1] > cent@coords[,1] & cents@coords[,2] < cent@coords[,2]] = "SE"
+    in_quadrant[cents@coords[,1] < cent@coords[,1] & cents@coords[,2] > cent@coords[,2]] = "SW"
+    in_quadrant[cents@coords[,1] < cent@coords[,1] & cents@coords[,2] < cent@coords[,2]] = "NW"
+  }
+  in_quadrant
+}