diff --git a/DESCRIPTION b/DESCRIPTION index ee2de0f9..48c55d92 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: stplanr Type: Package Title: Sustainable Transport Planning -Version: 0.9.0 +Version: 1.0.0 Authors@R: c( person("Robin", "Lovelace", email = "rob00x@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5679-6536")), @@ -37,17 +37,11 @@ LazyData: yes Depends: R (>= 3.5.0) Imports: - sp (>= 1.3.1), curl (>= 3.2), dplyr (>= 0.7.6), httr (>= 1.3.1), jsonlite (>= 1.5), - stringr (>= 1.3.1), - maptools (>= 0.9.3), - raster (>= 2.6.7), - rgeos (>= 0.3.28), methods, - geosphere (>= 1.5.7), Rcpp (>= 0.12.1), nabor (>= 0.5.0), rlang (>= 0.2.2), @@ -56,10 +50,8 @@ Imports: magrittr, sfheaders, data.table, - pbapply -LinkingTo: - RcppArmadillo (>= 0.9.100.5.0), - Rcpp (>= 0.12.18) + pbapply, + od Suggests: testthat (>= 2.0.0), knitr (>= 1.20), @@ -68,10 +60,8 @@ Suggests: dodgr (>= 0.0.3), cyclestreets, leaflet, - rgdal, pct, tmap, - openxlsx (>= 4.1.0), osrm, geodist, mapsapi, @@ -79,6 +69,6 @@ Suggests: VignetteBuilder: knitr URL: https://github.com/ropensci/stplanr, https://docs.ropensci.org/stplanr/ SystemRequirements: GNU make -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.0 Roxygen: list(markdown = TRUE) Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 4af0561b..f30348ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,84 +1,41 @@ # Generated by roxygen2: do not edit by hand -S3method(SpatialLinesNetwork,Spatial) -S3method(SpatialLinesNetwork,sf) -S3method(angle_diff,Spatial) -S3method(angle_diff,sf) -S3method(calc_catchment,Spatial) -S3method(calc_catchment,sf) -S3method(calc_catchment_sum,Spatial) -S3method(calc_catchment_sum,sf) S3method(geo_bb,bbox) S3method(geo_bb,matrix) S3method(geo_bb,sf) -S3method(geo_bb_matrix,Spatial) S3method(geo_bb_matrix,matrix) S3method(geo_bb_matrix,numeric) S3method(geo_bb_matrix,sf) -S3method(geo_buffer,Spatial) S3method(geo_buffer,sf) S3method(geo_buffer,sfc) -S3method(geo_length,Spatial) S3method(geo_length,sf) -S3method(geo_projected,Spatial) S3method(geo_projected,sf) -S3method(geo_select_aeq,Spatial) S3method(geo_select_aeq,sf) S3method(geo_select_aeq,sfc) -S3method(geo_toptail,Spatial) -S3method(geo_toptail,sf) -S3method(gsection,Spatial) S3method(gsection,sf) -S3method(line2df,Spatial) S3method(line2df,sf) -S3method(line2points,Spatial) S3method(line2points,sf) S3method(line2points,sfc) S3method(line2points,sfg) -S3method(line2pointsn,Spatial) S3method(line2pointsn,sf) S3method(line2vertices,sf) -S3method(line_bearing,Spatial) -S3method(line_bearing,sf) -S3method(line_midpoint,Spatial) -S3method(line_midpoint,sf) -S3method(n_vertices,Spatial) S3method(n_vertices,sf) -S3method(nearest_cyclestreets,"NULL") -S3method(nearest_cyclestreets,Spatial) -S3method(nearest_cyclestreets,sf) -S3method(od2line,Spatial) S3method(od2line,sf) -S3method(onewaygeo,Spatial) S3method(onewaygeo,sf) -S3method(overline,Spatial) S3method(overline,sf) -S3method(points2line,Spatial) -S3method(points2line,matrix) S3method(points2line,sf) S3method(points2odf,Spatial) S3method(points2odf,sf) S3method(rnet_group,default) S3method(rnet_group,sf) -S3method(rnet_group,sfNetwork) S3method(rnet_group,sfc) -S3method(route,Spatial) S3method(route,character) S3method(route,numeric) S3method(route,sf) export("%>%") -export("weightfield<-") -export(SpatialLinesNetwork) export(angle_diff) -export(api_pat) export(bb2poly) export(bbox_scale) -export(calc_catchment) -export(calc_catchment_sum) -export(calc_moving_catchment) -export(calc_network_catchment) -export(dist_google) -export(find_network_nodes) export(geo_bb) export(geo_bb_matrix) export(geo_buffer) @@ -87,38 +44,26 @@ export(geo_length) export(geo_projected) export(geo_select_aeq) export(geo_toptail) -export(gprojected) export(gsection) export(is_linepoint) export(islines) export(line2df) export(line2points) export(line2pointsn) -export(line2route) -export(line2routeRetry) export(line2vertices) -export(lineLabels) export(line_bearing) export(line_breakup) -export(line_length) export(line_midpoint) -export(line_sample) export(line_segment) -export(line_segment_sf) export(line_via) export(mats2line) -export(n_sample_length) export(n_vertices) -export(nearest_cyclestreets) -export(nearest_google) export(od2line) -export(od2line2) export(od2odf) export(od_aggregate_from) export(od_aggregate_to) export(od_coords) export(od_coords2line) -export(od_dist) export(od_id_character) export(od_id_max_min) export(od_id_order) @@ -130,13 +75,11 @@ export(onewaygeo) export(overline) export(overline2) export(overline_intersection) -export(overline_spatial) export(points2flow) export(points2line) export(points2odf) export(quadrant) export(read_table_builder) -export(reproject) export(rnet_add_node) export(rnet_boundary_df) export(rnet_boundary_points) @@ -148,10 +91,8 @@ export(rnet_get_nodes) export(rnet_group) export(route) export(route_average_gradient) -export(route_cyclestreets) export(route_dodgr) export(route_google) -export(route_local) export(route_nearest_point) export(route_osrm) export(route_rolling_average) @@ -162,53 +103,21 @@ export(route_slope_matrix) export(route_slope_vector) export(route_split) export(route_split_id) -export(route_transportapi_public) -export(sln2points) -export(sln_add_node) -export(sln_clean_graph) -export(sum_network_links) -export(sum_network_routes) export(toptail_buff) -export(toptailgs) -export(update_line_geometry) -export(weightfield) -exportMethods(plot) -exportMethods(summary) import(curl) importFrom(Rcpp,evalCpp) importFrom(dplyr,first) importFrom(dplyr,last) importFrom(dplyr,n) -importFrom(geosphere,distHaversine) importFrom(graphics,text) importFrom(magrittr,"%>%") -importFrom(maptools,SpatialLinesMidPoints) importFrom(methods,as) importFrom(methods,is) importFrom(methods,new) importFrom(methods,slot) -importFrom(raster,crop) -importFrom(raster,extent) -importFrom(rgeos,gArea) -importFrom(rgeos,gBuffer) -importFrom(rgeos,gIntersection) -importFrom(rgeos,gIntersects) -importFrom(rgeos,gLength) -importFrom(rgeos,gSimplify) importFrom(rlang,.data) -importFrom(sp,"proj4string<-") -importFrom(sp,CRS) -importFrom(sp,Lines) -importFrom(sp,SpatialLines) -importFrom(sp,bbox) -importFrom(sp,coordinates) -importFrom(sp,plot) -importFrom(sp,proj4string) -importFrom(sp,spChFIDs) -importFrom(sp,spTransform) importFrom(stats,setNames) importFrom(utils,download.file) importFrom(utils,read.csv) importFrom(utils,tail) importFrom(utils,unzip) -useDynLib(stplanr) diff --git a/NEWS.md b/NEWS.md index 367c58dd..1f8d4f3d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,12 @@ +# stplanr 1.0.0 + +- Remove dependency on `sp`, `rgeos` and `rgdal` (#332) +- That involved removal of the following functions: + - [catchmentArea.R](https://github.com/ropensci/stplanr/blob/v0.8.5/R/catchmentArea.R) + - Some of the functionality from [linefuns.R](https://github.com/ropensci/stplanr/blob/v0.8.5/R/linefuns.R) + + - Browse the code base as of stplanr 0.8.5 here: https://github.com/ropensci/stplanr/blob/v0.8.5 + # stplanr 0.9.0 (May 2022) - Message added on loading the package announcing planned changes: support for `sp` objects and associated packages will be dropped (#332) diff --git a/R/SpatialLinesNetwork.R b/R/SpatialLinesNetwork.R deleted file mode 100644 index 4d231573..00000000 --- a/R/SpatialLinesNetwork.R +++ /dev/null @@ -1,947 +0,0 @@ -setClass("igraph") -setOldClass("sf") - -#' An S4 class representing a (typically) transport network -#' -#' This class uses a combination of a SpatialLinesDataFrame and an igraph -#' object to represent transport networks that can be used for routing and -#' other network analyses. -#' @slot sl A SpatialLinesDataFrame with the geometry and other attributes -#' for each link the in network. -#' @slot g The graph network corresponding to `sl`. -#' @slot nb A list containing vectors of the nodes connected to each node -#' in the network. -#' @slot weightfield A character vector containing the variable (column) name -#' from the SpatialLinesDataFrame to be used for weighting the network. - -setClass("SpatialLinesNetwork", representation( - sl = "SpatialLinesDataFrame", - g = "igraph", nb = "list", weightfield = "character" -), -validity = function(object) { - if (requireNamespace("igraph", quietly = TRUE)) { - stopifnot(length(object@sl) == length(igraph::E(object@g))) - stopifnot(length(object@nb) == length(igraph::V(object@g))) - } else { - message("You must install igraph for this function to work") - } -} -) - -#' An S4 class representing a (typically) transport network -#' -#' This class uses a combination of a sf layer and an igraph -#' object to represent transport networks that can be used for routing and -#' other network analyses. -#' @slot sl A sf line layer with the geometry and other attributes -#' for each link the in network. -#' @slot g The graph network corresponding to `sl`. -#' @slot nb A list containing vectors of the nodes connected to each node -#' in the network. -#' @slot weightfield A character vector containing the variable (column) name -#' from the SpatialLinesDataFrame to be used for weighting the network. -setClass("sfNetwork", representation( - sl = "sf", - g = "igraph", nb = "list", weightfield = "character" -), -validity = function(object) { - if (requireNamespace("igraph", quietly = TRUE)) { - stopifnot(nrow(object@sl) == length(igraph::E(object@g))) - stopifnot(length(object@nb) == length(igraph::V(object@g))) - } else { - message("You must install igraph for this function to work") - } -} -) - - -#' Create object of class SpatialLinesNetwork or sfNetwork -#' -#' Creates a new SpatialLinesNetwork (for SpatialLines) or sfNetwork (for sf) -#' object that can be used for routing analysis within R. -#' -#' @section Details: -#' This function is used to create a new SpatialLinesNetwork from an existing -#' SpatialLines or SpatialLinesDataFrame object. A typical use case is to -#' represent a transport network for routing and other network analysis -#' functions. This function and the corresponding SpatialLinesNetwork -#' class is an implementation of the SpatialLinesNetwork developed by -#' Edzer Pebesma and presented on \href{https://rpubs.com/edzer/6767}{RPubs}. -#' The original implementation has been rewritten to better support large -#' (i.e., detailed city-size) networks and to provide additional methods -#' useful for conducting transport research following on from the initial -#' examples provided by \href{https://rpubs.com/janoskaz/10396}{Janoska(2013)}. -#' -#' @param sl A SpatialLines or SpatialLinesDataFrame containing the lines to -#' use to create the network. -#' @param uselonglat A boolean value indicating if the data should be assumed -#' to be using WGS84 latitude/longitude coordinates. If `FALSE` or not -#' set, uses the coordinate system specified by the SpatialLines object. -#' @param tolerance A numeric value indicating the tolerance (in the units of -#' the coordinate system) to use as a tolerance with which to match nodes. -#' -#' @references -#' Pebesma, E. (2013). Spatial Networks, URL:https://rpubs.com/edzer/6767. -#' -#' Janoska, Z. (2013). Find shortest path in spatial network, -#' URL:https://rpubs.com/janoskaz/10396. -#' @family rnet -#' @export -#' @examples -#' \donttest{ -#' # dont test due to issues with s2 dependency -#' sln_sf <- SpatialLinesNetwork(route_network_sf) -#' plot(sln_sf) -#' shortpath <- sum_network_routes(sln_sf, 1, 50, sumvars = "length") -#' plot(shortpath$geometry, col = "red", lwd = 4, add = TRUE) -#' } -SpatialLinesNetwork <- function(sl, uselonglat = FALSE, tolerance = 0.000) { - UseMethod("SpatialLinesNetwork") -} -#' @export -SpatialLinesNetwork.Spatial <- function(sl, uselonglat = FALSE, tolerance = 0.000) { - sl <- new("SpatialLinesDataFrame", sl, data = data.frame(id = 1:length(sl))) - if (!all(sapply(sl@lines, length) == 1)) { - stop("SpatialLines is not simple: each Lines element should have only a single Line") - } - if (requireNamespace("igraph", quietly = TRUE)) { - # Generate graph data - gdata <- coord_matches(sl, tolerance) - s <- gdata$s - g <- igraph::graph(gdata$pts0, directed = FALSE) # edges - nodes <- s[gdata$upts + 1, ] - g$x <- nodes[, 1] # x-coordinate vertex - g$y <- nodes[, 2] # y-coordinate vertex - g$n <- as.vector(table(gdata$pts0)) # nr of edges - # 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) { - 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) { - if (requireNamespace("igraph", quietly = TRUE)) { - 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))) %>% - dplyr::ungroup() %>% - dplyr::mutate(allrownum = 1:dplyr::n()) - - gdata <- coord_matches_sf( - as.matrix( - nodecoords %>% - dplyr::select(.data$X, .data$Y, .data$allrownum) - ), - as.matrix( - nodecoords %>% - dplyr::arrange(.data$X, .data$Y) %>% - dplyr::select(.data$X, .data$Y, .data$allrownum) - ), - nrow(sl), - tolerance - ) - - s <- gdata$s - g <- igraph::graph(gdata$pts0, directed = FALSE) - nodes <- s[gdata$upts + 1, ] - g$x <- nodes[, 1] # x-coordinate vertex - g$y <- nodes[, 2] # y-coordinate vertex - g$n <- as.vector(table(gdata$pts0)) # nr of edges - - sl$length <- as.numeric(sf::st_length(sl)) - igraph::E(g)$weight <- sl$length - # check it is a single graph - is_connected <- igraph::is_connected(g) - if (!is_connected) { - warning("Graph composed of multiple subgraphs, consider cleaning it with sln_clean_graph().") - } - # largest_group = names(which.max(graph_membership_table)) - # connected_vertexes <- igraph::V(g)[which(graph_membership == largest_group)] - new("sfNetwork", sl = sl, g = g, nb = gdata$nb, weightfield = "length") - } -} - -#' Clean spatial network - return an sln with a single connected graph -#' -#' See https://github.com/ropensci/stplanr/issues/344 -#' -#' @inheritParams sln_add_node -#' -#' @return An sfNetwork object -#' @export -sln_clean_graph <- function(sln) { - if (requireNamespace("igraph", quietly = TRUE)) { - g <- sln@g - 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)) - 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), ] - SpatialLinesNetwork(temp_sl) - } -} - -#' Plot a SpatialLinesNetwork -#' -#' @param x The SpatialLinesNetwork to plot -#' @param component The component of the network to plot. Valid values are "sl" -#' for the geographic (SpatialLines) representation or "graph" for the graph -#' representation. -#' @param ... Arguments to pass to relevant plot function. -#' @export -#' @family rnet -#' @examples -#' sln <- SpatialLinesNetwork(route_network) -#' plot(sln) -#' plot(sln, component = "graph") -setMethod("plot", - signature = c(x = "SpatialLinesNetwork"), - definition = function(x, component = "sl", ...) { - if (component == "sl") { - sp::plot(x@sl, ...) - } - else if (component == "graph") { - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::plot.igraph(x@g, ...) - } - } - else { - stop("Value of component not valid") - } - } -) - -#' Plot an sfNetwork -#' -#' @param x The sfNetwork to plot -#' @param component The component of the network to plot. Valid values are "sl" -#' for the geographic (sf) representation or "graph" for the graph -#' representation. -#' @param ... Arguments to pass to relevant plot function. -#' @family rnet -#' @export -#' @examples -#' sln_sf <- SpatialLinesNetwork(route_network_sf) -#' plot(sln_sf) -setMethod("plot", - signature = c(x = "sfNetwork"), - definition = function(x, component = "sl", ...) { - if (component == "sl") { - sp::plot(x@sl$geometry, ...) - } - else if (component == "graph") { - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::plot.igraph(x@g, ...) - } - } - else { - stop("Value of component not valid") - } - } -) - -#' Get or set weight field in SpatialLinesNetwork -#' -#' Get or set value of weight field in SpatialLinesNetwork -#' @section Details: -#' These functions manipulate the value of weightfield in a -#' SpatialLinesNetwork. When changing the value of weightfield, the weights -#' of the graph network are updated with the values of the corresponding -#' variables. -#' -#' @param x SpatialLinesNetwork to use -#' @param varname The name of the variable to set/use. -#' @param value Either the name of the variable to use as the weight field or -#' a dataframe or vector containing the weights to use if `varname` is -#' passed to the replacement function. If the dataframe contains multiple -#' columns, the column with the same name as `varname` is used, -#' otherwise the first column is used. -#' @examples -#' # with sp objects -#' data(routes_fast) -#' rnet <- overline(routes_fast, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' weightfield(sln) <- "length" -#' weightfield(sln, "randomnum") <- sample(1:10, size = nrow(sln@sl), replace = TRUE) -#' data(routes_fast_sf) -#' rnet <- overline(routes_fast_sf, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' weightfield(sln) <- "length" -#' sln@sl$randomnum <- sample(1:10, size = nrow(sln@sl), replace = TRUE) -#' weightfield(sln) <- "randomnum" -#' # todo: show the difference that it makes -#' @name weightfield -NULL - -#' @rdname weightfield -#' @export -setGeneric( - "weightfield", - function(x) standardGeneric("weightfield") -) - -#' @rdname weightfield -#' @export -setGeneric( - "weightfield<-", - function(x, value) standardGeneric("weightfield<-") -) - -#' @rdname weightfield -#' @export -setGeneric( - "weightfield<-", - function(x, varname, value) standardGeneric("weightfield<-") -) - -#' @rdname weightfield -setMethod("weightfield", signature(x = "SpatialLinesNetwork"), definition = function(x) { - x@weightfield -}) - -#' @rdname weightfield -setMethod("weightfield", signature(x = "sfNetwork"), definition = function(x) { - x@weightfield -}) - -#' @rdname weightfield -# @aliases <- -setReplaceMethod("weightfield", signature(x = "SpatialLinesNetwork", value = "ANY"), definition = function(x, value) { - if (!is(x, "SpatialLinesNetwork")) { - stop("x not SpatialLinesNetwork") - } - x@weightfield <- value - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::E(x@g)$weight <- x@sl@data[, value] - } - x -}) - -#' @rdname weightfield -# @aliases <- -setReplaceMethod("weightfield", signature(x = "sfNetwork", value = "ANY"), definition = function(x, value) { - if (!is(x, "sfNetwork")) { - stop("x not sfNetwork") - } - x@weightfield <- value - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::E(x@g)$weight <- as.numeric(x@sl[[value]]) - } - x -}) - -#' @rdname weightfield -setReplaceMethod("weightfield", signature(x = "SpatialLinesNetwork", varname = "character", value = "ANY"), - definition = function(x, varname, value) { - if (is(value, "data.frame")) { - if (sum(varname %in% colnames(value)) > 0) { - value <- value[, varname] - } - else { - value <- value[, 1] - } - } - if (length(value) != nrow(x@sl@data)) { - stop("Length of value is not the same as the number of rows in the SpatialLinesDataFrame.") - } - x@sl@data[, varname] <- value - x@weightfield <- varname - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::E(x@g)$weight <- x@sl@data[, varname] - } - x - } -) - -#' @rdname weightfield -setReplaceMethod("weightfield", signature(x = "sfNetwork", varname = "character", value = "ANY"), - definition = function(x, varname, value) { - if (is(value, "data.frame")) { - if (sum(varname %in% colnames(value)) > 0) { - value <- value[, varname] - } - else { - value <- value[, 1] - } - } - if (length(value) != nrow(x@sl)) { - stop("Length of value is not the same as the number of rows in the sf.") - } - x@sl[, varname] <- value - x@weightfield <- varname - if (requireNamespace("igraph", quietly = TRUE)) { - igraph::E(x@g)$weight <- x@sl[, varname] - } - x - } -) - -#' Print a summary of a SpatialLinesNetwork -#' -#' @param object The SpatialLinesNetwork -#' @param ... Arguments to pass to relevant summary function. -#' @examples -#' data(routes_fast) -#' rnet <- overline(routes_fast, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' summary(sln) -#' @export -setMethod("summary", - signature = c(object = "SpatialLinesNetwork"), - definition = function(object, ...) { - cat(paste0("Weight attribute field: ", object@weightfield)) - summary(object@g) - sp::summary(object@sl) - } -) - -#' Print a summary of a sfNetwork -#' -#' @param object The sfNetwork -#' @param ... Arguments to pass to relevant summary function. -#' @examples -#' data(routes_fast) -#' rnet <- overline(routes_fast, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' summary(sln) -#' @export -setMethod("summary", - signature = c(object = "sfNetwork"), - definition = function(object, ...) { - cat(paste0("Weight attribute field: ", object@weightfield)) - summary(object@g) - summary(object@sl) - } -) - -#' Find graph node ID of closest node to given coordinates -#' -#' @section Details: -#' Finds the node ID of the closest point to a single coordinate pair (or a -#' set of coordinates) from a SpatialLinesNetwork. -#' -#' @param sln SpatialLinesNetwork to search. -#' @param x Either the x (longitude) coordinate value, a vector of x values, -#' a dataframe or matrix with (at least) two columns, the first for coordinate -#' for x (longitude) values and a second for y (latitude) values, or a named -#' vector of length two with values of 'lat' and 'lon'. The output of -#' geo_code() either as a single result or as multiple (using -#' rbind() ) can also be used. -#' @param y Either the y (latitude) coordinate value or a vector of y values. -#' @param maxdist The maximum distance within which to match the nodes to -#' coordinates. If the SpatialLinesNetwork is projected then distance should -#' be in the same units as the projection. If longlat, then distance is in -#' metres. Default is 1000. -#' @return An integer value with the ID of the node closest to `(x,y)` -#' with a value of `NA` the closest node is further than `maxdist` -#' from `(x,y)`. If `x` is a vector, returns a vector of Node IDs. -#' @examples -#' data(routes_fast) -#' rnet <- overline(routes_fast, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' find_network_nodes(sln, -1.516734, 53.828) -#' @family rnet -#' @export -find_network_nodes <- function(sln, x, y = NULL, maxdist = 1000) { - if (!is(sln, "SpatialLinesNetwork") & !is(sln, "sfNetwork")) { - stop("sln is not a SpatialLinesNetwork or sfNetwork.") - } - if (is(x, "numeric")) { - if (length(x) == 2 & sum(c("lat", "lon") %in% names(x)) == 2) { - y <- x["lat"] - x <- x["lon"] - } - } - if (is(x, "data.frame") == FALSE & is(x, "matrix") == FALSE) { - if (missing(y)) { - stop("x is not a data.frame and y is missing.") - } - } - else { - if (all(c("lat", "lon") %in% colnames(x))) { - y <- x[, "lat"] - x <- x[, "lon"] - } - else { - y <- x[, 2] - x <- x[, 1] - } - } - if (length(x) != length(y)) { - stop("x and y are not of equal lengths") - } - - if (is(sln, "sfNetwork")) { - distlist <- lapply(1:length(x), function(i, gxy) { - as.numeric(sf::st_distance( - x = gxy, - y = sf::st_as_sf( - data.frame(x = x[i], y = y[i]), - coords = c("x", "y"), - crs = sf::st_crs(gxy)$epsg - ) - )) - }, sf::st_as_sf(data.frame(x = sln@g$x, y = sln@g$y), - coords = c("x", "y"), - crs = sf::st_crs(sln@sl)$epsg - )) - } else { - longlat <- ifelse(sp::is.projected(sln@sl) == TRUE, FALSE, TRUE) - maxdist <- ifelse(longlat == TRUE, maxdist / 1000, maxdist) - - distlist <- lapply(1:length(x), function(i, gxy) { - sp::spDists( - x = gxy, - y = matrix(c(x[i], y[i]), ncol = 2), - longlat = longlat - ) - }, as.matrix(data.frame(x = sln@g$x, y = sln@g$y))) - } - - nodeid <- sapply( - distlist, - function(x, maxdist) { - ifelse(min(x) > maxdist, NA, which(x == min(x))[1]) - }, - maxdist - ) - - - return(nodeid) -} - -#' Summarise shortest path between nodes on network -#' -#' @section Details: -#' Find the shortest path on the network between specified nodes and returns a -#' `SpatialLinesDataFrame` (or an `sf` object with LINESTRING geometry) -#' containing the path(s) and summary statistics of each one. -#' -#' The start and end arguments must be integers representing the node index. -#' To find which node is closest to a geographic point, use `find_nearest_node()`. -#' -#' If the start and end node are identical, the function will return a -#' degenerate line with just two (identical) points. See -#' [#444](https://github.com/ropensci/stplanr/issues/444). -#' -#' @param sln The SpatialLinesNetwork or sfNetwork to use. -#' @param start Integer of node indices where route starts. -#' @param end Integer of node indices where route ends. -#' @param sumvars Character vector of variables for which to calculate -#' summary statistics. The default value is `weightfield(sln)`. -#' @param combinations Boolean value indicating if all combinations of start -#' and ends should be calculated. If TRUE then every start Node ID will be routed -#' to every end Node ID. This is faster than passing every combination to start -#' and end. Default is `FALSE`. -#' @family rnet -#' -#' @examples -#' sln <- SpatialLinesNetwork(route_network) -#' weightfield(sln) # field used to determine shortest path -#' shortpath <- sum_network_routes(sln, start = 1, end = 50, sumvars = "length") -#' plot(shortpath, col = "red", lwd = 4) -#' plot(sln, add = TRUE) -#' -#' # with sf objects -#' sln <- SpatialLinesNetwork(route_network_sf) -#' weightfield(sln) # field used to determine shortest path -#' shortpath <- sum_network_routes(sln, start = 1, end = 50, sumvars = "length") -#' plot(sf::st_geometry(shortpath), col = "red", lwd = 4) -#' plot(sln, add = TRUE) -#' -#' # find shortest path between two coordinates -#' sf::st_bbox(sln@sl) -#' start_coords <- c(-1.546, 53.826) -#' end_coords <- c(-1.519, 53.816) -#' plot(sln) -#' plot(sf::st_point(start_coords), cex = 3, add = TRUE, col = "red") -#' plot(sf::st_point(end_coords), cex = 3, add = TRUE, col = "blue") -#' nodes <- find_network_nodes(sln, rbind(start_coords, end_coords)) -#' shortpath <- sum_network_routes(sln, nodes[1], nodes[2]) -#' plot(sf::st_geometry(shortpath), col = "darkred", lwd = 3, add = TRUE) -#' -#' # degenerate path -#' sum_network_routes(sln, start = 1, end = 1) -#' @export -sum_network_routes <- function(sln, start, end, sumvars = weightfield(sln), combinations = FALSE) { - if (!is(sln, "SpatialLinesNetwork") & !is(sln, "sfNetwork")) { - stop("sln is not a SpatialLinesNetwork or sfNetwork.") - } - if (missing(start) | missing(end)) { - stop("start or end is missing") - } - if (length(start) != length(end) && combinations == FALSE) { - stop("start and end not the same length.") - } - if (!is.numeric(start) | !is.numeric(end)) { - stop("start and end must be numeric (integer) values") - } - - if (!requireNamespace("igraph", quietly = TRUE)) { - warning("igraph needs to be installed for this function to work") - return(NULL) - } - - if (combinations == FALSE) { - routesegs <- lapply(1:length(start), function(i) { - unlist(igraph::get.shortest.paths(sln@g, start[i], end[i], output = "epath")$epath) - }) - - if (is(sln, "sfNetwork")) { - # Test if routesegs returned at least one "impossible" path (i.e. epath == - # 0L) and SOME start/end nodes are identical but not all of them. In this - # case I need to differentiate the two scenarios (i.e. degenerate paths - # and regular paths). - # See https://github.com/ropensci/stplanr/issues/444 and - # https://github.com/ropensci/stplanr/pull/445 for more details. - if ( - any(vapply(routesegs, identical, logical(1), integer(0))) && - (any(start == end) && !all(start == end)) - ) { - # Find ID of identical nodes - ID_identical <- which(start == end) - - # Run the sum_network_routes() function independently for the two cases - degenerate_paths <- sum_network_routes( - sln = sln, - start = start[ID_identical], - end = end[ID_identical], - sumvars = sumvars, - combinations = FALSE - ) - regular_paths <- sum_network_routes( - sln = sln, - start = start[-ID_identical], - end = end[-ID_identical], - sumvars = sumvars, - combinations = FALSE - ) - - # Combine the results and arrange them in the same order as before - all_paths <- rbind(degenerate_paths, regular_paths) - - # I arrange the paths in the original order sorting the ID of the - # identical and (not)identical - all_paths <- all_paths %>% - dplyr::slice(order(c(which(start == end), which(start != end)))) %>% - dplyr::mutate(ID = 1:n()) - - return(all_paths) - } - - # Test if routesegs returned all "impossible" paths (i.e. epath == 0L) and - # ALL start/end nodes are identical. - # See https://github.com/ropensci/stplanr/issues/444 and - # https://github.com/ropensci/stplanr/pull/445 for more details. - if ( - all(vapply(routesegs, identical, logical(1), integer(0))) && - isTRUE(all.equal(start, end)) - ) { - # In that case we are going to return a degenerate LINESTRING object - # whose only POINT is given by the common node(s). - # I decided to use the following approach in case there are more than 1 - # start/end nodes and they are all degenerate - deg_linestrings <- lapply( - start, - function(start_end_id) { - node_coordinates <- cbind(sln@g$x[start_end_id], sln@g$y[start_end_id]) - sf::st_linestring(rbind(node_coordinates, node_coordinates)) - } - ) - - deg_linestring <- sf::st_sfc( - deg_linestrings, - crs = sf::st_crs(sln@sl), - precision = sf::st_precision(sln@sl) - ) - - return( - sf::st_sf( - dplyr::tibble( - ID = 1, - sum_length = NA, - pathfound = FALSE - ), - geometry = deg_linestring - ) %>% - dplyr::mutate(ID = 1:n()) - ) - } - - routecoords <- mapply(function(routesegs, start) { - linecoords <- sf::st_coordinates(sln@sl[routesegs, ]) - linecoords <- lapply(1:max(linecoords[, "L1"]), function(x) { - linecoords[which(linecoords[, "L1"] == x), ] - }) - join_spatiallines_coords_sf(linecoords, sln@g$x[start], sln@g$y[start]) - }, - routesegs, start, - SIMPLIFY = FALSE - ) - } else { - routecoords <- mapply(function(routesegs, start) { - join_spatiallines_coords(sln@sl[routesegs, ], sln@g$x[start], sln@g$y[start]) - }, - routesegs, start, - SIMPLIFY = FALSE - ) - } - - routecoords <- lapply(1:length(start), function(i) { - if (nrow(routecoords[[i]]) > 0) { - routecoords[[i]] - } else { - matrix(c(sln@g$x[start[i]], sln@g$y[start[i]], sln@g$x[end[i]], sln@g$y[end[i]]), byrow = TRUE, nrow = 2) - } - }) - } else { - routesegs <- unlist(lapply(1:length(start), function(i) { - lapply(igraph::get.shortest.paths(sln@g, start[i], end, output = "epath")$epath, function(x) { - as.vector(x) - }) - }), recursive = FALSE) - - if (is(sln, "sfNetwork")) { - routecoords <- mapply(function(routesegs, start) { - join_spatiallines_coords(sln@sl[routesegs, ], sln@g$x[start], sln@g$y[start]) - }, - routesegs, rep(start, each = length(end)), - SIMPLIFY = FALSE - ) - } else { - routecoords <- mapply(function(routesegs, start) { - join_spatiallines_coords(sln@sl[routesegs, ], sln@g$x[start], sln@g$y[start]) - }, - routesegs, rep(start, each = length(end)), - SIMPLIFY = FALSE - ) - } - - routecoords <- lapply(1:(length(start) * length(end)), function(i, start, end) { - if (nrow(routecoords[[i]]) > 0) { - routecoords[[i]] - } else { - matrix(c(sln@g$x[start[i]], sln@g$y[start[i]], sln@g$x[end[i]], sln@g$y[end[i]]), byrow = TRUE, nrow = 2) - } - }, rep(start, each = length(end)), rep(end, times = length(start))) - } - - if (is(sln, "sfNetwork")) { - routedata <- setNames(data.frame(cbind(1:length(routesegs), do.call(rbind, lapply(routesegs, function(routesegs, sumvars) { - matrix( - sapply(1:length(sumvars), - FUN = function(j) { - if (length(routesegs) == 0) { - NA - } else { - sum(sln@sl[routesegs, ][[sumvars[j]]]) - } - } - ), - nrow = 1 - ) - }, sumvars)))), c("ID", paste0("sum_", sumvars))) - routedata$pathfound <- ifelse(unlist(lapply(routesegs, function(x) { - length(x) - })) == 0, FALSE, TRUE) - - sldf <- dplyr::bind_rows( - lapply( - 1:length(routecoords), - function(x) { - as.data.frame(routecoords[[x]]) %>% - dplyr::mutate(linenum = x) - } - ) - ) %>% - sf::st_as_sf( - coords = utils::head(colnames(.), -2), - crs = sf::st_crs(sln@sl)$epsg - ) %>% - dplyr::group_by(.data$linenum) %>% - dplyr::summarise(do_union = FALSE) %>% - sf::st_cast("LINESTRING") %>% - dplyr::bind_cols(routedata) %>% - dplyr::select(-.data$linenum) - } else { - routedata <- setNames(data.frame(cbind(1:length(routesegs), do.call(rbind, lapply(routesegs, function(routesegs, sumvars) { - matrix( - sapply(1:length(sumvars), - FUN = function(j) { - if (length(routesegs) == 0) { - NA - } else { - sum(sln@sl[routesegs, ]@data[sumvars[j]]) - } - } - ), - nrow = 1 - ) - }, sumvars)))), c("ID", paste0("sum_", sumvars))) - routedata$pathfound <- ifelse(unlist(lapply(routesegs, function(x) { - length(x) - })) == 0, FALSE, TRUE) - routelines <- mapply(function(x, i) { - sp::Lines(sp::Line(x), ID = i) - }, routecoords, 1:length(routecoords)) - - row.names(routedata) <- 1:nrow(routedata) - sldf <- sp::SpatialLinesDataFrame( - sp::SpatialLines(routelines, sln@sl@proj4string), - routedata - ) - } - - return(sldf) -} - -#' Generate spatial points representing nodes on a SpatialLinesNetwork -#' or sfNetwork. -#' -#' @inheritParams sum_network_routes -#' @family rnet -#' @export -#' @examples -#' data(routes_fast) -#' rnet <- overline(routes_fast, attrib = "length") -#' sln <- SpatialLinesNetwork(rnet) -#' (sln_nodes <- sln2points(sln)) -#' plot(sln) -#' plot(sln_nodes, add = TRUE) -sln2points <- function(sln) { - coords <- cbind(sln@g$x, sln@g$y) - if (is(sln, "sfNetwork")) { - sf::st_as_sf( - as.data.frame(coords), - coords = c("V1", "V2"), - crs = sf::st_crs(sln@sl)$epsg - ) - } else { - sp::SpatialPoints(coords, - proj4string = sln@sl@proj4string - ) - } -} - -#' Summarise links from shortest paths data -#' -#' @section Details: -#' Find the shortest path on the network between specified nodes and returns -#' a SpatialLinesDataFrame or sf containing the path(s) and summary statistics -#' of each one. -#' -#' @param sln The SpatialLinesNetwork or sfNetwork to use. -#' @param routedata A dataframe where the first column contains the Node ID(s) -#' of the start of the routes, the second column indicates the Node ID(s) of -#' the end of the routes, and any additional columns are summarised by link. -#' If there are no additional colums, then overlapping routes are counted. -#' @family rnet -#' @examples -#' 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) -#' ) -#' weightfield(sln_sf) # field used to determine shortest path -#' library(sf) -#' shortpath_sf <- sum_network_links(sln_sf, nodes_df) -#' plot(shortpath_sf["count"], lwd = shortpath_sf$count, add = TRUE) -#' @export -sum_network_links <- function(sln, routedata) { - if (!is(sln, "SpatialLinesNetwork") & !is(sln, "sfNetwork")) { - stop("sln is not a SpatialLinesNetwork or sfNetwork.") - } - if (missing(routedata)) { - stop("routedata is missing") - } - if (is(routedata, "data.frame") == FALSE) { - stop("routedata is not a dataframe") - } - if (ncol(routedata) < 2) { - stop("routedata has fewer than 2 columns.") - } - if (is(sln, "SpatialLinesNetwork")) { - stop("SpatialLinesNetwork not supported. Use newer sfNetwork class instead") - } - if (ncol(routedata) < 3) { - routedata$count <- 1 - } - if (!requireNamespace("igraph", quietly = TRUE)) { - warning("igraph needs to be installed for this function to work") - return(NULL) - } - - if (nrow(routedata[which(is.na(routedata[, 1]) == TRUE | is.na(routedata[, 2]) == TRUE), ]) > 0) { - warning("Some node IDs are missing, removing missing rows") - routedata <- routedata[which(is.na(routedata[, 1]) == FALSE & is.na(routedata[, 2]) == FALSE), ] - } - - routeends <- lapply(unique(routedata[, 1]), function(x, routedata) { - unique(routedata[which(routedata[, 1] == x), 2]) - }, routedata) - routesegs <- lapply(1:length(unique(routedata[, 1])), function(x, start, routeends) { - igraph::get.shortest.paths(sln@g, start[x], routeends[[x]], output = "epath")$epath - }, unique(routedata[, 1]), routeends) - routesegs <- lapply(routesegs, function(x) { - lapply(x, function(x) { - as.vector(x) - }) - }) - - routesegs <- dplyr::bind_rows( - unlist( - lapply( - 1:length(unique(routedata[, 1])), - function(x, start, routeends, routesegs) { - lapply( - 1:length(routeends[[x]]), - function(y, start, routeends, routesegs) { - if (length(routesegs[[y]]) == 0) {} else { - data.frame( - "stplanr_start" = start, - "stplanr_end" = routeends[y], - "stplanr_linkid" = routesegs[[y]] - ) - } - }, start[x], routeends[[x]], routesegs[[x]] - ) - }, unique(routedata[, 1]), routeends, routesegs - ), - recursive = FALSE - ) - ) %>% - dplyr::inner_join( - routedata, - by = c("stplanr_start" = colnames(routedata)[1], "stplanr_end" = colnames(routedata)[2]) - ) %>% - dplyr::select(-stplanr_start, -stplanr_end) %>% - dplyr::group_by(stplanr_linkid) %>% - dplyr::summarise_all(.funs = c("sum")) %>% - dplyr::ungroup() - - if (is(sln, "sfNetwork")) { - sln@sl$stplanr_linkid <- 1:nrow(sln@sl) - } else { - sln@sl@data$stplanr_linkid <- 1:nrow(sln@sl@data) - } - routelinks <- sln@sl[routesegs$stplanr_linkid, ] - routelinks <- merge(routelinks, routesegs, by = "stplanr_linkid") - routelinks$stplanr_linkid <- NULL - - return(routelinks) -} diff --git a/R/as_sf_fun.R b/R/as_sf_fun.R deleted file mode 100644 index 70ae434f..00000000 --- a/R/as_sf_fun.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Convert functions support sf/sp -#' -#' @param input Input object - an sf or sp object -#' @param FUN A function that works on sp/sf data -#' @param ... Arguments passed to `FUN` -#' @aliases as_sp_fun -as_sf_fun <- function(input, FUN, ...) { - if (is(object = input, class2 = "sf")) { - input <- as(object = input, Class = "Spatial") - } - res <- FUN(input) - if (is(object = res, class2 = "Spatial")) { - res <- sf::st_as_sf(res) - } - return(res) -} - -as_sp_fun <- function(input, FUN, ...) { - if (is(object = input, class2 = "Spatial")) { - input <- sf::st_as_sf(input) - } - res <- FUN(input) - if (is(object = res, class2 = "sf")) { - res <- as(res, "Spatial") - } - return(res) -} diff --git a/R/catchmentArea.R b/R/catchmentArea.R deleted file mode 100644 index a5ada194..00000000 --- a/R/catchmentArea.R +++ /dev/null @@ -1,759 +0,0 @@ -#' Calculate catchment area and associated summary statistics. -#' -#' @section Details: -#' Calculates the catchment area of a facility (e.g., cycle path) using -#' straight-line distance as well as summary statistics from variables -#' available in a SpatialPolygonsDataFrame with census tracts or other -#' zones. Assumes that the frequency of the variable is evenly distributed -#' throughout the zone. Returns a SpatialPolygonsDataFrame. -#' -#' @param polygonlayer A SpatialPolygonsDataFrame containing zones from which -#' the summary statistics for the catchment variable will be calculated. -#' Smaller polygons will increase the accuracy of the results. -#' @param targetlayer A SpatialPolygonsDataFrame, SpatialLinesDataFrame, -#' SpatialPointsDataFrame, SpatialPolygons, SpatialLines or SpatialPoints -#' object containing the specifications of the facility for which the -#' catchment area is being calculated. If the object contains more than one -#' facility (e.g., multiple cycle paths) the aggregate catchment area will be -#' calculated. -#' @param calccols A vector of column names containing the variables in the -#' polygonlayer to be used in the calculation of the summary statistics for -#' the catchment area. If dissolve = FALSE, all other variables in the -#' original SpatialPolygonsDataFrame for zones that fall partly or entirely -#' within the catchment area will be included in the returned -#' SpatialPolygonsDataFrame but will not be adjusted for the proportion within -#' the catchment area. -#' @param distance Defines the size of the catchment area as the distance -#' around the targetlayer in the units of the projection -#' (default = 500 metres) -#' @param projection The proj4string used to define the projection to be used -#' for calculating the catchment areas or a character string 'austalbers' to -#' use the Australian Albers Equal Area projection. Ignored if the polygonlayer -#' is projected in which case the targetlayer will be converted to the -#' projection used by the polygonlayer. In all cases the resulting object will -#' be reprojected to the original coordinate system and projection of the -#' polygon layer. Default is an Albers Equal Area projection but for more -#' reliable results should use a local projection (e.g., Australian Albers -#' Equal Area project). -#' @param retainAreaProportion Boolean value. If TRUE retains a variable in -#' the resulting SpatialPolygonsDataFrame containing the proportion of the -#' original area within the catchment area (Default = FALSE). -#' @param dissolve Boolean value. If TRUE collapses the underlying zones -#' within the catchment area into a single region with statistics for the -#' whole catchment area. -#' @param quadsegs Number of line segments to use to approximate a quarter -#' circle. Parameter passed to buffer functions, default is 5 for sp and -#' 30 for sf. -#' @family rnet -#' @export -#' @examples -#' \dontrun{ -#' data_dir <- system.file("extdata", package = "stplanr") -#' unzip(file.path(data_dir, "smallsa1.zip")) -#' unzip(file.path(data_dir, "testcycleway.zip")) -#' sa1income <- as(sf::read_sf("smallsa1.shp"), "Spatial") -#' testcycleway <- as(sf::read_sf("testcycleway.shp"), "Spatial") -#' cway_catch <- calc_catchment( -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' distance = 800, -#' projection = "austalbers", -#' dissolve = TRUE -#' ) -#' plot(sa1income) -#' plot(cway_catch, add = TRUE, col = "green") -#' plot(testcycleway, col = "red", add = TRUE) -#' sa1income <- sf::read_sf("smallsa1.shp") -#' testcycleway <- sf::read_sf("testcycleway.shp") -#' f <- list.files(".", "testcycleway|smallsa1") -#' file.remove(f) -#' cway_catch <- calc_catchment( -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' distance = 800, -#' projection = "austalbers", -#' dissolve = TRUE -#' ) -#' plot(sa1income$geometry) -#' plot(testcycleway$geometry, col = "red", add = TRUE) -#' plot(cway_catch["Total"], add = TRUE) -#' } -calc_catchment <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667 ", - "+lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80", - " +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - dissolve = FALSE, - quadsegs = NULL) { - .Deprecated(msg = "Try using functionality in the sfnetworks package") - UseMethod(generic = "calc_catchment") -} -#' @export -calc_catchment.Spatial <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667 ", - "+lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80", - " +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - dissolve = FALSE, - quadsegs = 5) { - if (projection != "skipproj") { - confproj <- checkprojs.Spatial(polygonlayer = polygonlayer, targetlayer = targetlayer, projection = projection) - polygonlayer <- confproj[["polygonlayer"]] - targetlayer <- confproj[["targetlayer"]] - origprojpolygon <- confproj[["origprojpolygon"]] - } - - polygonlayer@data$calc_catchment_fullArea <- - rgeos::gArea(polygonlayer, byid = TRUE) - - targetbuffer <- rgeos::gBuffer(targetlayer, width = distance, quadsegs = quadsegs, byid = TRUE) - polygonlayer@data$calc_catchment_charid <- paste(row.names(polygonlayer@data), targetbuffer@polygons[[1]]@ID) - polygonlayer@data$calc_catchment_charid2 <- as.character(row.names(polygonlayer@data)) - targetlayer@data$calc_catchment_charid <- as.character(row.names(targetlayer@data)) - - targetintersect <- - 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 - }) - ) - ) - - targetintersect@data$calc_catchment_sectArea <- rgeos::gArea(targetintersect, byid = TRUE) - targetintersect@data <- cbind( - targetintersect@data, - setNames( - as.data.frame( - t(as.data.frame( - strsplit( - as.character(targetintersect@data$calc_catchment_charid), - split = " " - ) - )) - ), - c("calc_catchment_polygonid", "calc_catchment_targetid") - ) - ) - targetintersect@data$calc_catchment_polygonid <- as.character(targetintersect@data$calc_catchment_polygonid) - targetintersect@data$calc_catchment_targetid <- as.character(targetintersect@data$calc_catchment_targetid) - targetintersect@data <- merge(targetintersect@data, polygonlayer@data, - by.x = "calc_catchment_polygonid", - by.y = "calc_catchment_charid2", all.x = TRUE - ) - targetintersect@data <- merge(targetintersect@data, targetlayer@data, - by.x = "calc_catchment_targetid", - by.y = "calc_catchment_charid", all.x = TRUE - ) - targetintersect@data$calc_catchment_propArea <- targetintersect@data$calc_catchment_sectArea / targetintersect@data$calc_catchment_fullArea - targetintersect@data[, calccols] <- targetintersect@data[, calccols] * targetintersect@data$calc_catchment_propArea - - - if (dissolve == TRUE) { - 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) { - as.character(targetintersect@data[[x]]) - }) - targetintersectd_data <- as.data.frame( - targetintersect@data %>% - dplyr::group_by_at(c("calc_catchment_targetid", targetcols)) %>% - dplyr::summarise_at( - dplyr::vars( - c(calccols, "calc_catchment_fullArea", "calc_catchment_sectArea") - ), - dplyr::funs("sum", .args = list("na.rm" = TRUE)) - ) - ) - rownames(targetintersectd_data) <- as.character(unlist(lapply(targetintersectd@polygons, function(x) { - x@ID - }))) - targetintersectd <- sp::SpatialPolygonsDataFrame(targetintersectd, - data = targetintersectd_data - ) - rm(targetintersectd_data) - targetintersectd@data$calc_catchment_propArea <- targetintersectd@data$calc_catchment_sectArea / targetintersectd@data$calc_catchment_fullArea - - targetintersectd@data$calc_catchment_charid <- "charid" - targetintersect <- targetintersectd - rm(targetintersectd) - } - - - targetintersect@data$calc_catchment_fullArea <- NULL - targetintersect@data$calc_catchment_sectArea <- NULL - targetintersect@data$calc_catchment_charid <- NULL - targetintersect@data$calc_catchment_polygonid <- NULL - targetintersect@data$calc_catchment_targetid <- NULL - targetintersect@data$calc_catchment_charid.x <- NULL - targetintersect@data$calc_catchment_charid.y <- NULL - - if (retainAreaProportion == FALSE) { - targetintersect@data$calc_catchment_propArea <- NULL - } - - row.names(targetintersect@data) <- 1:nrow(targetintersect@data) - - if (projection != "skipproj") { - targetintersect <- - sp::spTransform(targetintersect, sp::CRS(origprojpolygon)) - } - return(targetintersect) -} -#' @export -calc_catchment.sf <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667 ", - "+lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80", - " +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - dissolve = FALSE, - quadsegs = 30) { - if (projection != "skipproj") { - confproj <- checkprojs.sf(polygonlayer = polygonlayer, targetlayer = targetlayer, projection = projection) - polygonlayer <- confproj[["polygonlayer"]] - targetlayer <- confproj[["targetlayer"]] - origprojpolygon <- confproj[["origprojpolygon"]] - } - - polygonlayer$calc_catchment_fullArea <- as.numeric(sf::st_area(polygonlayer)) - - targetbuffer <- sf::st_buffer(targetlayer, distance, nQuadSegs = quadsegs) - polygonlayer$calc_catchment_charid <- paste(row.names(polygonlayer), row.names(targetbuffer)) - - targetintersect <- sf::st_intersection(polygonlayer, targetbuffer) - - - targetintersect$calc_catchment_sectArea <- as.numeric(sf::st_area(targetintersect)) - targetintersect$calc_catchment_propArea <- targetintersect$calc_catchment_sectArea / targetintersect$calc_catchment_fullArea - - targetintersect <- dplyr::mutate_at(targetintersect, dplyr::vars(calccols), dplyr::funs(.data$. * .data$calc_catchment_propArea)) - - if (dissolve == TRUE) { - targetcols <- colnames(targetlayer) - targetcols <- targetcols[which(targetcols != "geometry")] - targetintersect <- targetintersect %>% - dplyr::group_by_at(targetcols) %>% - dplyr::summarise_at(dplyr::vars(calccols), .funs = "sum", na.rm = TRUE) - } - - - targetintersect$calc_catchment_fullArea <- NULL - targetintersect$calc_catchment_sectArea <- NULL - targetintersect$calc_catchment_charid <- NULL - - if (retainAreaProportion == FALSE) { - targetintersect$calc_catchment_propArea <- NULL - } - - row.names(targetintersect) <- 1:nrow(targetintersect) - - if (projection != "skipproj") { - targetintersect <- sf::st_transform(targetintersect, origprojpolygon) - } - return(targetintersect) -} - -#' Calculate summary statistics for catchment area. -#' -#' @section Details: -#' Calculates the summary statistics for a catchment area of a facility -#' (e.g., cycle path) using straight-line distance from variables -#' available in a SpatialPolygonsDataFrame with census tracts or other -#' zones. Assumes that the frequency of the variable is evenly distributed -#' throughout the zone. Returns either a single value if calccols is of -#' length = 1, or a named vector otherwise. -#' -#' @param polygonlayer A SpatialPolygonsDataFrame containing zones from which -#' the summary statistics for the catchment variable will be calculated. -#' Smaller polygons will increase the accuracy of the results. -#' @param targetlayer A SpatialPolygonsDataFrame, SpatialLinesDataFrame, -#' SpatialPointsDataFrame, SpatialPolygons, SpatialLines or SpatialPoints -#' object containing the specifications of the facility for which the -#' catchment area is being calculated. If the object contains more than one -#' facility (e.g., multiple cycle paths) the aggregate catchment area will be -#' calculated. -#' @param calccols A vector of column names containing the variables in the -#' polygonlayer to be used in the calculation of the summary statistics for -#' the catchment area. -#' @param distance Defines the size of the catchment area as the distance -#' around the targetlayer in the units of the projection -#' (default = 500 metres) -#' @param projection The proj4string used to define the projection to be used -#' for calculating the catchment areas or a character string 'austalbers' to -#' use the Australian Albers Equal Area projection. Ignored if the polygonlayer -#' is projected in which case the targetlayer will be converted to the -#' projection used by the polygonlayer. In all cases the resulting object will -#' be reprojected to the original coordinate system and projection of the -#' polygon layer. Default is an Albers Equal Area projection but for more -#' reliable results should use a local projection (e.g., Australian Albers -#' Equal Area project). -#' @param retainAreaProportion Boolean value. If TRUE retains a variable in -#' the resulting SpatialPolygonsDataFrame containing the proportion of the -#' original area within the catchment area (Default = FALSE). -#' @param quadsegs Number of line segments to use to approximate a quarter -#' circle. Parameter passed to buffer functions, default is 5 for sp and -#' 30 for sf. -#' @family rnet -#' @export -#' @examples -#' \dontrun{ -#' data_dir <- system.file("extdata", package = "stplanr") -#' unzip(file.path(data_dir, "smallsa1.zip")) -#' unzip(file.path(data_dir, "testcycleway.zip")) -#' sa1income <- rgdal::readOGR(".", "smallsa1") -#' testcycleway <- rgdal::readOGR(".", "testcycleway") -#' calc_catchment_sum( -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' distance = 800, -#' projection = "austalbers" -#' ) -#' -#' calc_catchment_sum( -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' distance = 800, -#' projection = "austalbers" -#' ) -#' } -calc_catchment_sum <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - quadsegs = NA) { - UseMethod(generic = "calc_catchment_sum") -} -#' @export -calc_catchment_sum.Spatial <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - quadsegs = 5) { - if (length(calccols) == 1) { - return(sum(calc_catchment( - polygonlayer = polygonlayer, - targetlayer = targetlayer, - calccols = calccols, - distance = distance, - projection = projection, - retainAreaProportion = retainAreaProportion, - dissolve = FALSE, - quadsegs = quadsegs - )@data[, calccols], na.rm = TRUE)) - } else { - return(colSums(calc_catchment( - polygonlayer = polygonlayer, - targetlayer = targetlayer, - calccols = calccols, - distance = distance, - projection = projection, - retainAreaProportion = retainAreaProportion, - dissolve = FALSE, - quadsegs = quadsegs - )@data[, calccols], na.rm = TRUE)) - } -} - -#' @export -calc_catchment_sum.sf <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - quadsegs = 30) { - if (length(calccols) == 1) { - return(sum(as.data.frame(calc_catchment( - polygonlayer = polygonlayer, - targetlayer = targetlayer, - calccols = calccols, - distance = distance, - projection = projection, - retainAreaProportion = retainAreaProportion, - dissolve = FALSE, - quadsegs = quadsegs - ))[, calccols], na.rm = TRUE)) - } else { - return(colSums(as.data.frame(calc_catchment( - polygonlayer = polygonlayer, - targetlayer = targetlayer, - calccols = calccols, - distance = distance, - projection = projection, - retainAreaProportion = retainAreaProportion, - dissolve = FALSE, - quadsegs = quadsegs - ))[, calccols], na.rm = TRUE)) - } -} - -#' Calculate summary statistics for all features independently. -#' -#' @section Details: -#' Calculates the summary statistics for a catchment area of multiple -#' facilities or zones using straight-line distance from variables -#' available in a SpatialPolygonsDataFrame with census tracts or other -#' zones. Assumes that the frequency of the variable is evenly distributed -#' throughout the zone. Returns the original source dataframe with additional -#' columns with summary variables. -#' -#' @param polygonlayer A SpatialPolygonsDataFrame containing zones from which -#' the summary statistics for the catchment variable will be calculated. -#' Smaller polygons will increase the accuracy of the results. -#' @param targetlayer A SpatialPolygonsDataFrame, SpatialLinesDataFrame or -#' SpatialPointsDataFrame object containing the specifications of the -#' facilities and zones for which the catchment areas are being calculated. -#' @param calccols A vector of column names containing the variables in the -#' polygonlayer to be used in the calculation of the summary statistics for -#' the catchment areas. -#' @param distance Defines the size of the catchment areas as the distance -#' around the targetlayer in the units of the projection -#' (default = 500 metres) -#' @param projection The proj4string used to define the projection to be used -#' for calculating the catchment areas or a character string 'austalbers' to -#' use the Australian Albers Equal Area projection. Ignored if the polygonlayer -#' is projected in which case the targetlayer will be converted to the -#' projection used by the polygonlayer. In all cases the resulting object will -#' be reprojected to the original coordinate system and projection of the -#' polygon layer. Default is an Albers Equal Area projection but for more -#' reliable results should use a local projection (e.g., Australian Albers -#' Equal Area project). -#' @param retainAreaProportion Boolean value. If TRUE retains a variable in -#' the resulting SpatialPolygonsDataFrame containing the proportion of the -#' original area within the catchment area (Default = FALSE). -#' @family rnet -#' @export -#' @examples -#' \dontrun{ -#' data_dir <- system.file("extdata", package = "stplanr") -#' unzip(file.path(data_dir, "smallsa1.zip")) -#' unzip(file.path(data_dir, "testcycleway.zip")) -#' sa1income <- readOGR(".", "smallsa1") -#' testcycleway <- readOGR(".", "testcycleway") -#' calc_moving_catchment( -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' distance = 800, -#' projection = "austalbers" -#' ) -#' } -calc_moving_catchment <- function( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = "worldalbers", - retainAreaProportion = FALSE) { - newcalccols <- paste0("sum_", calccols) - - confproj <- checkprojs.Spatial(polygonlayer = polygonlayer, targetlayer = targetlayer, projection = projection) - - polygonlayer <- confproj[["polygonlayer"]] - targetlayer <- confproj[["targetlayer"]] - origprojpolygon <- confproj[["origprojpolygon"]] - - targetlayer@data[, newcalccols] <- NA - - p <- dplyr::progress_estimated(nrow(targetlayer), min_time = 10) - count <- 1 - while (count <= nrow(targetlayer)) { - targetlayer[count, newcalccols] <- setNames( - calc_catchment_sum( - polygonlayer = polygonlayer, - targetlayer = targetlayer[count, ], - calccols = calccols, - distance = distance, - projection = "skipproj", - retainAreaProportion = retainAreaProportion - ), - newcalccols - ) - p$tick()$print() - count <- count + 1 - } - - targetlayer <- - sp::spTransform(targetlayer, sp::CRS(origprojpolygon)) - - return(targetlayer) -} - -#' Calculate catchment area and associated summary statistics using network. -#' -#' @section Details: -#' Calculates the catchment area of a facility (e.g., cycle path) using -#' network distance (or other weight variable) as well as summary statistics -#' from variables available in a SpatialPolygonsDataFrame with census tracts -#' or other zones. Assumes that the frequency of the variable is evenly -#' distributed throughout the zone. Returns a SpatialPolygonsDataFrame. -#' -#' @param sln The SpatialLinesNetwork to use. -#' @param polygonlayer A SpatialPolygonsDataFrame containing zones from which -#' the summary statistics for the catchment variable will be calculated. -#' Smaller polygons will increase the accuracy of the results. -#' @param targetlayer A SpatialPolygonsDataFrame, SpatialLinesDataFrame or -#' SpatialPointsDataFrame object containing the specifications of the -#' facilities and zones for which the catchment areas are being calculated. -#' @param calccols A vector of column names containing the variables in the -#' polygonlayer to be used in the calculation of the summary statistics for -#' the catchment area. If dissolve = FALSE, all other variables in the -#' original SpatialPolygonsDataFrame for zones that fall partly or entirely -#' within the catchment area will be included in the returned -#' SpatialPolygonsDataFrame but will not be adjusted for the proportion within -#' the catchment area. -#' @param maximpedance The maximum value of the network's weight attribute in -#' the units of the weight (default = 1000). -#' @param distance Defines the additional catchment area around the network -#' in the units of the projection. -#' (default = 100 metres) -#' @param projection The proj4string used to define the projection to be used -#' for calculating the catchment areas or a character string 'austalbers' to -#' use the Australian Albers Equal Area projection. Ignored if the polygonlayer -#' is projected in which case the targetlayer will be converted to the -#' projection used by the polygonlayer. In all cases the resulting object will -#' be reprojected to the original coordinate system and projection of the -#' polygon layer. Default is an Albers Equal Area projection but for more -#' reliable results should use a local projection (e.g., Australian Albers -#' Equal Area project). -#' @param retainAreaProportion Boolean value. If TRUE retains a variable in -#' the resulting SpatialPolygonsDataFrame containing the proportion of the -#' original area within the catchment area (Default = FALSE). -#' @param dissolve Boolean value. If TRUE collapses the underlying zones -#' within the catchment area into a single region with statistics for the -#' whole catchment area. -#' @family rnet -#' @export -#' @examples -#' \dontrun{ -#' data_dir <- system.file("extdata", package = "stplanr") -#' unzip(file.path(data_dir, "smallsa1.zip"), exdir = tempdir()) -#' unzip(file.path(data_dir, "testcycleway.zip"), exdir = tempdir()) -#' unzip(file.path(data_dir, "sydroads.zip"), exdir = tempdir()) -#' sa1income <- readOGR(tempdir(), "smallsa1") -#' testcycleway <- readOGR(tempdir(), "testcycleway") -#' sydroads <- readOGR(tempdir(), "roads") -#' sydnetwork <- SpatialLinesNetwork(sydroads) -#' calc_network_catchment( -#' sln = sydnetwork, -#' polygonlayer = sa1income, -#' targetlayer = testcycleway, -#' calccols = c("Total"), -#' maximpedance = 800, -#' distance = 200, -#' projection = "austalbers", -#' dissolve = TRUE -#' ) -#' } -calc_network_catchment <- function(sln, - polygonlayer, - targetlayer, - calccols, - maximpedance = 1000, - distance = 100, - projection = paste0( - "+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ), - retainAreaProportion = FALSE, - dissolve = FALSE) { - if (!requireNamespace("igraph", quietly = TRUE)) { - warning("igraph needs to be installed for this function to work") - return(NULL) - } - longlat <- ifelse(sp::is.projected(sln@sl) == TRUE, FALSE, TRUE) - maximpedance <- - ifelse(longlat == TRUE, maximpedance / 1000, maximpedance) - - if (is(targetlayer, "SpatialLines") | - is(targetlayer, "SpatialLinesDataFrame") | - is(targetlayer, "SpatialPolygons") | - is(targetlayer, "SpatialPolygonsDataFrame") | - is(targetlayer, "SpatialPoints") | - is(targetlayer, "SpatialPointsDataFrame")) { - if (sln@sl@proj4string@projargs != targetlayer@proj4string@projargs) { - newtargetlayer <- sp::spTransform(targetlayer, sln@sl@proj4string) - } - else { - newtargetlayer <- targetlayer - } - # targetnodes <- unique(find_network_nodes(sln, as.data.frame(coordinates(newtargetlayer)))) - if (is(targetlayer, "SpatialPoints") | - is(targetlayer, "SpatialPointsDataFrame")) { - targetnodes <- unique(find_network_nodes(sln, as.data.frame(unique( - coordinates(newtargetlayer) - )))) - } else { - targetnodes <- unique(find_network_nodes(sln, as.data.frame(unique( - do.call(rbind, unlist( - coordinates(newtargetlayer), - recursive = FALSE - )) - )))) - } - spaths <- lapply(targetnodes, function(x) { - igraph::get.shortest.paths(sln@g, x, - # which(sp::spDists( - # x = as.matrix(data.frame(x=sln@g$x, y=sln@g$y)), - # y = matrix(cbind(sln@g$x,sln@g$y)[x,],ncol=2), - # longlat = longlat - # ) <= maximpedance), - output = "epath" - ) - }) - - spaths <- - unlist(lapply(spaths, function(x) { - x$epath - }), recursive = FALSE) - } - - else { - spaths <- igraph::get.shortest.paths(sln@g, - targetlayer, - which( - sp::spDists( - x = as.matrix(data.frame(x = sln@g$x, y = sln@g$y)), - y = matrix(cbind(sln@g$x, sln@g$y)[targetlayer, ], - ncol = - 2 - ), - longlat = longlat - ) <= maximpedance - ), - output = "epath" - ) - spaths <- spaths$epath - } - - uniquesects <- unique(unlist(lapply( - spaths, - function(x) { - if (length(x) > 0) { - if (sum(sln@sl@data[x, sln@weightfield], na.rm = TRUE) <= maximpedance) { - x - } - } - } - ))) - - calc_catchment( - polygonlayer = polygonlayer, - targetlayer = sln@sl[uniquesects, ], - calccols = calccols, - distance = distance, - projection = projection, - retainAreaProportion = retainAreaProportion, - dissolve = dissolve - ) -} - -checkprojs.Spatial <- function(polygonlayer, targetlayer, projection) { - # Define Named vector of known projection strings - knownprojs <- c( - "austalbers" = "+proj=aea +lat_1=-18 +lat_2=-36 +lat_0=0 +lon_0=132 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs", - "worldalbers" = "+proj=aea +lat_1=90 +lat_2=-18.416667 +lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ) - - if (sum(is.na(knownprojs[projection])) == 0) { - projection <- knownprojs[projection] - } - - polyproj <- sp::is.projected(polygonlayer) - lineproj <- sp::is.projected(targetlayer) - - origprojpolygon <- sp::proj4string(polygonlayer) - - if (polyproj == FALSE & lineproj == FALSE) { - polygonlayer <- sp::spTransform(polygonlayer, sp::CRS(projection)) - targetlayer <- sp::spTransform(targetlayer, sp::CRS(projection)) - } else if (polyproj == TRUE & lineproj == FALSE) { - projection <- sp::proj4string(polygonlayer) - targetlayer <- sp::spTransform(targetlayer, sp::CRS(projection)) - } else if (polyproj == TRUE & lineproj == TRUE) { - if (sp::proj4string(polygonlayer) != sp::proj4string(targetlayer)) { - projection <- sp::proj4string(polygonlayer) - targetlayer <- - sp::spTransform(targetlayer, sp::CRS(projection)) - } - } - return(list("polygonlayer" = polygonlayer, "targetlayer" = targetlayer, "origprojpolygon" = origprojpolygon)) -} - -checkprojs.sf <- function(polygonlayer, targetlayer, projection) { - # Define Named vector of known projection strings - knownprojs <- c( - "austalbers" = "+proj=aea +lat_1=-18 +lat_2=-36 +lat_0=0 +lon_0=132 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs", - "worldalbers" = "+proj=aea +lat_1=90 +lat_2=-18.416667 +lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" - ) - - if (sum(is.na(knownprojs[projection])) == 0) { - projection <- knownprojs[projection] - } - - polyproj <- !sf::st_is_longlat(polygonlayer) - lineproj <- !sf::st_is_longlat(targetlayer) - - origprojpolygon <- sf::st_crs(polygonlayer) - - if (polyproj == FALSE & lineproj == FALSE) { - polygonlayer <- sf::st_transform(polygonlayer, projection) - targetlayer <- sf::st_transform(targetlayer, projection) - } else if (polyproj == TRUE & lineproj == FALSE) { - projection <- sf::st_crs(polygonlayer)$proj4string - targetlayer <- sf::st_transform(targetlayer, projection) - } else if (polyproj == TRUE & lineproj == TRUE) { - if (sf::st_crs(polygonlayer)$proj4string != sf::st_crs(targetlayer)$proj4string) { - projection <- sf::st_crs(polygonlayer)$proj4string - targetlayer <- sf::st_transform(targetlayer, projection) - } - } - return(list("polygonlayer" = polygonlayer, "targetlayer" = targetlayer, "origprojpolygon" = origprojpolygon)) -} diff --git a/R/crs-funs.R b/R/crs-funs.R deleted file mode 100644 index 2724350e..00000000 --- a/R/crs-funs.R +++ /dev/null @@ -1,25 +0,0 @@ -#' Reproject lat/long spatial object so that they are in units of 1m -#' -#' Many GIS functions (e.g. finding the area) -#' -#' @param shp A spatial object with a geographic (WGS84) coordinate system -#' @param crs An optional coordinate reference system (if not provided it is set -#' automatically by [geo_select_aeq()]). -#' @family geo -#' @export -#' @examples -#' data(routes_fast) -#' rf_aeq <- reproject(routes_fast[1:3, ]) -#' rf_osgb <- reproject(routes_fast[1:3, ], 27700) -reproject <- function(shp, crs = geo_select_aeq(shp)) { - if (is.na(raster::crs(shp))) { - message("Assuming a geographical (lat/lon) CRS (EPSG:4326)") - raster::crs(shp) <- sp::CRS("+init=epsg:4326") - } - if (is.numeric(crs)) { # test if it's an epsg code - crs <- sp::CRS(paste0("+init=epsg:", crs)) - } - message(paste0("Transforming to CRS ", crs)) - res <- sp::spTransform(shp, crs) - res -} diff --git a/R/cyclestreets.R b/R/cyclestreets.R deleted file mode 100644 index 515b32cb..00000000 --- a/R/cyclestreets.R +++ /dev/null @@ -1,45 +0,0 @@ -#' Generate nearest point on the route network of a point using the CycleStreets.net -#' -#' @section Details: -#' Retrieve coordinates of the node(s) on the network mapped from coordinates -#' passed to functions. -#' -#' Note: there is now a dedicated cyclestreets package: -#' https://github.com/Robinlovelace/cyclestreets -#' -#' @inheritParams route_cyclestreets -#' @param shp A spatial object -#' @param lat Numeric vector containing latitude coordinate for each coordinate -#' to map. Also accepts dataframe with latitude in the first column and -#' longitude in the second column. -#' @param lng Numeric vector containing longitude coordinate for each -#' coordinate to map. -#' -#' @export -#' @examples -#' \dontrun{ -#' nearest_cyclestreets(53, 0.02, pat = Sys.getenv("CYCLESTREETS")) -#' nearest_cyclestreets(cents[1, ], pat = Sys.getenv("CYCLESTREETS")) -#' nearest_cyclestreets(cents_sf[1, ], pat = Sys.getenv("CYCLESTREETS")) -#' } -nearest_cyclestreets <- function(shp = NULL, lat, lng, pat = api_pat("cyclestreet")) { - UseMethod("nearest_cyclestreets", object = shp) -} -#' @export -nearest_cyclestreets.NULL <- function(shp = NULL, lat, lng, pat = api_pat("cyclestreet")) { - url <- paste0("https://api.cyclestreets.net/v2/nearestpoint?lonlat=", lng, ",", lat, "&key=", pat) - obj <- jsonlite::fromJSON(url) - coords <- obj$features$geometry$coordinates[[1]] - sp::SpatialPointsDataFrame( - coords = matrix(coords, ncol = 2), - data = data.frame(orig_lat = lat, orig_lng = lng) - ) -} -#' @export -nearest_cyclestreets.Spatial <- function(shp, lat = shp@coords[1, 2], lng = shp@coords[1, 1], pat = api_pat("cyclestreet")) { - nearest_cyclestreets.NULL(lat = lat, lng = lng, pat = pat) -} -#' @export -nearest_cyclestreets.sf <- function(shp, lat = sf::st_coordinates(shp)[2], lng = sf::st_coordinates(shp)[1], pat = api_pat("cyclestreet")) { - sf::st_as_sf(nearest_cyclestreets.NULL(lat = lat, lng = lng, pat = pat)) -} diff --git a/R/data.R b/R/data.R index 126d9d59..0164bde0 100644 --- a/R/data.R +++ b/R/data.R @@ -10,25 +10,19 @@ #' } #' #' Cents was generated from the data repository pct-data: https://github.com/npct/pct-data. This data was accessed from within the pct repo: https://github.com/npct/pct, using the following code: -#' @aliases cents_sf #' @examples -#' \dontrun{ -#' cents -#' plot(cents) -#' } -#' +#' cents_sf #' @docType data #' @keywords datasets -#' @name cents -#' @usage data(cents) -#' @format A spatial dataset with 8 rows and 5 variables +#' @name cents_sf +#' @format A spatial dataset with 8 rows and 5 columns NULL -#' data frame of commuter flows +#' Data frame of commuter flows #' #' #' This dataset represents commuter flows (work travel) between origin -#' and destination zones (see [cents()]). +#' and destination zones. #' The data is from the UK and is available as open data: #' . #' @@ -44,42 +38,15 @@ NULL #' Although these variable names are unique to UK data, the data #' structure is generalisable and typical of flow data from any source. #' The key variables are the origin and destination ids, which link to -#' the `cents` georeferenced spatial objects. +#' the georeferenced spatial objects. #' @family example data -#' @examples -#' \dontrun{ -#' # This is how the dataset was constructed - see -#' # https://github.com/npct/pct - if download to ~/repos -#' flow <- readRDS("~/repos/pct/pct-data/national/flow.Rds") -#' data(cents) -#' o <- flow$Area.of.residence %in% cents$geo_code[-1] -#' d <- flow$Area.of.workplace %in% cents$geo_code[-1] -#' flow <- flow[o & d, ] # subset flows with o and d in study area -#' library(devtools) -#' flow$id <- paste(flow$Area.of.residence, flow$Area.of.workplace) -#' use_data(flow, overwrite = TRUE) -#' -#' # Convert flows to spatial lines dataset -#' flowlines <- od2line(flow = flow, zones = cents) -#' # use_data(flowlines, overwrite = TRUE) -#' -#' # Convert flows to routes -#' routes_fast <- line2route(l = flowlines, plan = "fastest") -#' routes_slow <- line2route(l = flowlines, plan = "quietest") -#' -#' use_data(routes_fast) -#' use_data(routes_slow) -#' routes_fast_sf <- sf::st_as_sf(routes_fast) -#' routes_slow_sf <- sf::st_as_sf(routes_slow) -#' } -#' #' @docType data #' @keywords datasets #' @name flow -#' @usage data(flow) #' @format A data frame with 49 rows and 15 columns NULL -#' data frame of invented + +#' Data frame of invented #' commuter flows with destinations in a different layer than the origins #' #' @family example data @@ -98,94 +65,37 @@ NULL #' @usage data(flow_dests) #' @format A data frame with 49 rows and 15 columns NULL -#' Example destinations data -#' -#' This dataset represents trip destinations on a different geographic -#' level than the origins stored in the object `cents`. -#' @family example data -#' @examples -#' \dontrun{ -#' # This is how the dataset was constructed - see -#' # https://cowz.geodata.soton.ac.uk/download/ -#' download.file( -#' "https://cowz.geodata.soton.ac.uk/download/files/COWZ_EW_2011_BFC.zip", -#' "COWZ_EW_2011_BFC.zip" -#' ) -#' unzip("COWZ_EW_2011_BFC.zip") -#' wz <- raster::shapefile("COWZ_EW_2011_BFC.shp") -#' to_remove <- list.files(pattern = "COWZ", full.names = TRUE, recursive = TRUE) -#' file.remove(to_remove) -#' proj4string(wz) -#' wz <- sp::spTransform(wz, proj4string(zones)) -#' destination_zones <- wz[zones, ] -#' plot(destination_zones) -#' devtools::use_data(destination_zones) -#' head(destination_zones@data) -#' destinations <- rgeos::gCentroid(destinations, byid = TRUE) -#' destinations <- sp::SpatialPointsDataFrame(destinations, destination_zones@data) -#' devtools::use_data(destinations, overwrite = TRUE) -#' destinations_sf <- sf::st_as_sf(destinations) -#' devtools::use_data(destinations_sf) -#' } -#' @docType data -#' @keywords datasets -#' @name destination_zones -#' @aliases destinations destinations_sf -#' @usage data(destination_zones) -#' @format A spatial dataset with 87 features -NULL -#' spatial lines dataset of commuter flows -#' -#' -#' Flow data after conversion to a spatial format -#' with [od2line()] (see [flow()]). -#' -#' @family example data -#' @docType data -#' @keywords datasets -#' @name flowlines -#' @aliases flowlines_sf -#' @format A spatial lines dataset with 49 rows and 15 columns -NULL -#' spatial lines dataset of commuter flows on the travel network +#' Spatial lines dataset of commuter flows on the travel network #' #' #' Simulated travel route allocated to the transport network -#' representing the 'fastest' between [cents()] -#' objects -#' with [od2line()] (see [flow()]). +#' representing the 'fastest' between `cents_sf` +#' objects. #' #' @family example data #' @docType data #' @keywords datasets -#' @name routes_fast -#' @usage data(routes_fast) +#' @name routes_fast_sf +#' @usage routes_fast_sf #' @format A spatial lines dataset with 49 rows and 15 columns -#' @aliases routes_fast_sf NULL -#' spatial lines dataset of commuter flows on the travel network +#' Spatial lines dataset of commuter flows on the travel network #' #' #' Simulated travel route allocated to the transport network -#' representing the 'quietest' between [cents()] -#' objects -#' with [od2line()] (see [flow()]). +#' representing the 'quietest' between `cents_sf`. #' #' @family example data #' @docType data #' @keywords datasets -#' @name routes_slow -#' @usage data(routes_slow) +#' @name routes_slow_sf #' @format A spatial lines dataset 49 rows and 15 columns -#' @aliases routes_slow_sf NULL #' Spatial polygons of home locations for flow analysis. #' -#' Note: we recommend using the `zones_sf` data. -#' #' These correspond to the `cents_sf` data. #' #' \itemize{ @@ -198,62 +108,32 @@ NULL #' plot(zones_sf) #' @docType data #' @keywords datasets -#' @name zones -#' @aliases zones_sf +#' @name zones_sf NULL -#' spatial lines dataset representing a route network +#' Spatial lines dataset of commuter flows #' #' -#' The flow of commuters using different segments of the road network represented in the -#' [flowlines()] and [routes_fast()] datasets +#' Flow data after conversion to a spatial format.. #' #' @family example data #' @docType data #' @keywords datasets -#' @name route_network -#' @aliases route_network_sf -#' @usage data(route_network) -#' @format A spatial lines dataset 80 rows and 1 column -#' @examples -#' \dontrun{ -#' # Generate route network -#' route_network <- overline(routes_fast, "All", fun = sum) -#' route_network_sf <- sf::st_as_sf(route_network) -#' } +#' @name flowlines_sf +#' @format A spatial lines dataset with 49 rows and 15 columns NULL -#' SpatialPointsDataFrame representing road traffic deaths +#' spatial lines dataset representing a route network #' -#' This dataset represents the type of data downloaded and cleaned -#' using stplanr functions. It represents a very small sample (with most variables stripped) -#' of open data from the UK's Stats19 dataset. #' -#' @docType data -#' @keywords datasets -#' @name ca_local -#' @usage data(ca_local) -#' @format A SpatialPointsDataFrame with 11 rows and 2 columns -NULL - -#' Line polygon +#' The flow of commuters using different segments of the road network represented in the +#' [flowlines_sf()] and [routes_fast_sf()] datasets #' -#' This dataset represents road width for testing. +#' @family example data #' @docType data #' @keywords datasets -#' @name l_poly -#' @usage data(l_poly) -#' @format A SpatialPolygon -#' -#' @examples -#' \dontrun{ -#' l <- routes_fast[13, ] -#' l_poly <- geo_projected(l, rgeos::gBuffer, 8) -#' plot(l_poly) -#' plot(routes_fast, add = TRUE) -#' # allocate road width to relevant line -#' devtools::use_data(l_poly) -#' } +#' @name route_network_sf +#' @format A spatial lines dataset 80 rows and 1 column NULL #' Example of OpenStreetMap road network @@ -340,3 +220,16 @@ NULL #' @examples #' rnet_cycleway_intersection NULL + +#' Example destinations data +#' +#' This dataset represents trip destinations on a different geographic +#' level than the origins stored in the object `cents_sf`. +#' @family example data +#' @examples +#' destinations_sf +#' @docType data +#' @keywords datasets +#' @name destinations_sf +#' @format A spatial dataset with 87 features +NULL diff --git a/R/geo-functions.R b/R/geo-functions.R index 363f83c3..76402eb7 100644 --- a/R/geo-functions.R +++ b/R/geo-functions.R @@ -1,17 +1,3 @@ -#' Write to geojson easily -#' -#' Provides a user-friendly wrapper for `sf::st_write()`. Note, -#' `geojson_write` from the geojsonio package -#' provides the same functionality . -#' -#' @param shp Spatial data object -#' @param filename File name of the output geojson -writeGeoJSON <- function(shp, filename) { - name <- nm <- deparse(substitute(shp)) - newname <- paste0(filename, ".geojson") - sf::st_write(sf::st_as_sf(shp), newname) -} - #' Scale a bounding box #' #' Takes a bounding box as an input and outputs a bounding box of a different size, centred at the same point. @@ -43,7 +29,7 @@ bbox_scale <- function(bb, scale_factor) { #' represented as a bounding box, corner points or rectangular polygon. #' #' @inheritParams bbox_scale -#' @param shp Spatial object (from sf or sp packages) +#' @param shp Spatial object #' @param distance Distance in metres to extend the bounding box by #' @param output Type of object returned (polygon by default) #' @aliases bb2poly @@ -51,13 +37,12 @@ bbox_scale <- function(bb, scale_factor) { #' @family geo #' @export #' @examples -#' # Simple features implementation: #' shp <- routes_fast_sf #' shp_bb <- geo_bb(shp, distance = 100) #' plot(shp_bb, col = "red", reset = FALSE) #' plot(geo_bb(routes_fast_sf, scale_factor = 0.8), col = "green", add = TRUE) -#' plot(geo_bb(routes_fast_sf, output = "points"), add = TRUE) #' plot(routes_fast_sf$geometry, add = TRUE) +#' geo_bb(shp, output = "point") geo_bb <- function(shp, scale_factor = 1, distance = 0, output = c("polygon", "points", "bb")) { UseMethod("geo_bb") } @@ -67,16 +52,12 @@ geo_bb.sf <- function(shp, scale_factor = 1, distance = 0, output = c("polygon", output <- match.arg(output) bb <- geo_bb_matrix(shp) bb <- bbox_scale(bb = bb, scale_factor = scale_factor) - bb_sp <- bb2poly(bb = bb, distance = distance) - bb <- sf::st_as_sf(bb_sp) + bb <- bb2poly(bb = bb, distance = distance) sf::st_crs(bb) <- sf::st_crs(shp) if (output == "polygon") { return(bb) } else if (output == "points") { - bb_point <- sp::SpatialPoints(raster::geom(bb_sp)[1:4, c(5, 6)]) - bb_point <- sf::st_as_sf(bb_point) - sf::st_crs(bb_point) <- sf::st_crs(shp) - return(bb_point) + return(sf::st_cast(x = bb, to = "POINT")[1:4]) } else if (output == "bb") { return(geo_bb_matrix(bb)) } @@ -93,10 +74,7 @@ geo_bb.bbox <- function(shp, scale_factor = 1, distance = 0, output = c("polygon if (output == "polygon") { return(bb) } else if (output == "points") { - bb_point <- sp::SpatialPoints(raster::geom(bb_sp)[1:4, c(5, 6)]) - bb_point <- sf::st_as_sf(bb_point) - sf::st_crs(bb_point) <- sf::st_crs(shp) - return(bb_point) + return(sf::st_cast(x = bb, to = "POINT")[1:4]) } else if (output == "bb") { return(geo_bb_matrix(bb)) } @@ -115,8 +93,7 @@ geo_bb.matrix <- function(shp, scale_factor = 1, distance = 0, output = c("polyg if (output == "polygon") { return(bb) } else if (output == "points") { - bb_point <- sp::SpatialPoints(raster::geom(bb)[1:4, c(5, 6)]) - return(bb_point) + return(sf::st_cast(x = bb, to = "POINT")[1:4]) } else if (output == "bb") { return(geo_bb_matrix(bb)) } @@ -125,14 +102,16 @@ geo_bb.matrix <- function(shp, scale_factor = 1, distance = 0, output = c("polyg #' @export bb2poly <- function(bb, distance = 0) { if (is(bb, "matrix")) { - b_poly <- as(raster::extent(as.vector(t(bb))), "SpatialPolygons") + bb = as.numeric(bb) + class(bb) = "bbox" + b_poly <- sf::st_as_sfc(bb) } else { - b_poly <- as(raster::extent(bb), "SpatialPolygons") - proj4string(b_poly) <- proj4string(bb) + b_poly = sf::st_as_sfc(bb) } if (distance > 0) { - b_poly_buff <- geo_buffer(shp = b_poly, width = distance) - b_poly <- bb2poly(b_poly_buff) + b_poly_buff <- geo_buffer(shp = b_poly, dist = distance) + b_poly_bbox = sf::st_bbox(b_poly_buff) + b_poly <- bb2poly(b_poly_bbox) } b_poly } @@ -145,19 +124,14 @@ bb2poly <- function(bb, distance = 0) { #' @family geo #' @export #' @examples -#' geo_bb_matrix(routes_fast) #' geo_bb_matrix(routes_fast_sf) -#' geo_bb_matrix(cents[1, ]) +#' geo_bb_matrix(cents_sf[1, ]) #' geo_bb_matrix(c(-2, 54)) #' geo_bb_matrix(sf::st_coordinates(cents_sf)) geo_bb_matrix <- function(shp) { UseMethod("geo_bb_matrix") } #' @export -geo_bb_matrix.Spatial <- function(shp) { - sp::bbox(shp) -} -#' @export geo_bb_matrix.sf <- function(shp) { bb <- sf::st_bbox(shp) bb <- matrix(bb, ncol = 2) diff --git a/R/geo_code.R b/R/geo_code.R index 6477deae..1e07777f 100644 --- a/R/geo_code.R +++ b/R/geo_code.R @@ -7,7 +7,7 @@ #' @param return_all Should the request return all information returned by Google Maps? #' The default is `FALSE`: to return only two numbers: the longitude and latitude, in that order #' @param service Which service to use? Nominatim by default -#' @inheritParams route_cyclestreets +#' @param pat Personal access token #' @family nodes #' @export #' @examples diff --git a/R/geo_projected.R b/R/geo_projected.R index 2f2736ed..ed869810 100644 --- a/R/geo_projected.R +++ b/R/geo_projected.R @@ -11,12 +11,6 @@ #' @param shp A spatial object with a geographic (WGS84) coordinate system #' @export #' @examples -#' sp::bbox(routes_fast) -#' new_crs <- geo_select_aeq(routes_fast) -#' rf_projected <- sp::spTransform(routes_fast, new_crs) -#' sp::bbox(rf_projected) -#' line_length <- rgeos::gLength(rf_projected, byid = TRUE) -#' plot(line_length, rf_projected$length) #' shp <- zones_sf #' geo_select_aeq(shp) #' @export @@ -24,15 +18,6 @@ geo_select_aeq <- function(shp) { UseMethod("geo_select_aeq") } #' @export -geo_select_aeq.Spatial <- function(shp) { - cent <- rgeos::gCentroid(shp) - aeqd <- sprintf( - "+proj=aeqd +lat_0=%s +lon_0=%s +x_0=0 +y_0=0", - cent@coords[[2]], cent@coords[[1]] - ) - sp::CRS(aeqd) -} -#' @export geo_select_aeq.sf <- function(shp) { cent <- sf::st_geometry(shp) coords <- sf::st_coordinates(shp) @@ -57,17 +42,16 @@ geo_select_aeq.sfc <- function(shp) { sf::st_crs(aeqd) } - #' Perform GIS functions on a temporary, projected version of a spatial object #' #' This function performs operations on projected data. #' #' @param shp A spatial object with a geographic (WGS84) coordinate system -#' @param fun A function to perform on the projected object (e.g. the the rgeos or sf packages) +#' @param fun A function to perform on the projected object (e.g. from the sf package) #' @param crs An optional coordinate reference system (if not provided it is set #' automatically by [geo_select_aeq()]) #' @param silent A binary value for printing the CRS details (default: TRUE) -#' @param ... Arguments to pass to `fun`, e.g. `byid = TRUE` if the function is `rgeos::gLength()` +#' @param ... Arguments to pass to `fun` #' @aliases gprojected #' @export #' @examples @@ -114,36 +98,6 @@ geo_projected.sfc <- function(shp, fun, crs = geo_select_aeq(shp), silent = TRUE } res } -#' @export -geo_projected.Spatial <- function(shp, fun, crs = geo_select_aeq(shp), silent = TRUE, ...) { - # assume it's not projected (i.e. lat/lon) if there is no CRS - if (!is.na(sp::is.projected(shp))) { - if (sp::is.projected(shp)) { - res <- fun(shp, ...) - } else { - shp_projected <- reproject(shp, crs = crs) - if (!silent) { - message(paste0("Running function on a temporary projection: ", crs)) - } - res <- fun(shp_projected, ...) - if (is(res, "Spatial")) { - res <- sp::spTransform(res, sp::CRS("+init=epsg:4326")) - } - } - } else { - shp_projected <- reproject(shp, crs = crs) - if (!silent) { - message(paste0("Running function on a temporary projection: ", crs$proj4string)) - } - res <- fun(shp_projected, ...) - if (is(res, "Spatial")) { - res <- sp::spTransform(res, sp::CRS("+init=epsg:4326")) - } - } - res -} -#' @export -gprojected <- geo_projected.Spatial #' Perform a buffer operation on a temporary projected CRS #' #' This function solves the problem that buffers will not be circular when used on @@ -157,7 +111,7 @@ gprojected <- geo_projected.Spatial #' around which a buffer should be drawn #' @param dist The distance (in metres) of the buffer (when buffering simple features) #' @param width The distance (in metres) of the buffer (when buffering sp objects) -#' @param ... Arguments passed to the buffer (see `?rgeos::gBuffer` or `?sf::st_buffer` for details) +#' @param ... Arguments passed to the buffer (see `?sf::st_buffer` for details) #' @examples #' lib_versions <- sf::sf_extSoftVersion() #' lib_versions @@ -165,10 +119,6 @@ gprojected <- geo_projected.Spatial #' buff_sf <- geo_buffer(routes_fast_sf, dist = 50) #' plot(buff_sf$geometry) #' geo_buffer(routes_fast_sf$geometry, dist = 50) -#' # on legacy sp objects (not tested) -#' # buff_sp <- geo_buffer(routes_fast, width = 100) -#' # class(buff_sp) -#' # plot(buff_sp, col = "red") #' } #' @export geo_buffer <- function(shp, dist = NULL, width = NULL, ...) { @@ -183,10 +133,6 @@ geo_buffer.sfc <- function(shp, ...) { geo_projected(shp, sf::st_buffer, ...) } -#' @export -geo_buffer.Spatial <- function(shp, ...) { - geo_projected.Spatial(shp = shp, fun = rgeos::gBuffer, ...) -} #' Calculate line length of line with geographic or projected CRS #' #' Takes a line (represented in sf or sp classes) @@ -196,7 +142,6 @@ geo_buffer.Spatial <- function(shp, ...) { #' lib_versions <- sf::sf_extSoftVersion() #' lib_versions #' if (lib_versions[3] >= "6.3.1") { -#' geo_length(routes_fast) #' geo_length(routes_fast_sf) #' } #' @export @@ -213,9 +158,3 @@ geo_length.sf <- function(shp) { } as.numeric(l) } - -#' @export -geo_length.Spatial <- function(shp) { - shp <- sf::st_as_sf(shp) - geo_length(shp) -} diff --git a/R/google-functions.R b/R/google-functions.R deleted file mode 100644 index 464e4de1..00000000 --- a/R/google-functions.R +++ /dev/null @@ -1,178 +0,0 @@ -#' Generate nearest point on the route network of a point using the Google Maps API -#' -#' @section Details: -#' Retrieve coordinates of the node(s) on the network mapped from coordinates -#' passed to functions. -#' -#' @param lat Numeric vector containing latitude coordinate for each coordinate -#' to map. Also accepts dataframe with latitude in the first column and -#' longitude in the second column. -#' @param lng Numeric vector containing longitude coordinate for each -#' coordinate to map. -#' @param google_api String value containing the Google API key to use. -#' @family nodes -#' @export -#' @examples -#' \dontrun{ -#' nearest_google(lat = 50.333, lng = 3.222, google_api = "api_key_here") -#' } -nearest_google <- function(lat, lng, google_api) { - base_url <- "https://roads.googleapis.com/v1/snapToRoads" - url <- paste0(base_url, "?path=", lat, ",", lng, "&key=", google_api) - obj <- jsonlite::fromJSON(url) - coords <- c(obj$snappedPoints$location$longitude, obj$snappedPoints$location$latitude) - sp::SpatialPointsDataFrame( - coords = matrix(coords, ncol = 2), - data = data.frame(orig_lat = lat, orig_lng = lng) - ) -} -#' Return travel network distances and time using the Google Maps API -#' -#' @section Details: -#' Estimate travel times accounting for the road network - see -#' Note: Currently returns the json object returned by the Google Maps API and uses the same origins and destinations. -#' @param from Two-column matrix or data frame of coordinates representing -#' latitude and longitude of origins. -#' @param to Two-column matrix or data frame of coordinates representing -#' latitude and longitude of destinations. -#' @param google_api String value containing the Google API key to use. -#' @param g_units Text string, either metric (default) or imperial. -#' @param mode Text string specifying the mode of transport. Can be -#' bicycling (default), walking, driving or transit -#' @param arrival_time Time of arrival in date format. -#' @family od -#' @export -#' -#' @details -#' Absent authorization, the google API is limited to a maximum of 100 -#' simultaneous queries, and so will, for example, only returns values for up to -#' 10 origins times 10 destinations. -#' -#' @examples -#' \dontrun{ -#' # Distances from one origin to one destination -#' from <- c(-46.3, -23.4) -#' to <- c(-46.4, -23.4) -#' dist_google(from = from, to = to, mode = "walking") # not supported on last test -#' dist_google(from = from, to = to, mode = "driving") -#' dist_google(from = c(0, 52), to = c(0, 53)) -#' data("cents") -#' # Distances from between all origins and destinations -#' dists_cycle <- dist_google(from = cents, to = cents) -#' dists_drive <- dist_google(cents, cents, mode = "driving") -#' dists_trans <- dist_google(cents, cents, mode = "transit") -#' dists_trans_am <- dist_google(cents, cents, -#' mode = "transit", -#' arrival_time = strptime("2016-05-27 09:00:00", -#' format = "%Y-%m-%d %H:%M:%S", tz = "BST" -#' ) -#' ) -#' # Find out how much longer (or shorter) cycling takes than walking -#' summary(dists_cycle$duration / dists_trans$duration) -#' # Difference between travelling now and for 9am arrival -#' summary(dists_trans_am$duration / dists_trans$duration) -#' odf <- points2odf(cents) -#' odf <- cbind(odf, dists) -#' head(odf) -#' flow <- points2flow(cents) -#' # show the results for duration (thicker line = shorter) -#' plot(flow, lwd = mean(odf$duration) / odf$duration) -#' dist_google(c("Hereford"), c("Weobley", "Leominster", "Kington")) -#' dist_google(c("Hereford"), c("Weobley", "Leominster", "Kington"), -#' mode = "transit", arrival_time = strptime("2016-05-27 17:30:00", -#' format = "%Y-%m-%d %H:%M:%S", tz = "BST" -#' ) -#' ) -#' } -dist_google <- function(from, to, google_api = Sys.getenv("GOOGLEDIST"), - g_units = "metric", - mode = c("bicycling", "walking", "driving", "transit"), - arrival_time = "") { - mode <- match.arg(mode) - base_url <- "https://maps.googleapis.com/maps/api/distancematrix/json?units=" - # Convert sp object to lat/lon vector - if (is(from, "SpatialPoints") | is(from, "SpatialPointsDataFrame")) { - from <- coordinates(from) - } - if (is(to, "SpatialPoints") | is(to, "SpatialPointsDataFrame")) { - to <- coordinates(to) - } - if (google_api == "") { - google_api_param <- "" - } else { - google_api_param <- "&key=" - } - if (is(from, "matrix") | is(from, "data.frame")) { - from <- paste(from[, 2], from[, 1], sep = ",") - } - if (is(from, "numeric")) { - from <- paste(from[2], from[1], sep = ",") - } - if (is(to, "matrix") | is(to, "data.frame")) { - to <- paste(to[, 2], to[, 1], sep = ",") - } - if (is(to, "numeric")) { - to <- paste(to[2], to[1], sep = ",") - } - from <- paste0(from, collapse = "|") - to <- paste0(to, collapse = "|") - url_travel <- paste0( - base_url, g_units, "&origins=", from, - "&destinations=", to, "&mode=", mode - ) - if (is(arrival_time[1], "POSIXlt")) { - arrival_time <- as.numeric(arrival_time) - url_travel <- paste0(url_travel, "&arrival_time=", arrival_time) - } - url <- paste0( - url_travel, - google_api_param, - google_api - ) - url <- utils::URLencode(url, repeated = FALSE, reserved = FALSE) - message(paste0("Sent this request: ", url)) - obj <- jsonlite::fromJSON(url) - if (obj$status != "OK" & any(grepl("error", names(obj)))) { - stop(obj[grepl("error", names(obj))], call. = FALSE) - } - if (grepl(pattern = "ZERO_RESULTS", obj$rows$elements[[1]])[1]) { - stop("No results for this request (e.g. due to lack of support for this mode between the from and to locations)", call. = FALSE) - } - - # some of cols are data.frames, e.g. - # lapply(obj$rows$elements[[1]], class) - # obj$rows$elements[[1]][1] - # obj$rows$elements[[1]][1]$distance$value - distances <- lapply( - obj$rows$elements, - function(x) x[1]$distance$value - ) - distances <- unlist(distances) - duration <- lapply( - obj$rows$elements, - function(x) x[2]$duration$value - ) - duration <- unlist(duration) - currency <- NA - fare <- NA - if (mode == "transit" & !is.null(obj$rows$elements[[1]]$fare[1])) { - currency <- lapply( - obj$rows$elements, - function(x) x$fare$currency - ) - currency <- unlist(currency) - fare <- lapply( - obj$rows$elements, - function(x) x$fare$value - ) - fare <- unlist(fare) - } - # is_ok = lapply(obj$rows$elements, - # function(x) x$status) - from_addresses <- rep(obj$origin_addresses, each = length(obj$origin_addresses)) - to_addresses <- rep(obj$destination_addresses, length(obj$origin_addresses)) - res_df <- data.frame(from_addresses, to_addresses, distances, duration, currency, fare) - res_df$from_addresses <- as.character(res_df$from_addresses) - res_df$to_addresses <- as.character(res_df$to_addresses) - return(res_df) -} diff --git a/R/line_sample.R b/R/line_sample.R deleted file mode 100644 index b73a91a5..00000000 --- a/R/line_sample.R +++ /dev/null @@ -1,83 +0,0 @@ -#' Sample integer number from given continuous vector of line lengths and probabilities, with total n -#' -#' @param n Sum of integer values returned -#' @param l_lengths Numeric vector of line lengths -#' @param weights Relative probabilities of samples on lines -#' @family lines -#' @export -#' @examples -#' n <- 10 -#' l_lengths <- 1:5 -#' weights <- 9:5 -#' (res <- n_sample_length(n, l_lengths, weights)) -#' sum(res) -#' n <- 100 -#' l_lengths <- c(12, 22, 15, 14) -#' weights <- c(38, 10, 44, 34) -#' (res <- n_sample_length(n, l_lengths, weights)) -#' sum(res) -#' # more examples: -#' n_sample_length(5, 1:5, c(0.1, 0.9, 0, 0, 0)) -#' n_sample_length(5, 1:5, c(0.5, 0.3, 0.1, 0, 0)) -#' l <- flowlines[2:6, ] -#' l_lengths <- line_length(l) -#' n <- n_sample_length(10, l_lengths, weights = l$All) -n_sample_length <- function(n, l_lengths, weights) { - # generate length-adjusted weights equal to 1 - l_lengths_rel <- l_lengths * weights / (sum(l_lengths * weights)) - n_vec <- round(n * l_lengths_rel) - if (sum(n_vec) != n) { - n_diff <- n - sum(n_vec) - probs <- l_lengths_rel - (n_vec / n) # how much less of each is needed - if (n_diff < 0) { - probs <- probs * -1 - } - probs[probs < 0] <- 0 - sel <- sample(length(l_lengths), size = abs(n_diff), prob = probs) - n_vec[sel] <- n_vec[sel] + sign(n_diff) - } - n_vec -} - -#' Sample n points along lines with density proportional to a weight -#' -#' @param n The total number of points to sample -#' @param l The SpatialLines object along which to create sample points -#' @param weights The relative probabilities of lines being samples -#' @family lines -#' @export -#' @examples -#' l <- flowlines[2:5, ] -#' n <- 100 -#' l_lengths <- line_length(l) -#' weights <- l$All -#' p <- line_sample(l, 50, weights) -#' plot(p) -#' p <- line_sample(l, 50, weights = 1:length(l)) -#' plot(p) -line_sample <- function(l, n, weights) { - not_projected <- !sp::is.projected(l) - if (not_projected) { - crs_orig <- sp::proj4string(l) - if (is.na(crs_orig)) { - crs_orig <- sp::CRS("+init=epsg:4326") - } - crs_new <- geo_select_aeq(l) - l <- sp::spTransform(l, CRSobj = crs_new) - } - lsf <- sf::st_as_sf(l, "SpatialLinesDataFrame") - l_lengths <- sf::st_length(lsf) - l_lengths <- as.vector(l_lengths) # convert to numeric vector - n_vec <- n_sample_length(n, l_lengths, weights = weights) - psf <- sf::st_line_sample(lsf, n = n_vec) - - # aim: group point collection into points - to update if possible - # class(psf) # its a MULIPOINT - psf_point <- as(psf, "Spatial") - psp <- as(psf, "Spatial") - psp <- sp::SpatialPoints(matrix(sp::coordinates(psp), ncol = 2), proj4string = sp::CRS(proj4string(psp))) - if (not_projected) { - psp <- sp::spTransform(psp, crs_orig) - } - return(psp) -} diff --git a/R/line_segment.R b/R/line_segment.R deleted file mode 100644 index 5081c33d..00000000 --- a/R/line_segment.R +++ /dev/null @@ -1,26 +0,0 @@ -#' Divide sf LINESTRING objects into regular segments -#' @inheritParams line2df -#' @param n_segments The number of segments to divide the line into -#' @param segment_length The approximate length of segments in the output (overides n_segments if set) -#' @family lines -#' @export -#' @examples -#' l <- routes_fast_sf[2, ] -#' l_seg2 <- line_segment_sf(l = l, n_segments = 2) -#' plot(sf::st_geometry(l_seg2), col = 1:2, lwd = 5) -line_segment_sf <- function(l, n_segments, segment_length = NA) { - if (!is.na(segment_length)) { - l_length <- line_length(l) - n_segments <- round(l_length / segment_length) - } - # browser() # tests - # first_linestring = lwgeom::st_linesubstring(x = l, from = 0, to = 0.2) - from_to_sequence = seq(from = 0, to = 1, length.out = n_segments + 1) - line_segment_list = lapply(seq(n_segments), function(i) - lwgeom::st_linesubstring( - x = l, - from = from_to_sequence[i], - to = from_to_sequence[i + 1]) - ) - do.call(rbind, line_segment_list) -} \ No newline at end of file diff --git a/R/linefuns.R b/R/linefuns.R index 15bf10cb..f24d99dd 100644 --- a/R/linefuns.R +++ b/R/linefuns.R @@ -1,34 +1,22 @@ # Line functions -#' Retrieve the number of vertices from a SpatialLines or SpatialPolygons object +#' Retrieve the number of vertices in sf objects #' -#' Returns a vector of the same length as the number of lines, -#' with the number of vertices per line or polygon. +#' Returns a vector of the same length as the number of sf objects. #' -#' See for more information. -#' -#' @param l A SpatialLines or SpatalPolygons object +#' @param l An sf object with LINESTRING geometry #' @family lines #' @export #' @examples -#' n_vertices(routes_fast) -#' n_vertices(routes_fast_sf) +#' l = routes_fast_sf +#' n_vertices(l) +#' n_vertices(zones_sf) n_vertices <- function(l) { UseMethod("n_vertices") } #' @export -n_vertices.Spatial <- function(l) { - sapply(l@lines, function(x) nrow(x@Lines[[1]]@coords)) -} -#' @export n_vertices.sf <- function(l) { - geoms <- sf::st_coordinates(l) - L1 <- rlang::quo(L1) - geoms %>% - dplyr::as_tibble() %>% - dplyr::group_by(!!L1) %>% - dplyr::summarise(n_vertices = dplyr::n()) %>% - dplyr::pull(n_vertices) + sapply(sf::st_geometry(l), function(x) nrow(sf::st_coordinates(x))) } #' Identify lines that are points @@ -45,12 +33,11 @@ n_vertices.sf <- function(l) { #' @family lines #' @export #' @examples -#' data(flowlines) -#' islp <- is_linepoint(flowlines) -#' nrow(flowlines) +#' islp <- is_linepoint(flowlines_sf) +#' nrow(flowlines_sf) #' sum(islp) #' # Remove invisible 'linepoints' -#' nrow(flowlines[!islp, ]) +#' nrow(flowlines_sf[!islp, ]) is_linepoint <- function(l) { nverts <- n_vertices(l) sel <- nverts <= 2 @@ -59,7 +46,7 @@ is_linepoint <- function(l) { } #' Find the bearing of straight lines #' -#' This is a simple wrapper around the geosphere function [bearing()] to return the +#' This function returns the #' bearing (in degrees relative to north) of lines. #' #' @details @@ -78,26 +65,9 @@ is_linepoint <- function(l) { #' 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, ]) -#' bearings_sp_1_9 -#' plot(bearings_sf_1_9, bearings_sp_1_9) #' line_bearing(flowlines_sf[1:5, ], bidirectional = TRUE) -#' line_bearing(flowlines[1:5, ], bidirectional = TRUE) #' } line_bearing <- function(l, bidirectional = FALSE) { - UseMethod("line_bearing") -} -#' @export -line_bearing.Spatial <- function(l, bidirectional = FALSE) { - ldf <- line2df(l) - bearing <- geosphere::bearing(as.matrix(ldf[, c("fx", "fy")]), as.matrix(ldf[, c("tx", "ty")])) - if (bidirectional) { - bearing <- make_bidirectional(bearing) - } - bearing -} -#' @export -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)])) @@ -114,7 +84,8 @@ line_bearing.sf <- function(l, bidirectional = FALSE) { #' on the direction of turn, i.e. + or - values for clockwise/anticlockwise), #' bidirectional (which mean values greater than +/- 90 are impossible). #' -#' Building on the convention used in [bearing()] and in many applications, +#' Building on the convention used in in the `bearing()` function from the +#' `geosphere` package and in many applications, #' North is definied as 0, East as 90 and West as -90. #' #' @inheritParams line_bearing @@ -133,18 +104,9 @@ line_bearing.sf <- function(l, bidirectional = FALSE) { #' 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) -#' plot(flowlines) -#' plot(flowlines[a < 15, ], add = TRUE, lwd = 3, col = "red") -#' # East-West -#' plot(flowlines[a > 75, ], add = TRUE, lwd = 3, col = "green") #' } angle_diff <- function(l, angle, bidirectional = FALSE, absolute = TRUE) { - UseMethod("angle_diff") -} -#' @export -angle_diff.Spatial <- function(l, angle, bidirectional = FALSE, absolute = TRUE) { - if (is(object = l, "Spatial")) { + if (is(object = l, "sf")) { line_angles <- line_bearing(l) } else { line_angles <- l @@ -161,86 +123,53 @@ angle_diff.Spatial <- function(l, angle, bidirectional = FALSE, absolute = TRUE) } angle_diff } -#' @export -angle_diff.sf <- function(l, angle, bidirectional = FALSE, absolute = TRUE) { - l_sp <- sf::as_Spatial(sf::st_geometry(l)) - angle_diff.Spatial(l_sp, angle, bidirectional = FALSE, absolute = TRUE) -} #' Find the mid-point of lines #' -#' This is a wrapper around [SpatialLinesMidPoints()] that allows it to find the midpoint -#' of lines that are not projected, which have a lat/long CRS. #' @inheritParams line2df +#' @param tolerance The tolerance used to break lines at verteces. +#' See [lwgeom::st_linesubstring()]. #' @family lines #' @export #' @examples -#' data(routes_fast) -#' line_midpoint(routes_fast[2:5, ]) -line_midpoint <- function(l) { - UseMethod("line_midpoint") -} -#' @export -line_midpoint.Spatial <- function(l) { - gprojected(l, maptools::SpatialLinesMidPoints) -} -#' @export -line_midpoint.sf <- function(l) { - l <- sf::as_Spatial(l) - res_sp <- line_midpoint.Spatial(l) - sf::st_as_sf(l) -} -#' Calculate length of lines in geographic CRS -#' @inheritParams line2df -#' @param byid Logical determining whether the length is returned per object (default is true) -#' @export -line_length <- function(l, byid = TRUE) { - gprojected(l, rgeos::gLength, byid = byid) +#' l = routes_fast_sf[2:5, ] +#' plot(l$geometry, col = 2:5) +#' midpoints = line_midpoint(l) +#' plot(midpoints, add = TRUE) +line_midpoint <- function(l, tolerance = NULL) { + if(is.null(tolerance)) { + sub = lwgeom::st_linesubstring(x = l, from = 0, to = 0.5) + } else { + sub = lwgeom::st_linesubstring(x = l, from = 0, to = 0.5, tolerance = tolerance) + } + lwgeom::st_endpoint(sub) } -#' Divide SpatialLines dataset into regular segments +#' Divide sf LINESTRING objects into regular segments #' @inheritParams line2df #' @param n_segments The number of segments to divide the line into #' @param segment_length The approximate length of segments in the output (overides n_segments if set) #' @family lines #' @export #' @examples -#' data(routes_fast) -#' l <- routes_fast[2, ] -#' library(sp) +#' l <- routes_fast_sf[2, ] #' l_seg2 <- line_segment(l = l, n_segments = 2) -#' plot(l_seg2, col = l_seg2$group, lwd = 50) +#' plot(sf::st_geometry(l_seg2), col = 1:2, lwd = 5) line_segment <- function(l, n_segments, segment_length = NA) { if (!is.na(segment_length)) { - l_length <- line_length(l) + l_length <- sf::st_length(l) n_segments <- round(l_length / segment_length) } - if (n_segments == 2) { - pseg <- line_midpoint(l) - } else { - pseg <- sp::spsample(x = l, n = n_segments - 1, type = "regular") - } - l_geom <- raster::geom(l) - l_coords <- l_geom[, c("x", "y")] - knn_res <- nabor::knn(data = l_coords, query = sp::coordinates(pseg), k = 1) - sel_nearest <- c(knn_res$nn.idx) - for (i in 1:(length(sel_nearest) + 1)) { - ids <- c(1, sel_nearest, nrow(l)) - if (i == 1) { - l_seg <- points2line(l_coords[ids[i]:ids[(i + 1)], ]) - sp::spChFIDs(l) <- i - } else if (i == length(sel_nearest) + 1) { - l_temp <- points2line(l_coords[ids[i]:nrow(l_coords), ]) - sp::spChFIDs(l_temp) <- i - l_seg <- raster::bind(l_seg, l_temp) - } else { - l_temp <- points2line(l_coords[ids[i]:ids[(i + 1)], ]) - sp::spChFIDs(l_temp) <- i - l_seg <- raster::bind(l_seg, l_temp) - } - } - l_seg <- sp::SpatialLinesDataFrame(l_seg, data.frame(group = 1:i)) - raster::crs(l_seg) <- raster::crs(l) - l_seg + # browser() # tests + # first_linestring = lwgeom::st_linesubstring(x = l, from = 0, to = 0.2) + from_to_sequence = seq(from = 0, to = 1, length.out = n_segments + 1) + line_segment_list = lapply(seq(n_segments), function(i) + lwgeom::st_linesubstring( + x = l, + from = from_to_sequence[i], + to = from_to_sequence[i + 1] + ) + ) + do.call(rbind, line_segment_list) } make_bidirectional <- function(bearing) { is_na_bearings <- is.na(bearing) diff --git a/R/loadABS.R b/R/loadABS.R index 85a43fc0..09307945 100644 --- a/R/loadABS.R +++ b/R/loadABS.R @@ -7,6 +7,10 @@ #' This function imports the original (unzipped) TableBuilder files in .csv #' or .xlsx format before creating an R dataframe with the data. #' +#' Note: we recommend using the +#' [readabs](https://github.com/mattcowgill/readabs) +#' package for this purpose. +#' #' @param dataset Either a dataframe containing the original data from #' TableBuilder or a character string containing the path of the #' unzipped TableBuilder file. @@ -22,88 +26,6 @@ #' with totals (default = TRUE). #' @family data #' @export -#' @examples -#' data_dir <- system.file("extdata", package = "stplanr") -#' t1 <- read_table_builder(file.path(data_dir, "SA1Population.csv")) -#' 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) -#' t3 <- read_table_builder(sa1pop) read_table_builder <- function(dataset, filetype = "csv", sheet = 1, removeTotal = TRUE) { - if (missing(dataset)) { - stop("Dataset is missing") - } - if (is.data.frame(dataset)) { - tbfile <- dataset - } else if (is.character(dataset)) { - if (filetype == "xlsx") { - if (requireNamespace("openxlsx", quietly = TRUE)) { - tbfile <- openxlsx::readWorkbook(dataset, sheet = sheet, colNames = FALSE) - } else { - stop("Please install openxlsx for this to work") - } - } else { - tbfile <- read.csv(stringsAsFactors = TRUE, dataset, header = FALSE) - } - } else { - stop("Dataset not data.frame or character string") - } - if (is.null(tbfile) == TRUE) { - stop("File could not be loaded") - } else { - if (filetype == "xlsx" | filetype == "legacycsv") { - tbfile[tbfile == ""] <- NA - tbfile <- tbfile[, which(!(colSums(is.na(tbfile)) == nrow(tbfile)))] - if (is.na(tbfile[which(rowSums(is.na(tbfile[, 2:ncol(tbfile)])) == min(rowSums(is.na(tbfile[, 2:ncol(tbfile)])))), ][1, 1]) == TRUE) { - tbfile[, 1] <- NULL - } - else { - tbfile <- tbfile[which(rowSums(is.na(tbfile)) < (ncol(tbfile) - 1)), ] - } - tbfile <- tbfile[which(rowSums(is.na(tbfile)) != ncol(tbfile)), ] - valuecols <- which(!is.na(tbfile[1, ])) - valuecols <- valuecols[which(valuecols > 1)] - valuecols <- valuecols[!valuecols %in% which(!is.na(tbfile[2, ]))] - colnames(tbfile) <- c(as.character(unlist(unname(tbfile[2, which(!is.na(tbfile[2, ]))]))), as.character(unlist(unname(tbfile[1, valuecols])))) - tbfile <- tbfile[3:nrow(tbfile), ] - tbfile <- tbfile[which(rowSums(is.na(tbfile)) != ncol(tbfile) - 1), ] - if (length(valuecols) > 1) { - tbfile <- tbfile[which(!rowSums(is.na(tbfile[, valuecols])) == length(valuecols)), ] - } - else { - tbfile <- tbfile[which(is.na(tbfile[, valuecols]) != TRUE), ] - } - i <- 1 - while (sum(is.na(tbfile[, i])) != 0) { - tbfile[, i] <- rep( - unique(tbfile[which(is.na(tbfile[, i]) == FALSE), i]), - each = nrow(tbfile) / length(tbfile[which(is.na(tbfile[, i]) == FALSE), i]), - times = length(tbfile[which(is.na(tbfile[, i]) == FALSE), i]) / length(unique(tbfile[which(is.na(tbfile[, i]) == FALSE), i])) - ) - i <- i + 1 - } - if (removeTotal == TRUE) { - tbfile <- tbfile[, which(colnames(tbfile) != "Total")] - tbfile <- tbfile[which(tbfile[, 1] != "Total"), ] - } - tbfile[valuecols[which(valuecols <= ncol(tbfile))]] <- sapply(tbfile[valuecols[which(valuecols <= ncol(tbfile))]], function(x) { - as.numeric(as.character(x)) - }) - row.names(tbfile) <- NULL - } else { - colnamevals <- c(as.character(unname(unlist(tbfile[(min(which(is.na(tbfile[, ncol(tbfile)]) == FALSE)) - 1), 1:(ncol(tbfile) - 1)]))), "value") - tbfile <- tbfile[which(is.na(tbfile[, ncol(tbfile)]) == FALSE), ] - colnames(tbfile) <- colnamevals - if (removeTotal == TRUE) { - tbfile <- tbfile[apply(tbfile, 1, function(x) all(x != "Total")), ] - } - row.names(tbfile) <- NULL - tbfile$value <- as.numeric(as.character(tbfile$value)) - } - } - return(tbfile) + .Deprecated("See https://github.com/mattcowgill/readabs for reading ABS data.") } diff --git a/R/node-funs.R b/R/node-funs.R index f66e58e5..cffcda8e 100644 --- a/R/node-funs.R +++ b/R/node-funs.R @@ -1,24 +1,3 @@ -#' Add node to spatial lines object -#' -#' @inheritParams route_split -#' @param sln A spatial lines (`sfNetwork`) object created by `SpatialLinesNetwork` -#' @export -#' @examples -#' sample_routes <- routes_fast_sf[2:6, NULL] -#' sample_routes$value <- rep(1:3, length.out = 5) -#' rnet <- overline2(sample_routes, attrib = "value") -#' sln <- SpatialLinesNetwork(rnet) -#' p <- sf::st_sfc(sf::st_point(c(-1.540, 53.826)), crs = sf::st_crs(rnet)) -#' sln_nodes <- sln2points(sln) -#' sln_new <- sln_add_node(sln, p) -#' route <- route_local(sln_new, p, sln_nodes[9, ]) -#' plot(sln) -#' plot(sln_nodes, pch = as.character(1:nrow(sln_nodes)), add = TRUE) -#' plot(route$geometry, lwd = 9, add = TRUE) -sln_add_node <- function(sln, p) { - rnet_new <- rnet_add_node(sln@sl, p) - SpatialLinesNetwork(rnet_new) -} #' Extract nodes from route network #' #' @inheritParams route_split diff --git a/R/od-funs.R b/R/od-funs.R index 40d77488..93a0d3ba 100644 --- a/R/od-funs.R +++ b/R/od-funs.R @@ -5,33 +5,19 @@ #' in the form of 1 line per OD pair, with zone codes of the trip origin in the first #' column and the zone codes of the destination in the second column #' (see the [`vignette("stplanr-od")`](https://docs.ropensci.org/stplanr/articles/stplanr-od.html)) for details. -#' `od2odf()` creates an 'origin-destination data frame', based on a data frame containing -#' origin and destination cones (`flow`) that match the first column in a -#' a spatial (polygon or point) object (`zones`). +#' `od2odf()` creates an 'origin-destination data frame', with columns containing +#' origin and destination codes (`flow`) that match the first column in a +#' a spatial (polygon or point `sf`) object (`zones`). #' #' The function returns a data frame with coordinates for the origin and destination. #' @inheritParams od2line #' @family od #' @export #' @examples -#' data(flow) -#' data(zones) -#' od2odf(flow[1:2, ], zones) +#' od2odf(flow[1:2, ], zones_sf) od2odf <- function(flow, zones) { - coords <- data.frame( - code = as.character(zones[[1]]), - fx = coordinates(zones)[, 1], fy = coordinates(zones)[, 2] - ) - flowcode <- data.frame( - stringsAsFactors = FALSE, - code_o = as.character(flow[[1]]), - code_d = as.character(flow[[2]]) - ) - odf <- dplyr::left_join(flowcode, coords, by = c("code_o" = "code")) - names(coords) <- c("code", "fx", "fy") - odf <- dplyr::left_join(odf, coords, by = c("code_d" = "code")) - - data.frame(odf) # return data.frame as more compatible with spatial data + od_codes = flow[1:2] + cbind(o = flow[[1]], d = flow[[2]], od::od_coordinates(flow, zones)) } #' Create matrices representing origin-destination coordinates @@ -48,10 +34,8 @@ od2odf <- function(flow, zones) { #' @export #' @examples #' od_coords(from = c(0, 52), to = c(1, 53)) # lon/lat coordinates -#' od_coords(from = cents[1, ], to = cents[2, ]) # Spatial points #' od_coords(cents_sf[1:3, ], cents_sf[2:4, ]) # sf points #' # od_coords("Hereford", "Leeds") # geocode locations -#' 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")) { @@ -59,36 +43,34 @@ od_coords <- function(from = NULL, to = NULL, l = NULL) { } else { is_sf_line <- FALSE } - if (is_sf_line | any(grepl(pattern = "Line", x = class(from)))) { l <- from } - if (!is.null(l)) { coord_matrix <- line2df(l) %>% dplyr::select("fx", "fy", "tx", "ty") - } - - else { - # Convert sp object to lat/lon vector - if (is(object = from, "Spatial")) from <- sp::coordinates(from) - if (is(object = to, "Spatial")) to <- sp::coordinates(to) - + } else { # sf objects - if (is(object = from, "sf") | is(object = from, "sfc")) from <- sf::st_coordinates(from) - if (is(object = to, "sf") | is(object = to, "sfc")) to <- sf::st_coordinates(to) - + if (is(object = from, "sf") | is(object = from, "sfc")) { + from <- sf::st_coordinates(from) + } + if (is(object = to, "sf") | is(object = to, "sfc")) { + to <- sf::st_coordinates(to) + } # Convert character strings to lon/lat if needs be - if (is.character(from)) from <- matrix(geo_code(from), ncol = 2) - if (is.character(to)) to <- matrix(geo_code(to), ncol = 2) + if (is.character(from)) { + from <- matrix(geo_code(from), ncol = 2) + } + if (is.character(to)) { + to <- matrix(geo_code(to), ncol = 2) + } if (is.vector(from) & is.vector(to)) { coord_matrix <- matrix(c(from, to), ncol = 4) - } else { - coord_matrix <- cbind(from, to) - } + } else { + coord_matrix <- cbind(from, to) + } colnames(coord_matrix) <- c("fx", "fy", "tx", "ty") } - as.matrix(coord_matrix) } @@ -154,7 +136,7 @@ od_coords2line <- function(odc, crs = 4326, remove_duplicates = TRUE) { #' #' @param flow A data frame representing origin-destination data. #' The first two columns of this data frame should correspond -#' to the first column of the data in the zones. Thus in [cents()], +#' to the first column of the data in the zones. Thus in [cents_sf()], #' the first column is geo_code. This corresponds to the first two columns #' of [flow()]. #' @param zones A spatial object representing origins (and destinations @@ -178,14 +160,6 @@ od_coords2line <- function(odc, crs = 4326, remove_duplicates = TRUE) { #' l <- od2line(flow = od_data, zones = cents_sf) #' plot(sf::st_geometry(cents_sf)) #' plot(l, lwd = l$All / mean(l$All), add = TRUE) -#' l <- od2line(flow = od_data, zones = cents) -#' # When destinations are different -#' head(destinations[1:5]) -#' od_data2 <- flow_dests[1:12, 1:3] -#' od_data2 -#' flowlines_dests <- od2line(od_data2, cents_sf, destinations = destinations_sf) -#' flowlines_dests -#' plot(flowlines_dests) #' @name od2line NULL @@ -238,78 +212,6 @@ od2line.sf <- function(flow, zones, destinations = NULL, 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, - zone_code = names(zones)[1], - origin_code = names(flow)[1], - dest_code = names(flow)[2], - zone_code_d = NA, silent = TRUE) { - l <- vector("list", nrow(flow)) - - if (is.null(destinations)) { - if (!silent) { - message(paste( - "Matching", zone_code, "in the zones to", origin_code, "and", dest_code, - "for origins and destinations respectively" - )) - } - for (i in 1:nrow(flow)) { - from <- zones@data[[zone_code]] %in% flow[[origin_code]][i] - if (sum(from) == 0) { - warning(paste0("No match for line ", i)) - } - to <- zones@data[[zone_code]] %in% flow[[dest_code]][i] - if (sum(to) == 0 & sum(from) == 1) { - warning(paste0("No match for line ", i)) - } - x <- sp::coordinates(zones[from, ]) - y <- sp::coordinates(zones[to, ]) - l[[i]] <- sp::Lines(list(sp::Line(rbind(x, y))), as.character(i)) - } - } else { - if (is.na(zone_code_d)) { - zone_code_d <- names(destinations)[1] - } - if (!silent) { - message(paste( - "Matching", zone_code, "in the zones and", zone_code_d, "in the destinations,\nto", - origin_code, "and", dest_code, - "for origins and destinations respectively" - )) - } - for (i in 1:nrow(flow)) { - from <- zones@data[[zone_code]] %in% flow[[origin_code]][i] - if (sum(from) == 0) { - warning(paste0("No match for line ", i)) - } - to <- destinations@data[[zone_code_d]] %in% flow[[dest_code]][i] - if (sum(to) == 0 & sum(from) == 1) { - warning(paste0("No match for line ", i)) - } - x <- sp::coordinates(zones[from, ]) - y <- sp::coordinates(destinations[to, ]) - l[[i]] <- sp::Lines(list(sp::Line(rbind(x, y))), as.character(i)) - } - } - l <- sp::SpatialLines(l) - l <- sp::SpatialLinesDataFrame(l, data = flow, match.ID = FALSE) - sp::proj4string(l) <- sp::proj4string(zones) - l -} - -#' @rdname od2line -#' @export -od2line2 <- function(flow, zones) { - odf <- od2odf(flow, zones) - l <- vector("list", nrow(odf)) - for (i in 1:nrow(odf)) { - l[[i]] <- - sp::Lines(list(sp::Line(rbind( - c(odf$fx[i], odf$fy[i]), c(odf$tx[i], odf$ty[i]) - ))), as.character(i)) - } - l <- sp::SpatialLines(l) -} #' Convert geographic line objects to a data.frame with from and to coords #' @@ -320,10 +222,6 @@ od2line2 <- function(flow, zones) { #' @family lines #' @export #' @examples -#' data(flowlines) -#' line2df(flowlines[5, ]) # beginning and end of a single straight line -#' line2df(flowlines) # on multiple lines -#' line2df(routes_fast[5:6, ]) # beginning and end of routes #' line2df(routes_fast_sf[5:6, ]) # beginning and end of routes line2df <- function(l) { UseMethod("line2df") @@ -341,17 +239,6 @@ line2df.sf <- function(l) { tx = dplyr::last(!!X), ty = dplyr::last(!!Y) ) } -#' @export -line2df.Spatial <- function(l) { - ldf_geom <- raster::geom(l) - dplyr::group_by(dplyr::as_tibble(ldf_geom), object) %>% - dplyr::summarise( - fx = dplyr::first(x), - fy = dplyr::first(y), - tx = dplyr::last(x), - ty = dplyr::last(y) - ) -} #' Convert a spatial (linestring) object to points #' @@ -387,22 +274,6 @@ line2points <- function(l, ids = rep(1:nrow(l))) { UseMethod("line2points") } #' @export -line2points.Spatial <- function(l, ids = rep(1:nrow(l), each = 2)) { - for (i in 1:length(l)) { - lcoords <- sp::coordinates(l[i, ])[[1]][[1]] - pmat <- matrix(lcoords[c(1, nrow(lcoords)), ], nrow = 2) - lpoints <- sp::SpatialPoints(pmat) - if (i == 1) { - out <- lpoints - } else { - out <- raster::bind(out, lpoints) - } - } - sp::proj4string(out) <- sp::proj4string(l) - out <- sp::SpatialPointsDataFrame(coords = out, data = data.frame(id = ids)) - out -} -#' @export line2points.sf <- function(l, ids = rep(1:nrow(l), each = 2)) { y_coords <- x_coords <- double(length = length(ids)) # initiate coords coord_matrix <- cbind(x_coords, y_coords) @@ -436,13 +307,6 @@ line2pointsn <- function(l) { UseMethod("line2pointsn") } #' @export -line2pointsn.Spatial <- function(l) { - spdf <- raster::geom(l) - p <- sp::SpatialPoints(coords = spdf[, c("x", "y")]) - raster::crs(p) <- raster::crs(l) - p -} -#' @export line2pointsn.sf <- function(l) { suppressWarnings(sf::st_cast(l, "POINT")) } @@ -489,175 +353,6 @@ line2vertices.sf <- function(l) { internal_vertexes_sf } -#' Convert straight OD data (desire lines) into routes -#' -#' @section Details: -#' -#' See [route_cyclestreets()] and other route functions for details. -#' -#' A parallel implementation of this was available until version 0.1.8. -#' -#' @param l A spatial (linestring) object -#' @param route_fun A routing function to be used for converting the straight lines to routes -#' [od2line()] -#' @param n_print A number specifying how frequently progress updates -#' should be shown -#' @param list_output If FALSE (default) assumes spatial (linestring) object output. Set to TRUE to save output as a list. -#' @param l_id Character string naming the id field from the input lines data, -#' typically the origin and destination ids pasted together. If absent, the row name of the -#' straight lines will be used. -#' @param time_delay Number or seconds to wait between each query -#' @param ... Arguments passed to the routing function, e.g. [route_cyclestreets()] -#' @family routes -#' @export -#' @examples -#' \dontrun{ -#' # does not run as requires API key -#' l <- flowlines[2:5, ] -#' r <- line2route(l) -#' rq <- line2route(l = l, plan = "quietest", silent = TRUE) -#' rsc <- line2route(l = l, route_fun = cyclestreets::journey) -#' plot(r) -#' plot(r, col = "red", add = TRUE) -#' plot(rq, col = "green", add = TRUE) -#' plot(rsc) -#' plot(l, add = T) -#' # Plot for a single line to compare 'fastest' and 'quietest' route -#' n <- 2 -#' plot(l[n, ]) -#' lines(r[n, ], col = "red") -#' lines(rq[n, ], col = "green") -#' } -line2route <- - function(l, - route_fun = stplanr::route_cyclestreets, - n_print = 10, - list_output = FALSE, - l_id = NA, - time_delay = 0, - ...) { - return_sf <- is(l, "sf") - if (return_sf) { - requireNamespace("sf") - l <- sf::as_Spatial(l) - } - FUN <- match.fun(route_fun) - ldf <- line2df(l) - n_ldf <- nrow(ldf) - - error_fun <- function(e) { - warning(paste("Fail for line number", i)) - e - } - - 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 - ) - perc_temp <- i %% round(n_ldf / n_print) - # print % of distances calculated - if (!is.na(perc_temp) & perc_temp == 0) { - message(paste0(round(100 * i / n_ldf), " % out of ", n_ldf, " distances calculated")) - } - Sys.sleep(time = time_delay) - } - - 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") { - message("Output is sf") - rc_is_sf <- class_out == "sf" - rc_sf <- rc[rc_is_sf] - r_sf <- do.call(rbind, rc_sf) - return(r_sf) - } - - if (list_output) { - r <- rc - } else { - # Set the names based on the first non failing line (then exit loop) - for (i in 1:n_ldf) { - if (grepl("Spatial.*DataFrame", class(rc[[i]]))[1]) { - rdata <- data.frame(matrix(nrow = nrow(l), ncol = ncol(rc[[i]]) + 1)) - names(rdata) <- c(names(rc[[i]]), "error") - r <- l - r@data <- rdata - break - } - Sys.sleep(time = time_delay) - } - - # Copy rc into r including the data or copy the error into r - for (i in 1:n_ldf) { - if (grepl("Spatial.*DataFrame", class(rc[[i]]))[1]) { - r@lines[[i]] <- Lines(rc[[i]]@lines[[1]]@Lines, row.names(l[i, ])) - r@data[i, ] <- c(rc[[i]]@data, error = NA) - } else { - r@data[i, "error"] <- rc[[i]][1] - } - Sys.sleep(time = time_delay) - } - - # Set the id in r - l_ids <- c(l_id, "id") - l_id <- l_ids[!is.na(l_ids)][1] - r$id <- if (l_id %in% names(l)) { - l@data[[l_id]] - } else { - row.names(l) - } - } - if (return_sf) { - r <- sf::st_as_sf(r) - } - r - } - -#' Convert straight spatial (linestring) object from flow data into routes retrying -#' on connection (or other) intermittent failures -#' -#' @section Details: -#' -#' See [line2route()] for the version that is not retried on errors. -#' @param lines A spatial (linestring) object -#' @param pattern A regex that the error messages must not match to be retried, default -#' "^Error: " i.e. do not retry errors starting with "Error: " -#' @param n_retry Number of times to retry -#' @inheritParams line2route -#' @family routes -#' @export -#' @examples -#' \dontrun{ -#' data(flowlines) -#' rf_list <- line2routeRetry(flowlines[1:2, ], pattern = "nonexistanceerror", silent = F) -#' } -line2routeRetry <- function(lines, pattern = "^Error: ", n_retry = 3, ...) { - routes <- line2route(lines, reporterrors = T, ...) - - # When the time is NA then the routing failed, - # if there is no error message or the message matches the pattern select line to be retried - failed_to_route <- lines[is.na(routes$time) & (is.na(routes$error) | !grepl(pattern, routes$error)), ] - if (nrow(failed_to_route) > 0 && n_retry > 0) { - ids <- routes$ids - routes_retry <- line2routeRetry(failed_to_route, pattern = pattern, n_retry = n_retry - 1, ...) - for (idx_retry in 1:nrow(routes_retry)) { - # Merge in retried routes if they are Spatial DataFrames - if (grepl("Spatial.*DataFrame", class(routes_retry[[idx_retry]]))) { - idx_to_replace <- which(routes$id == routes_retry$id[idx_retry]) - - 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, ])) - } - } - } - routes -} - #' Convert a series of points into a dataframe of origins and destinations #' #' Takes a series of geographical points and converts them into a data.frame @@ -668,11 +363,7 @@ line2routeRetry <- function(lines, pattern = "^Error: ", n_retry = 3, ...) { #' @family od #' @export #' @examples -#' data(cents) -#' df <- points2odf(cents) -#' cents_centroids <- rgeos::gCentroid(cents, byid = TRUE) -#' df2 <- points2odf(cents_centroids) -#' df3 <- points2odf(cents_sf) +#' points2odf(cents_sf) points2odf <- function(p) { UseMethod("points2odf") } @@ -710,90 +401,22 @@ points2odf.Spatial <- function(p) { #' #' @export #' @examples -#' data(cents) -#' plot(cents) -#' flow <- points2flow(cents) -#' plot(flow, add = TRUE) -#' flow_sf <- points2flow(cents_sf) +#' flow_sf <- points2flow(cents_sf[1:4, ]) #' plot(flow_sf) points2flow <- function(p) { odf <- points2odf(p) od2line(flow = odf, zones = p) } -#' Update line geometry -#' -#' Take two SpatialLines objects and update the geometry of the former with that of the latter, -#' retaining the data of the former. -#' -#' @param l A SpatialLines object, whose geometry is to be modified -#' @param nl A SpatialLines object of the same length as `l` to provide the new geometry -#' @family lines -#' -#' @export -#' @examples -#' data(flowlines) -#' l <- flowlines[2:5, ] -#' nl <- routes_fast -#' nrow(l) -#' nrow(nl) -#' l <- l[!is_linepoint(l), ] -#' names(l) -#' names(routes_fast) -#' l_newgeom <- update_line_geometry(l, nl) -#' plot(l, lwd = l$All / mean(l$All)) -#' plot(l_newgeom, lwd = l$All / mean(l$All)) -#' names(l_newgeom) -update_line_geometry <- function(l, nl) { - for (i in 1:nrow(l)) { - l@lines[[i]] <- Lines(nl@lines[[i]]@Lines, row.names(l[i, ])) - } - l -} - -#' Quickly calculate Euclidean distances of od pairs -#' -#' It is common to want to know the Euclidean distance between origins and destinations -#' in OD data. You can calculate this by first converting OD data to SpatialLines data, -#' e.g. with [od2line()]. However this can be slow and overkill if you just -#' want to know the distance. This function is a few orders of magnitude faster. -#' -#' Note: this function assumes that the zones or centroids in `cents` have a geographic -#' (lat/lon) CRS. -#' -#' @inheritParams od2line -#' @family od -#' @export -#' @examples -#' data(flow) -#' data(cents) -#' od_dist(flow, cents) -od_dist <- function(flow, zones) { - omatch <- match(flow[[1]], zones@data[[1]]) - dmatch <- match(flow[[2]], zones@data[[1]]) - cents_o <- zones@coords[omatch, ] - cents_d <- zones@coords[dmatch, ] - geosphere::distHaversine(p1 = cents_o, p2 = cents_d) -} - #' Convert a series of points, or a matrix of coordinates, into a line #' -#' This is a simple wrapper around [spLines()] that makes the creation of -#' `SpatialLines` objects easy and intuitive +#' This function makes that makes the creation of `sf` +#' objects with LINESTRING geometries easy. #' #' @param p A spatial (points) obect or matrix representing the coordinates of points. #' @family lines #' @export #' @examples -#' p <- matrix(1:4, ncol = 2) -#' library(sp) -#' l <- points2line(p) -#' plot(l) -#' l <- points2line(cents) -#' plot(l) -#' p <- line2points(routes_fast) -#' l <- points2line(p) -#' plot(l) #' l_sf <- points2line(cents_sf) #' plot(l_sf) points2line <- function(p) { @@ -803,23 +426,6 @@ points2line <- function(p) { points2line.sf <- function(p) { points2flow(p = p) } -#' @export -points2line.Spatial <- function(p) { - if (is(p, "SpatialPoints")) { - p_proj <- sp::proj4string(p) - p <- sp::coordinates(p) - } else { - p_proj <- NA - } - l <- points2line(p) - raster::crs(l) <- p_proj - l -} -#' @export -points2line.matrix <- function(p) { - l <- raster::spLines(p) - l -} #' Summary statistics of trips originating from zones in OD data #' #' This function takes a data frame of OD data and diff --git a/R/oneway.R b/R/oneway.R index ab2aa178..4de7bbe5 100644 --- a/R/oneway.R +++ b/R/oneway.R @@ -133,7 +133,7 @@ not_duplicated <- function(x) { #' example, the true extent of travel will by heavily under-estimated for #' OD pairs which have similar amounts of travel in both directions. #' Flows in both direction are often represented by overlapping lines with -#' identical geometries (see [flowlines()]) which can be confusing +#' identical geometries which can be confusing #' for users and are difficult to plot. #' @examples #' (od_min <- od_data_sample[c(1, 2, 9), 1:6]) @@ -146,19 +146,8 @@ not_duplicated <- function(x) { #' flow_oneway <- od_oneway(flow, attrib = attrib) #' colSums(flow_oneway[attrib]) == colSums(flow[attrib]) # test if the colSums are equal #' # Demonstrate the results from oneway and onewaygeo are identical -#' flow_oneway_geo <- onewaygeo(flowlines, attrib = attrib) #' flow_oneway_sf <- od_oneway(flowlines_sf) -#' par(mfrow = c(1, 2)) -#' plot(flow_oneway_geo, lwd = flow_oneway_geo$All / mean(flow_oneway_geo$All)) #' plot(flow_oneway_sf$geometry, lwd = flow_oneway_sf$All / mean(flow_oneway_sf$All)) -#' par(mfrow = c(1, 1)) -#' od_max_min <- od_oneway(od_min, stplanr.key = od_id_character(od_min[[1]], od_min[[2]])) -#' cor(od_max_min$all, od_oneway$all) -#' # benchmark performance -#' # bench::mark(check = FALSE, iterations = 3, -#' # onewayid(flowlines_sf, attrib), -#' # od_oneway(flowlines_sf) -#' # ) od_oneway <- function(x, attrib = names(x[-c(1:2)])[vapply(x[-c(1:2)], is.numeric, TRUE)], id1 = names(x)[1], diff --git a/R/overline.R b/R/overline.R index 714d5269..f0c11cf8 100644 --- a/R/overline.R +++ b/R/overline.R @@ -10,11 +10,6 @@ #' @export #' @examples #' \dontrun{ -#' rnet <- overline(routes_fast[c(2, 3, 22), ], attrib = "length") -#' plot(rnet) -#' lines(routes_fast[22, ], col = "red") # line without overlaps -#' islines(routes_fast[2, ], routes_fast[3, ]) -#' islines(routes_fast[2, ], routes_fast[22, ]) #' # sf implementation #' islines(routes_fast_sf[2, ], routes_fast_sf[3, ]) #' islines(routes_fast_sf[2, ], routes_fast_sf[22, ]) @@ -22,10 +17,6 @@ islines <- function(g1, g2) { UseMethod("islines") } -islines.Spatial <- function(g1, g2) { - ## return TRUE if geometries intersect as lines, not points - inherits(rgeos::gIntersection(g1, g2), "SpatialLines") -} islines.sf <- function(g1, g2) { sf::st_geometry_type(sf::st_intersection(sf::st_geometry(g1), sf::st_geometry(g2))) == "MULTILINESTRING" } @@ -54,28 +45,11 @@ islines.sf <- function(g1, g2) { #' rsec <- gsection(sl, buff_dist = 50) #' length(rsec) # 4 features: issue #' plot(rsec, col = seq(length(rsec))) -#' # dont test due to issues with sp classes on some set-ups -#' # sl <- routes_fast[2:4, ] -#' # rsec <- gsection(sl) -#' # rsec_buff <- gsection(sl, buff_dist = 1) -#' # plot(sl[1], lwd = 9, col = 1:nrow(sl)) -#' # plot(rsec, col = 5 + (1:length(rsec)), add = TRUE, lwd = 3) -#' # plot(rsec_buff, col = 5 + (1:length(rsec_buff)), add = TRUE, lwd = 3) #' } gsection <- function(sl, buff_dist = 0) { UseMethod("gsection") } #' @export -gsection.Spatial <- function(sl, buff_dist = 0) { - if (buff_dist > 0) { - sl <- geo_toptail(sl, toptail_dist = buff_dist) - } - overlapping <- rgeos::gOverlaps(sl, byid = T) - u <- rgeos::gUnion(sl, sl) - u_merged <- rgeos::gLineMerge(u) - sp::disaggregate(u_merged) -} -#' @export gsection.sf <- function(sl, buff_dist = 0) { if (buff_dist > 0) { sl <- geo_toptail(sl, toptail_dist = buff_dist) @@ -87,24 +61,6 @@ gsection.sf <- function(sl, buff_dist = 0) { u_disag } -#' Label SpatialLinesDataFrame objects -#' -#' This function adds labels to lines plotted using base graphics. Largely -#' for illustrative purposes, not designed for publication-quality -#' graphics. -#' -#' @param sl A SpatialLinesDataFrame with overlapping elements -#' @param attrib A text string corresponding to a named variable in `sl` -#' -#' @author Barry Rowlingson -#' @family rnet -#' -#' @export -lineLabels <- function(sl, attrib) { - text(sp::coordinates( - rgeos::gCentroid(sl, byid = TRUE) - ), labels = sl[[attrib]]) -} #' Convert series of overlapping lines into a route network #' @@ -173,7 +129,7 @@ lineLabels <- function(sl, attrib) { #' @export #' @examples #' sl <- routes_fast_sf[2:4, ] -#' sl$All <- flowlines$All[2:4] +#' sl$All <- flowlines_sf$All[2:4] #' rnet <- overline(sl = sl, attrib = "All") #' nrow(sl) #' nrow(rnet) @@ -186,12 +142,6 @@ lineLabels <- function(sl, attrib) { #' plot(rnet_sf_raw) #' rnet_sf_raw$n <- 1:nrow(rnet_sf_raw) #' plot(rnet_sf_raw[10:25, ]) -#' # legacy implementation based on sp data -#' # sl <- routes_fast[2:4, ] -#' # rnet1 <- overline(sl = sl, attrib = "length") -#' # rnet2 <- overline(sl = sl, attrib = "length", buff_dist = 1) -#' # plot(rnet1, lwd = rnet1$length / mean(rnet1$length)) -#' # plot(rnet2, lwd = rnet2$length / mean(rnet2$length)) overline <- function(sl, attrib, ncores = 1, @@ -408,73 +358,7 @@ overline2 <- } #' @export overline.sf <- overline2 -#' @export -overline.Spatial <- function(sl, ...) { - overline_spatial(sl, ...) -} - -#' Spatial aggregation of routes represented with sp classes -#' -#' This function, largely superseded by sf implementations, still works -#' but is not particularly fast. -#' -#' @param na.zero Sets whether aggregated values with a value of zero are -#' removed. -#' @inheritParams gsection -#' @inheritParams overline -#' @family rnet -#' @export -overline_spatial <- function(sl, attrib, fun = sum, na.zero = FALSE, buff_dist = 0) { - fun <- c(fun) - if (length(fun) < length(attrib)) { - fun <- rep(c(fun), length.out = length(attrib)) - } - sl_sp <- as(sl, "SpatialLines") - - ## get the line sections that make the network - slu <- gsection(sl, buff_dist = buff_dist) - ## overlay network with routes - overs <- sp::over(slu, sl_sp, returnList = TRUE) - ## overlay is true if end points overlay, so filter them out: - overs <- lapply(1:length(overs), function(islu) { - Filter(function(isl) { - islines(sl_sp[isl, ], slu[islu, ]) - }, overs[[islu]]) - }) - ## now aggregate the required attribibute using fun(): - # aggs = sapply(overs, function(os){fun(sl[[attrib]][os])}) - aggs <- setNames( - as.data.frame( - lapply( - 1:length(attrib), - function(y, overs, attribs, aggfuns) { - sapply(overs, function(os, attrib, fun2) { - fun2(sl[[attrib]][os]) - }, - attrib = attribs[y], - fun2 = aggfuns[[y]] - ) - }, - overs, - attrib, - fun - ) - ), - attrib - ) - - ## make a sl with the named attribibute: - sl <- sp::SpatialLinesDataFrame(slu, aggs) - # names(sl) = attrib - - ## remove lines with attribute values of zero - if (na.zero) { - sl <- sl[sl[[attrib]] > 0, ] - } - - sl -} #' Aggregate flows so they become non-directional (by geometry - the slow way) #' @@ -484,9 +368,6 @@ overline_spatial <- function(sl, attrib, fun = sum, na.zero = FALSE, buff_dist = #' If only the largest flow in either direction is captured in an analysis, for #' example, the true extent of travel will by heavily under-estimated for #' OD pairs which have similar amounts of travel in both directions. -#' Flows in both direction are often represented by overlapping lines with -#' identical geometries (see [flowlines()]) which can be confusing -#' for users and are difficult to plot. #' #' This function aggregates directional flows into non-directional flows, #' potentially halving the number of lines objects and reducing the number @@ -501,20 +382,6 @@ overline_spatial <- function(sl, attrib, fun = sum, na.zero = FALSE, buff_dist = #' with a distance (i.e. not intra-zone flows) are included #' @family lines #' @export -#' @examples -#' plot(flowlines[1:30, ], lwd = flowlines$On.foot[1:30]) -#' singlines <- onewaygeo(flowlines[1:30, ], attrib = which(names(flowlines) == "On.foot")) -#' plot(singlines, lwd = singlines$On.foot / 2, col = "red", add = TRUE) -#' \dontrun{ -#' plot(flowlines, lwd = flowlines$All / 10) -#' singlelines <- onewaygeo(flowlines, attrib = 3:14) -#' plot(singlelines, lwd = singlelines$All / 20, col = "red", add = TRUE) -#' sum(singlelines$All) == sum(flowlines$All) -#' nrow(singlelines) -#' singlelines_sf <- onewaygeo(flowlines_sf, attrib = 3:14) -#' sum(singlelines_sf$All) == sum(flowlines_sf$All) -#' summary(singlelines$All == singlelines_sf$All) -#' } onewaygeo <- function(x, attrib) { UseMethod("onewaygeo") } @@ -528,33 +395,6 @@ onewaygeo.sf <- function(x, attrib) { return(singlelines) } -#' @export -onewaygeo.Spatial <- function(x, attrib) { - geq <- rgeos::gEquals(x, x, byid = TRUE) | rgeos::gEqualsExact(x, x, byid = TRUE) - sel1 <- !duplicated(geq) # repeated rows - singlelines <- x[sel1, ] - non_numeric_cols <- which(!sapply(x@data, is.numeric)) - keeper_cols <- sort(unique(c(non_numeric_cols, attrib))) - - singlelines@data[, attrib] <- (matrix( - unlist( - lapply( - apply(geq, 1, function(x) { - which(x == TRUE) - }), - function(y, x) { - colSums(x[y, attrib]@data) - }, x - ) - ), - nrow = nrow(x), - byrow = TRUE - ))[sel1, ] - - singlelines@data <- singlelines@data[keeper_cols] - - return(singlelines) -} #' Convert series of overlapping lines into a route network #' @@ -564,7 +404,6 @@ onewaygeo.Spatial <- function(x, attrib) { #' #' @param sl An `sf` `LINESTRING` object with overlapping elements #' @inheritParams overline -#' @inheritParams overline_spatial #' @export #' @examples #' routes_fast_sf$value <- 1 diff --git a/R/quadrants.R b/R/quadrants.R index 25e3c5ab..dc092c94 100644 --- a/R/quadrants.R +++ b/R/quadrants.R @@ -1,39 +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) +#' @param x Object of class sf +#' @param cent The centrepoint of the region of interest. +#' Quadrants will be defined based on this point. +#' By default this will be the geographic centroid of the zones. +#' @param number_out Should the result be returned as a number? #' @family geo #' #' @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)) +#' x = zones_sf +#' (quads <- quadrant(x)) +#' plot(x$geometry, col = factor(quads)) +quadrant <- function(x, cent = NULL, number_out = FALSE) { + if(is.null(cent)) { + cent = sf::st_centroid(sf::st_union(x)) + } + ccords = sf::st_coordinates(cent) + x_cents <- sf::st_centroid(x) + coords = sf::st_coordinates(x_cents) + in_quadrant <- rep(NA, nrow(x)) 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 + in_quadrant[coords[, 1] > ccords[, 1] & coords[, 2] > ccords[, 2]] <- 1 + in_quadrant[coords[, 1] > ccords[, 1] & coords[, 2] < ccords[, 2]] <- 2 + in_quadrant[coords[, 1] < ccords[, 1] & coords[, 2] > ccords[, 2]] <- 3 + in_quadrant[coords[, 1] < ccords[, 1] & coords[, 2] < ccords[, 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[coords[, 1] > ccords[, 1] & coords[, 2] > ccords[, 2]] <- "NE" + in_quadrant[coords[, 1] > ccords[, 1] & coords[, 2] < ccords[, 2]] <- "SE" + in_quadrant[coords[, 1] < ccords[, 1] & coords[, 2] > ccords[, 2]] <- "SW" + in_quadrant[coords[, 1] < ccords[, 1] & coords[, 2] < ccords[, 2]] <- "NW" } in_quadrant } diff --git a/R/rnet-clean.R b/R/rnet-clean.R index 44a05584..fdce63a5 100644 --- a/R/rnet-clean.R +++ b/R/rnet-clean.R @@ -5,7 +5,7 @@ utils::globalVariables(c("linestring_id", "new_linestring_id")) #' Break up an sf object with LINESTRING geometry. #' #' This function breaks up a LINESTRING geometry into multiple LINESTRING(s). It -#' is used mainly for preserving routability of an `sfNetwork` object that is +#' is used mainly for preserving routability of an object that is #' created using Open Street Map data. See details, #' [stplanr/issues/282](https://github.com/ropensci/stplanr/issues/282), and #' [stplanr/issues/416](https://github.com/ropensci/stplanr/issues/416). @@ -18,13 +18,13 @@ utils::globalVariables(c("linestring_id", "new_linestring_id")) #' LINESTRING (see the rnet_cycleway_intersection example). #' #' The problem with the first example is that, according to algorithm behind -#' [SpatialLinesNetwork()], two LINESTRINGS are connected if and only if they +#' `SpatialLinesNetwork()`, two LINESTRINGS are connected if and only if they #' share at least one point in their boundaries. The roads and the roundabout #' are clearly connected in the "real" world but the corresponding LINESTRING #' objects do not share two distinct boundary points. In fact, by Open Street #' Map standards, a roundabout is represented as a closed and circular #' LINESTRING, and this implies that the roundabout is not connected to the -#' other roads according to [SpatialLinesNetwork()] definition. By the same +#' other roads according to `SpatialLinesNetwork()` definition. By the same #' reasoning, the roads in the second example are clearly connected in the #' "real" world, but they do not share any point in their boundaries. This #' function is used to solve this type of problem. diff --git a/R/rnet_group.R b/R/rnet_group.R index 2fe1ba89..3192e422 100644 --- a/R/rnet_group.R +++ b/R/rnet_group.R @@ -36,13 +36,7 @@ #' plot(rnet["group_louvain"]) #' rnet$group_fast_greedy <- rnet_group(rnet, igraph::cluster_fast_greedy) #' plot(rnet["group_fast_greedy"]) -#' -#' # show sfNetwork implementation -#' sfn <- SpatialLinesNetwork(rnet) -#' sfn <- rnet_group(sfn) -#' plot(sfn@sl["rnet_group"]) #' @export -#' rnet_group <- function(rnet, ...) { UseMethod("rnet_group") } @@ -108,40 +102,3 @@ rnet_group.sf <- function( ... ) } - -#' @name rnet_group -#' @export -rnet_group.sfNetwork <- function( - rnet, - cluster_fun = igraph::clusters, - ... -) { - - if (requireNamespace("igraph", quietly = TRUE)) { - - # 1. Derive the dual graph of the input rnet object - rnet_graph_dual <- igraph::make_line_graph(methods::slot(rnet, "g")) - - # 2. Apply the cluster_fun - wc <- cluster_fun(rnet_graph_dual) - - # 3. Derive the membership - m <- igraph::membership(wc) - - # 4. Add the new column - if ("rnet_group" %in% colnames(methods::slot(rnet, "sl"))) { - warning( - "The rnet_group column will be overwritten.", - call. = FALSE, - immediate. = TRUE - ) - } - methods::slot(rnet, "sl")[["rnet_group"]] <- as.integer(m) - - # Return - return(rnet) - } else { - message("You must install igraph for this function to work") - } - -} \ No newline at end of file diff --git a/R/route-transport-api.R b/R/route-transport-api.R deleted file mode 100644 index 500db670..00000000 --- a/R/route-transport-api.R +++ /dev/null @@ -1,115 +0,0 @@ -#' Plan a single route with TransportAPI.com -#' -#' Provides an R interface to the TransportAPI.com public transport API. -#' The function returns a SpatialLinesDataFrame object representing the -#' public route. -#' Currently only works for the United Kingdom. -#' See for more information. -#' -#' @param from Text string or coordinates (a numeric vector of -#' `length = 2` representing latitude and longitude) representing a point -#' on Earth. -#' -#' @param to Text string or coordinates (a numeric vector of -#' `length = 2` representing latitude and longitude) representing a point -#' on Earth. This represents the destination of the trip. -#' -#' @param silent Logical (default is FALSE). TRUE hides request sent. -#' @param region String for the active region to use for journey plans. -#' Possible values are 'southeast' (default) or 'tfl'. -#' @param modes Vector of character strings containing modes to use. Default is -#' to use all modes. -#' @param not_modes Vector of character strings containing modes not to use. -#' Not used if `modes` is set. -#' -#' @details -#' -#' This function uses the online routing service -#' TransportAPI.com to find public routes -#' between origins and destinations. It does not require -#' any key to access the API. -#' -#' Note that if `from` and `to` are supplied as -#' character strings (instead of lon/lat pairs), Google's -#' geo-coding services are used via `geo_code`. -#' -#' Note: there is now a dedicated transportAPI package: -#' https://github.com/ITSLeeds/transportAPI -#' -#' @family routes -#' @export -#' @seealso line2route -#' @examples -#' -#' \dontrun{ -#' # Plan the 'public' route from Hereford to Leeds -#' rqh <- route_transportapi_public(from = "Hereford", to = "Leeds") -#' plot(rq_hfd) -#' } -#' -#' # Aim plan public transport routes with transportAPI -route_transportapi_public <- function(from, to, silent = FALSE, - region = "southeast", modes = NA, not_modes = NA) { - - # Convert sp object to lat/lon vector - if (is(from, "SpatialPoints") | is(from, "SpatialPointsDataFrame")) { - from <- coordinates(from) - } - if (is(to, "SpatialPoints") | is(to, "SpatialPointsDataFrame")) { - to <- coordinates(to) - } - - # Convert character strings to lon/lat if needs be - if (is.character(from)) { - from <- geo_code(from) - } - if (is.character(to)) { - to <- geo_code(to) - } - - orig <- paste0(from, collapse = ",") - dest <- paste0(to, collapse = ",") - - api_base <- "https://fcc.transportapi.com" - ft_string <- paste0("/from/lonlat:", orig, "/to/lonlat:", dest) - - queryattrs <- list(region = region) - if (is.na(modes) == FALSE) { - queryattrs[["modes"]] <- paste0(modes, collapse = "-") - } else { - if (is.na(not_modes) == FALSE) { - queryattrs[["not_modes"]] <- paste0(not_modes, collapse = "-") - } - } - - httrreq <- httr::GET( - url = api_base, - path = paste0("/v3/uk/public/journey", ft_string, ".json"), - query = queryattrs - ) - - if (silent == FALSE) { - print(paste0("The request sent to transportapi was: ", httrreq$request$url)) - } - - if (grepl("application/json", httrreq$headers$`content-type`) == FALSE & - grepl("js", httrreq$headers$`content-type`) == FALSE) { - stop("Error: Transportapi did not return a valid result") - } - - txt <- httr::content(httrreq, as = "text", encoding = "UTF-8") - - if (txt == "") { - stop("Error: Transportapi did not return a valid result") - } - - obj <- jsonlite::fromJSON(txt) - - coords <- obj$routes$route_parts[[1]]$coordinates - coords <- do.call(rbind, coords) - route <- sp::SpatialLines(list(sp::Lines(list(sp::Line(coords)), ID = 1))) - proj4string(route) <- sp::CRS("+init=epsg:4326") - - # for the future: add summary data on the route - route -} diff --git a/R/route.R b/R/route.R index 9a3cd846..d9a2a885 100644 --- a/R/route.R +++ b/R/route.R @@ -5,45 +5,21 @@ #' The definition of optimal depends on the routing function used #' #' @inheritParams od_coords -#' @inheritParams line2route +#' @param l A spatial (linestring) object +#' @param route_fun A routing function to be used for converting the lines to routes +#' @param n_print A number specifying how frequently progress updates +#' should be shown +#' @param list_output If FALSE (default) assumes spatial (linestring) object output. +#' Set to TRUE to save output as a list. +#' @param ... Arguments passed to the routing function +#' @family routes #' @param cl Cluster #' @param wait How long to wait between routes? #' 0 seconds by default, can be useful when sending requests to rate limited APIs. #' @family routes #' @export #' @examples -#' library(sf) -#' l = od_data_lines[2, ] -#' \donttest{ -#' if(curl::has_internet()) { -#' r_walk = route(l = l, route_fun = route_osrm, osrm.profile = "foot") -#' r_bike = route(l = l, route_fun = route_osrm, osrm.profile = "bike") -#' plot(r_walk$geometry) -#' plot(r_bike$geometry, col = "blue", add = TRUE) -#' # r_bc = route(l = l, route_fun = route_bikecitizens) -#' # plot(r_bc) -#' # route(l = l, route_fun = route_bikecitizens, wait = 1) -#' library(osrm) -#' r_osrm <- route( -#' l = l, -#' route_fun = osrmRoute, -#' returnclass = "sf" -#' ) -#' nrow(r_osrm) -#' plot(r_osrm) -#' sln <- stplanr::SpatialLinesNetwork(route_network_sf) -#' # calculate shortest paths -#' plot(sln) -#' plot(l$geometry, add = TRUE) -#' r_local <- stplanr::route( -#' l = l, -#' route_fun = stplanr::route_local, -#' sln = sln -#' ) -#' plot(r_local["all"], add = TRUE, lwd = 5) -#' -#' } -#' } +#' # Todo: add examples route <- function(from = NULL, to = NULL, l = NULL, route_fun = cyclestreets::journey, wait = 0, n_print = 10, list_output = FALSE, cl = NULL, ...) { @@ -181,65 +157,6 @@ most_common_class_of_list <- function(l, class_to_find = "sf") { is_class <- class_out == class_to_find is_class } -#' @export -route.Spatial <- function(from = NULL, to = NULL, l = NULL, - route_fun = cyclestreets::journey, wait = 0, - n_print = 10, list_output = FALSE, cl = NULL, ...) { - - # error msg in case routing fails - error_fun <- function(e) { - warning(paste("Fail for line number", i)) - e - } - FUN <- match.fun(route_fun) - # generate od coordinates - ldf <- dplyr::as_tibble(od_coords(from, to, l)) - # calculate line data frame - if (is.null(l)) { - l <- od2line(ldf) - } - - # pre-allocate objects - rc <- as.list(rep(NA, nrow(ldf))) - rg <- sf::st_sfc(lapply(1:nrow(ldf), function(x) { - sf::st_linestring(matrix(as.numeric(NA), ncol = 2)) - })) - - rc[[1]] <- FUN(from = c(ldf$fx[1], ldf$fy[1]), to = c(ldf$tx[1], ldf$ty[1]), ...) - rdf <- dplyr::as_tibble(matrix(ncol = ncol(rc[[1]]@data), nrow = nrow(ldf))) - names(rdf) <- names(rc[[1]]) - - rdf[1, ] <- rc[[1]]@data[1, ] - rg[1] <- sf::st_as_sfc(rc[[1]]) - - if (nrow(ldf) > 1) { - for (i in 2:nrow(ldf)) { - 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(nrow(ldf) / n_print) - # print % of distances calculated - if (!is.na(perc_temp) & perc_temp == 0) { - message(paste0(round(100 * i / nrow(ldf)), " % out of ", nrow(ldf), " distances calculated")) - } - - rdf[i, ] <- rc[[i]]@data[1, ] - rg[i] <- sf::st_as_sf(rc[[i]])$geometry - } - } - - r <- sf::st_sf(geometry = rg, rdf) - - if (list_output) { - r <- rc - } - - r -} - #' Route on local data using the dodgr package #' #' @inheritParams route diff --git a/R/route_cyclestreets.R b/R/route_cyclestreets.R deleted file mode 100644 index f0308e4c..00000000 --- a/R/route_cyclestreets.R +++ /dev/null @@ -1,221 +0,0 @@ -#' Plan a single route with CycleStreets.net -#' -#' Provides an R interface to the CycleStreets.net cycle planning API, -#' a route planner made by cyclists for cyclists. -#' The function returns a SpatialLinesDataFrame object representing the -#' an estimate of the fastest, quietest or most balance route. -#' Currently only works for the United Kingdom and part of continental Europe, -#' though other areas may be requested by contacting CycleStreets. -#' See for more information. -#' -#' @param from Text string or coordinates (a numeric vector of -#' `length = 2` representing latitude and longitude) representing a point -#' on Earth. -#' -#' @param to Text string or coordinates (a numeric vector of -#' `length = 2` representing latitude and longitude) representing a point -#' on Earth. This represents the destination of the trip. -#' -#' @param plan Text strong of either "fastest" (default), "quietest" or "balanced" -#' @param silent Logical (default is FALSE). TRUE hides request sent. -#' @param pat The API key used. By default this is set to NULL and -#' this is usually aquired automatically through a helper, api_pat(). -#' -#' @details -#' -#' This function uses the online routing service -#' CycleStreets.net to find routes suitable for cyclists -#' between origins and destinations. Requires an -#' internet connection, a CycleStreets.net API key -#' and origins and destinations within the UK (and various areas beyond) to run. -#' -#' Note that if `from` and `to` are supplied as -#' character strings (instead of lon/lat pairs), Google's -#' geo-coding services are used via `geo_code()`. -#' -#' You need to have an api key for this code to run. -#' Loading a locally saved copy of the api key text string -#' before running the function, for example, will ensure it -#' is available on any computer: -#' -#' ` -#' mytoken <- readLines("~/Dropbox/dotfiles/cyclestreets-api-key-rl") -#' Sys.setenv(CYCLESTREETS = mytoken) -#' ` -#' -#' if you want the API key to be available in future -#' sessions, set it using the .Renviron file -#' with `usethis::edit_r_environ()` -#' -#' Read more about the .Renviron here: `?.Renviron` -#' -#' @param base_url The base url from which to construct API requests -#' (with default set to main server) -#' @param reporterrors Boolean value (TRUE/FALSE) indicating if cyclestreets (TRUE by default). -#' should report errors (FALSE by default). -#' @param save_raw Boolean value which returns raw list from the json if TRUE (FALSE by default). -#' @export -#' @seealso line2route -#' @examples -#' -#' \dontrun{ -#' from <- c(-1.55, 53.80) # geo_code("leeds") -#' to <- c(-1.76, 53.80) # geo_code("bradford uk") -#' json_output <- route_cyclestreets(from = from, to = to, plan = "quietest", save_raw = TRUE) -#' str(json_output) # what does cyclestreets give you? -#' rf_lb <- route_cyclestreets(from, to, plan = "fastest") -#' rf_lb@data -#' plot(rf_lb) -#' (rf_lb$length / (1000 * 1.61)) / # distance in miles -#' (rf_lb$time / (60 * 60)) # time in hours - average speed here: ~8mph -#' } -#' -route_cyclestreets <- function(from, to, plan = "fastest", silent = TRUE, pat = NULL, - base_url = "https://www.cyclestreets.net", reporterrors = TRUE, - save_raw = "FALSE") { - - # Convert sp object to lat/lon vector - if (is(from, "SpatialPoints") | is(from, "SpatialPointsDataFrame")) { - from <- coordinates(from) - } - if (is(to, "SpatialPoints") | is(to, "SpatialPointsDataFrame")) { - to <- coordinates(to) - } - - - # Convert character strings to lon/lat if needs be - if (is.character(from)) { - from <- geo_code(from) - } - if (is.character(to)) { - to <- geo_code(to) - } - - orig <- paste0(from, collapse = ",") - dest <- paste0(to, collapse = ",") - ft_string <- paste(orig, dest, sep = "|") - - if (is.null(pat)) { - pat <- api_pat("cyclestreet") - } - - httrmsg <- httr::modify_url( - base_url, - path = "api/journey.json", - query = list( - key = pat, - itinerarypoints = ft_string, - plan = plan, - reporterrors = ifelse(reporterrors == TRUE, 1, 0) - ) - ) - - if (silent == FALSE) { - print(paste0("The request sent to cyclestreets.net was: ", httrmsg)) - } - - httrreq <- httr::GET(httrmsg) - - if (grepl("application/json", httrreq$headers$`content-type`) == FALSE) { - stop("Error: CycleStreets did not return a valid result") - } - - txt <- httr::content(httrreq, as = "text", encoding = "UTF-8") - if (txt == "") { - stop("Error: CycleStreets did not return a valid result") - } - - obj <- jsonlite::fromJSON(txt, simplifyDataFrame = TRUE) - - if (is.element("error", names(obj))) { - stop(paste0("Error: ", obj$error)) - } - - if (save_raw) { - return((obj)) - } else { - # obj$marker$`@attributes`$elevations - # obj$marker$`@attributes`$points - coords <- obj$marker$`@attributes`$coordinates[1] - coords <- stringr::str_split(coords, pattern = " |,")[[1]] - coords <- matrix(as.numeric(coords), ncol = 2, byrow = TRUE) - - route <- sp::SpatialLines(list(sp::Lines(list(sp::Line(coords)), ID = 1))) - h <- obj$marker$`@attributes`$elevations # hilliness - h <- stringr::str_split(h[[1]], pattern = ",") # only take first set of data - h <- as.numeric(unlist(h)[-1]) - hdif <- diff(h) - htot <- sum(abs(hdif)) - hchng <- h[length(h)] - h[1] - hmxmn <- max(h) - min(h) - hup <- sum(hdif[which(hdif > 0)]) - hdown <- -1 * sum(hdif[which(hdif < 0)]) - - # busyness overall - bseg <- obj$marker$`@attributes`$busynance - bseg <- stringr::str_split(bseg, pattern = ",") - bseg <- as.numeric(unlist(bseg)[-1]) - bseg <- sum(bseg) - - df <- data.frame( - plan = obj$marker$`@attributes`$plan[1], - start = obj$marker$`@attributes`$start[1], - finish = obj$marker$`@attributes`$finish[1], - length = as.numeric(obj$marker$`@attributes`$length[1]), - time = as.numeric(obj$marker$`@attributes`$time[1]), - waypoint = nrow(coords), - cum_hill = htot, # total up and down - change_elev = hchng, # diff between start and end - dif_max_min = hmxmn, # diff between highest and lowest - up_tot = hup, # total climbing - down_tot = hdown, # total descending - av_incline = htot / as.numeric(obj$marker$`@attributes`$length[1]), - co2_saving = as.numeric(obj$marker$`@attributes`$grammesCO2saved[1]), - calories = as.numeric(obj$marker$`@attributes`$calories[1]), - busyness = bseg - ) - - row.names(df) <- route@lines[[1]]@ID - route <- sp::SpatialLinesDataFrame(route, df) - sp::proj4string(route) <- sp::CRS("+init=epsg:4326") - route - } -} - -#' Retrieve personal access token. -#' -#' @param api_name Text string of the name of the API you are calling, e.g. -#' cyclestreets, graphhopper etc. -#' -#' @keywords internal -#' @export -#' @examples -#' \dontrun{ -#' api_pat(api_name = "cyclestreet") -#' } -api_pat <- function(api_name, force = FALSE) { - api_name_caps <- toupper(api_name) - env <- Sys.getenv(api_name_caps) - if (!identical(env, "") && !force) { - return(env) - } - - if (!interactive()) { - stop(paste0("Set the environment variable ", api_name_caps, " e.g. with .Renviron or Sys.setenv()"), - call. = FALSE - ) - } - - message("Couldn't find the environment variable ", api_name_caps, ". See documentation, e.g. ?route_cyclestreets, for more details.") - message("Please enter your API key to access the ", api_name, "and press enter:") - pat <- readline(": ") - - if (identical(pat, "")) { - stop("Personal access token entry failed", call. = FALSE) - } - - message("Updating ", api_name_caps, " environment variable. Save this to .Renviron for future use.") - Sys.setenv(api_name_caps = pat) - - pat -} diff --git a/R/route_local.R b/R/route_local.R index 03a95780..6af560a1 100644 --- a/R/route_local.R +++ b/R/route_local.R @@ -1,40 +1,8 @@ -#' Plan a route with local data -#' -#' This function returns the shortest path between locations -#' in, or near to, segements on a `SpatialLinesNetwork`. -#' -#' @param ... Arguments to pass to `sum_network_links` -#' @inheritParams od_coords -#' @inheritParams sum_network_routes -#' @family routes -#' @export -#' @examples -#' from <- c(-1.535181, 53.82534) -#' to <- c(-1.52446, 53.80949) -#' sln <- SpatialLinesNetwork(route_network_sf) -#' r <- route_local(sln, from, to) -#' plot(sln) -#' plot(r$geometry, add = TRUE, col = "red", lwd = 5) -#' plot(cents[c(3, 4), ], add = TRUE) -#' r2 <- route_local(sln = sln, cents_sf[3, ], cents_sf[4, ]) -#' plot(r2$geometry, add = TRUE, col = "blue", lwd = 3) -#' l <- flowlines_sf[3:5, ] -#' r3 <- route_local(l = l, sln = sln) -#' plot(r2$geometry, add = TRUE, col = "blue", lwd = 3) -route_local <- function(sln, from, to, l = NULL, ...) { - if(is.null(l)) { - coords <- od_coords(from, to) - } else { - coords <- od_coords(l) - } - # from_sln <- find_network_nodes(sln, coords[1, "fx"], coords[1, "fy"]) - # to_sln <- find_network_nodes(sln, coords[1, "tx"], coords[1, "ty"]) - nodes_near <- find_network_nodes( - sln = sln, x = as.vector(coords[, c(1, 3)]), - y = as.vector(coords[, c(2, 4)]), maxdist = 2000 - ) - nodes_matrix <- matrix(nodes_near, ncol = 2) - od_df <- data.frame(start = nodes_matrix[, 1], end = nodes_matrix[, 2]) - # sum_network_routes(sln, start = nodes_matrix[, 1], end = nodes_matrix[, 2], ...) - sum_network_links(sln, routedata = od_df, ...) -} +# TODO: implement with sfnetworks +# route_local <- function(sln, from, to, l = NULL, ...) { +# if(is.null(l)) { +# coords <- od_coords(from, to) +# } else { +# coords <- od_coords(l) +# } +# } diff --git a/R/route_osrm.R b/R/route_osrm.R index 0984e04e..a96d6c3f 100644 --- a/R/route_osrm.R +++ b/R/route_osrm.R @@ -16,18 +16,19 @@ #' @export #' @examples #' \donttest{ -#' l1 = od_data_lines[49, ] -#' l1m = od_coords(l1) -#' from = l1m[, 1:2] -#' to = l1m[, 3:4] -#' if(curl::has_internet()) { -#' r_foot = route_osrm(from, to) -#' r_bike = route_osrm(from, to, osrm.profile = "bike") -#' r_car = route_osrm(from, to, osrm.profile = "car") -#' plot(r_foot$geometry, lwd = 9, col = "grey") -#' plot(r_bike, col = "blue", add = TRUE) -#' plot(r_car, col = "red", add = TRUE) -#' } +#' # Examples no longer working due to API being down +#' # l1 = od_data_lines[49, ] +#' # l1m = od_coords(l1) +#' # from = l1m[, 1:2] +#' # to = l1m[, 3:4] +#' # if(curl::has_internet()) { +#' # r_foot = route_osrm(from, to) +#' # r_bike = route_osrm(from, to, osrm.profile = "bike") +#' # r_car = route_osrm(from, to, osrm.profile = "car") +#' # plot(r_foot$geometry, lwd = 9, col = "grey") +#' # plot(r_bike, col = "blue", add = TRUE) +#' # plot(r_car, col = "red", add = TRUE) +#' # } #' } route_osrm <- function(from, to, osrm.server = "https://routing.openstreetmap.de/", osrm.profile = "foot"){ diff --git a/R/stplanr-package.R b/R/stplanr-package.R index be69461e..a3ea34ce 100644 --- a/R/stplanr-package.R +++ b/R/stplanr-package.R @@ -10,28 +10,16 @@ #' and analyse data for transportation research, including origin-destination analysis, #' route allocation and modelling travel patterns. #' -#' @section Interesting functions: -#' \itemize{ -#' \item [overline()] - Aggregate overlaying route lines and data intelligently -#' \item [calc_catchment()] - Create a 'catchment area' to show the areas serving a destination -#' \item [route_cyclestreets()] - Finds the fastest routes for cyclists between two places. -#' } #' #' @import curl -#' @importFrom sp bbox plot spTransform Lines SpatialLines spChFIDs proj4string proj4string<- CRS coordinates -#' @importFrom rgeos gBuffer gLength gIntersects gIntersection gArea gSimplify #' @importFrom graphics text #' @importFrom methods as slot #' @importFrom stats setNames #' @importFrom utils read.csv -#' @importFrom raster extent crop -#' @importFrom geosphere distHaversine #' @importFrom Rcpp evalCpp #' @importFrom methods is new #' @importFrom utils download.file tail unzip -#' @importFrom maptools SpatialLinesMidPoints #' @importFrom rlang .data #' @importFrom dplyr first last n -#' @useDynLib stplanr NULL utils::globalVariables(c(".", "n", ".inc", "object", "x", "y", "stplanr_start", "stplanr_end", "stplanr_linkid")) diff --git a/R/toptail.R b/R/toptail.R index df438128..810d6e1b 100644 --- a/R/toptail.R +++ b/R/toptail.R @@ -3,15 +3,16 @@ #' Takes lines and removes the start and end point, to a distance determined #' by the user. #' -#' Note: [toptailgs()] is around 10 times faster, but only works -#' on data with geographic CRS's due to its reliance on the geosphere +#' Note: see the function +#' [`toptailgs()`](https://github.com/ropensci/stplanr/blob/master/R/toptail.R#L121) +#' in {stplanr} v0.8.5 for an implementation that uses the geosphere #' package. #' -#' @param l A SpatialLines object +#' @param l An `sf` object representing lines #' @param toptail_dist The distance (in metres) to top and tail the line by. #' Can either be a single value or a vector of the same length as the #' SpatialLines object. -#' @param ... Arguments passed to rgeos::gBuffer() +#' @param ... Arguments passed to `sf::st_buffer()` #' @aliases toptail #' @family lines #' @export @@ -20,7 +21,6 @@ #' lib_versions #' # dont test due to issues with sp classes on some set-ups #' if (lib_versions[3] >= "6.3.1") { -#' # l <- routes_fast[2:4, ] # to run with sp classes #' l <- routes_fast_sf[2:4, ] #' l_top_tail <- geo_toptail(l, 300) #' l_top_tail @@ -28,48 +28,6 @@ #' plot(sf::st_geometry(geo_toptail(l, 600)), lwd = 9, add = TRUE) #' } geo_toptail <- function(l, toptail_dist, ...) { - UseMethod("geo_toptail") -} -#' @export -geo_toptail.Spatial <- toptail <- function(l, toptail_dist, ...) { - if (length(toptail_dist) > 1 & length(toptail_dist) != length(l)) { - stop("toptail_dist is vector but not of equal length to spatial object") - } - - lpoints <- line2points(l) - - if (length(toptail_dist) == 1) { - toptail_dist <- rep(toptail_dist, length(l)) - } - - for (i in 1:length(l)) { - sel_points <- lpoints[lpoints$id == i, ] - - # Create buffer for geographic or projected crs - if (!sp::is.projected(l)) { - sel <- geo_buffer(lpoints, width = toptail_dist[i], ..., silent = TRUE) - } else { - sel <- rgeos::gBuffer(lpoints, dist = toptail_dist[i], ...) - } - - if (rgeos::gContainsProperly(sel, l[i, ])) { - message(paste0( - "Line ", i, " is completely removed by the clip and", - " is omitted from the results" - )) - next - } - l2 <- rgeos::gDifference(l[i, ], sel) - if (!exists("out")) { - out <- l2 - } else { - out <- raster::bind(out, l2) - } - } - out -} -#' @export -geo_toptail.sf <- function(l, toptail_dist, ...) { suppressMessages(suppressWarnings({ line_list <- lapply( seq(nrow(l)), @@ -79,7 +37,7 @@ geo_toptail.sf <- function(l, toptail_dist, ...) { lwgeom::st_startpoint(li), lwgeom::st_endpoint(li) ) - sel <- geo_buffer(shp = sel_points, dist = toptail_dist, nQuadSegs = 5) + sel <- geo_buffer(shp = sel_points, dist = toptail_dist, nQuadSegs = 5, ...) if (any(sf::st_contains_properly(sel, li, sparse = FALSE))) { message( "Line ", i, " is completely removed by the clip and", @@ -96,87 +54,14 @@ geo_toptail.sf <- function(l, toptail_dist, ...) { # sf::st_sf(out) out } -#' Clip the first and last n metres of SpatialLines -#' -#' Takes lines and removes the start and end point, to a distance determined -#' by the user. Uses the geosphere::distHaversine function and requires -#' coordinates in WGS84 (lng/lat). -#' -#' @param l A SpatialLines object -#' @param toptail_dist The distance (in metres) to top the line by. -#' Can be either a single value or a vector of the same length as the -#' SpatialLines object. If tail_dist is missing, is used as the tail distance. -#' @param tail_dist The distance (in metres) to tail the line by. Can be -#' either a single value or a vector of the same length as the SpatialLines -#' object. -#' @family lines -#' @export -#' @examples -#' data("routes_fast") -#' rf <- routes_fast[2:3, ] -#' r_toptail <- toptailgs(rf, toptail_dist = 300) -#' plot(rf, lwd = 3) -#' plot(r_toptail, col = "red", add = TRUE) -#' plot(cents, add = TRUE) -toptailgs <- function(l, toptail_dist, tail_dist = NULL) { - if (length(toptail_dist) > 1) { - if (length(toptail_dist) != length(l)) { - stop("toptail_dist is vector but not of equal length to SpatialLines object") - } - } - if (!missing(tail_dist)) { - if (length(tail_dist) > 1) { - if (length(tail_dist) != length(l)) { - stop("tail_dist is vector but not of equal length to SpatialLines object") - } - } - } - else { - tail_dist <- toptail_dist - } - - toptail_disto <- toptail_dist - tail_disto <- tail_dist - - i <- 1 - while (i <= length(l)) { - toptail_dist <- ifelse(length(toptail_disto) == 1, toptail_disto, toptail_disto[i]) - linecoords <- coordinates(l@lines[[i]])[[1]] - topdists <- geosphere::distHaversine(linecoords[1, ], linecoords) - linecoords <- rbind( - tail(linecoords[which(topdists < toptail_dist), , drop = FALSE], n = 1) + ( - linecoords[which(topdists >= toptail_dist), , drop = FALSE][1, ] - - tail(linecoords[which(topdists < toptail_dist), , drop = FALSE], n = 1) - ) * ( - (toptail_dist - tail(topdists[which(topdists < toptail_dist)], n = 1)) / (topdists[which(topdists >= toptail_dist)][1] - tail(topdists[which(topdists < toptail_dist)], n = 1)) - ), - linecoords[which(topdists >= toptail_dist), , drop = FALSE] - ) - bottomdists <- geosphere::distHaversine(linecoords[nrow(linecoords), ], linecoords) - tail_dist <- ifelse(length(tail_disto) == 1, tail_disto, tail_disto[i]) - - linecoords <- rbind( - linecoords[which(bottomdists >= tail_dist), , drop = FALSE], - tail(linecoords[which(bottomdists >= tail_dist), , drop = FALSE], n = 1) + ( - linecoords[which(bottomdists < tail_dist), , drop = FALSE][1, ] - - tail(linecoords[which(bottomdists >= tail_dist), , drop = FALSE], n = 1) - ) * - ((tail(bottomdists[which(bottomdists >= tail_dist)], n = 1) - tail_dist) / (tail(bottomdists[which(bottomdists >= tail_dist)], n = 1) - bottomdists[which(bottomdists < tail_dist)][1])) - ) - l@lines[[i]]@Lines[[1]]@coords <- unname(linecoords) - i <- i + 1 - } - return(l) -} -#' Clip the beginning and ends SpatialLines to the edge of SpatialPolygon borders +#' Clip the beginning and ends of `sf` LINESTRING objects #' #' Takes lines and removes the start and end point, to a distance determined -#' by the nearest polygon border. +#' by the nearest `buff` polygon border. #' -#' @param l An sf LINESTRING object -#' @param buff An sf POLYGON object to act as the buffer -#' @param ... Arguments passed to rgeos::gBuffer() +#' @inheritParams geo_toptail +#' @param buff An `sf` object with POLYGON geometry to buffer the linestring. #' @family lines #' @export #' @examples diff --git a/R/zzz.R b/R/zzz.R index 5e4ffe11..ce23bf7c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,10 +1,10 @@ .onLoad <- function(libname, pkgname){ packageStartupMessage( paste0( - "Loading stplanr v0.9.0.\n", - "Note: the next planned version, v1.0.0, will not support sp objects.\n", - "See the issue #332 and https://github.com/ropensci/stplanr/pull/481.", - "Any feedback on GitHub: welcome. Thanks (Robin Lovelace, April 2022)!" + "Loading stplanr v1.0.0.\n", + "Note: this version removes support for sp objects.\n", + "If you require support for sp, use an older version or shift to sf.\n", + "See r-spatial.org/r/2022/04/12/evolution.html for motivation." ) ) } diff --git a/README.Rmd b/README.Rmd index 62ab55d8..87931d4a 100644 --- a/README.Rmd +++ b/README.Rmd @@ -211,8 +211,6 @@ devtools::install_github("ropensci/stplanr") library(stplanr) ``` -stplanr depends on rgdal, which can be tricky to install. - ### Installing stplanr on Linux and Mac **stplanr** depends on **sf**. Installation instructions for Mac, Ubuntu and other Linux distros can be found here: https://github.com/r-spatial/sf#installing diff --git a/data/ca_local.rda b/data/ca_local.rda deleted file mode 100644 index d6d6e12d..00000000 Binary files a/data/ca_local.rda and /dev/null differ diff --git a/data/cents.rda b/data/cents.rda deleted file mode 100644 index fde4f65e..00000000 Binary files a/data/cents.rda and /dev/null differ diff --git a/data/destination_zones.rda b/data/destination_zones.rda deleted file mode 100644 index e385eb53..00000000 Binary files a/data/destination_zones.rda and /dev/null differ diff --git a/data/destinations.rda b/data/destinations.rda deleted file mode 100644 index 734a5980..00000000 Binary files a/data/destinations.rda and /dev/null differ diff --git a/data/flowlines.rda b/data/flowlines.rda deleted file mode 100644 index d704899a..00000000 Binary files a/data/flowlines.rda and /dev/null differ diff --git a/data/l_poly.rda b/data/l_poly.rda deleted file mode 100644 index 8ccd1958..00000000 Binary files a/data/l_poly.rda and /dev/null differ diff --git a/data/route_network.rda b/data/route_network.rda deleted file mode 100644 index fde95042..00000000 Binary files a/data/route_network.rda and /dev/null differ diff --git a/data/routes_fast.rda b/data/routes_fast.rda deleted file mode 100644 index cab31978..00000000 Binary files a/data/routes_fast.rda and /dev/null differ diff --git a/data/routes_slow.rda b/data/routes_slow.rda deleted file mode 100644 index 21e37fe2..00000000 Binary files a/data/routes_slow.rda and /dev/null differ diff --git a/data/zones.rda b/data/zones.rda deleted file mode 100644 index 1179e86c..00000000 Binary files a/data/zones.rda and /dev/null differ diff --git a/man/SpatialLinesNetwork-class.Rd b/man/SpatialLinesNetwork-class.Rd deleted file mode 100644 index 2093e180..00000000 --- a/man/SpatialLinesNetwork-class.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\docType{class} -\name{SpatialLinesNetwork-class} -\alias{SpatialLinesNetwork-class} -\title{An S4 class representing a (typically) transport network} -\description{ -This class uses a combination of a SpatialLinesDataFrame and an igraph -object to represent transport networks that can be used for routing and -other network analyses. -} -\section{Slots}{ - -\describe{ -\item{\code{sl}}{A SpatialLinesDataFrame with the geometry and other attributes -for each link the in network.} - -\item{\code{g}}{The graph network corresponding to \code{sl}.} - -\item{\code{nb}}{A list containing vectors of the nodes connected to each node -in the network.} - -\item{\code{weightfield}}{A character vector containing the variable (column) name -from the SpatialLinesDataFrame to be used for weighting the network.} -}} - diff --git a/man/SpatialLinesNetwork.Rd b/man/SpatialLinesNetwork.Rd deleted file mode 100644 index 1f52b368..00000000 --- a/man/SpatialLinesNetwork.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{SpatialLinesNetwork} -\alias{SpatialLinesNetwork} -\title{Create object of class SpatialLinesNetwork or sfNetwork} -\usage{ -SpatialLinesNetwork(sl, uselonglat = FALSE, tolerance = 0) -} -\arguments{ -\item{sl}{A SpatialLines or SpatialLinesDataFrame containing the lines to -use to create the network.} - -\item{uselonglat}{A boolean value indicating if the data should be assumed -to be using WGS84 latitude/longitude coordinates. If \code{FALSE} or not -set, uses the coordinate system specified by the SpatialLines object.} - -\item{tolerance}{A numeric value indicating the tolerance (in the units of -the coordinate system) to use as a tolerance with which to match nodes.} -} -\description{ -Creates a new SpatialLinesNetwork (for SpatialLines) or sfNetwork (for sf) -object that can be used for routing analysis within R. -} -\section{Details}{ - -This function is used to create a new SpatialLinesNetwork from an existing -SpatialLines or SpatialLinesDataFrame object. A typical use case is to -represent a transport network for routing and other network analysis -functions. This function and the corresponding SpatialLinesNetwork -class is an implementation of the SpatialLinesNetwork developed by -Edzer Pebesma and presented on \href{https://rpubs.com/edzer/6767}{RPubs}. -The original implementation has been rewritten to better support large -(i.e., detailed city-size) networks and to provide additional methods -useful for conducting transport research following on from the initial -examples provided by \href{https://rpubs.com/janoskaz/10396}{Janoska(2013)}. -} - -\examples{ -\donttest{ -# dont test due to issues with s2 dependency -sln_sf <- SpatialLinesNetwork(route_network_sf) -plot(sln_sf) -shortpath <- sum_network_routes(sln_sf, 1, 50, sumvars = "length") -plot(shortpath$geometry, col = "red", lwd = 4, add = TRUE) -} -} -\references{ -Pebesma, E. (2013). Spatial Networks, URL:https://rpubs.com/edzer/6767. - -Janoska, Z. (2013). Find shortest path in spatial network, -URL:https://rpubs.com/janoskaz/10396. -} -\seealso{ -Other rnet: -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/angle_diff.Rd b/man/angle_diff.Rd index 6493c9ac..dd818a71 100644 --- a/man/angle_diff.Rd +++ b/man/angle_diff.Rd @@ -24,7 +24,8 @@ on the direction of turn, i.e. + or - values for clockwise/anticlockwise), bidirectional (which mean values greater than +/- 90 are impossible). } \details{ -Building on the convention used in \code{\link[=bearing]{bearing()}} and in many applications, +Building on the convention used in in the \code{bearing()} function from the +\code{geosphere} package and in many applications, North is definied as 0, East as 90 and West as -90. } \examples{ @@ -36,11 +37,6 @@ if (lib_versions[3] >= "6.3.1") { 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) - plot(flowlines) - plot(flowlines[a < 15, ], add = TRUE, lwd = 3, col = "red") - # East-West - plot(flowlines[a > 75, ], add = TRUE, lwd = 3, col = "green") } } \seealso{ @@ -52,17 +48,12 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/api_pat.Rd b/man/api_pat.Rd deleted file mode 100644 index 157547de..00000000 --- a/man/api_pat.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/route_cyclestreets.R -\name{api_pat} -\alias{api_pat} -\title{Retrieve personal access token.} -\usage{ -api_pat(api_name, force = FALSE) -} -\arguments{ -\item{api_name}{Text string of the name of the API you are calling, e.g. -cyclestreets, graphhopper etc.} -} -\description{ -Retrieve personal access token. -} -\examples{ -\dontrun{ -api_pat(api_name = "cyclestreet") -} -} -\keyword{internal} diff --git a/man/as_sf_fun.Rd b/man/as_sf_fun.Rd deleted file mode 100644 index 2b426415..00000000 --- a/man/as_sf_fun.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/as_sf_fun.R -\name{as_sf_fun} -\alias{as_sf_fun} -\alias{as_sp_fun} -\title{Convert functions support sf/sp} -\usage{ -as_sf_fun(input, FUN, ...) -} -\arguments{ -\item{input}{Input object - an sf or sp object} - -\item{FUN}{A function that works on sp/sf data} - -\item{...}{Arguments passed to \code{FUN}} -} -\description{ -Convert functions support sf/sp -} diff --git a/man/bbox_scale.Rd b/man/bbox_scale.Rd index e225955a..9bf46468 100644 --- a/man/bbox_scale.Rd +++ b/man/bbox_scale.Rd @@ -30,7 +30,6 @@ points(bb[1, ], bb[2, ], col = "red") Other geo: \code{\link{geo_bb_matrix}()}, \code{\link{geo_bb}()}, -\code{\link{quadrant}()}, -\code{\link{reproject}()} +\code{\link{quadrant}()} } \concept{geo} diff --git a/man/ca_local.Rd b/man/ca_local.Rd deleted file mode 100644 index b300b61c..00000000 --- a/man/ca_local.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{ca_local} -\alias{ca_local} -\title{SpatialPointsDataFrame representing road traffic deaths} -\format{ -A SpatialPointsDataFrame with 11 rows and 2 columns -} -\usage{ -data(ca_local) -} -\description{ -This dataset represents the type of data downloaded and cleaned -using stplanr functions. It represents a very small sample (with most variables stripped) -of open data from the UK's Stats19 dataset. -} -\keyword{datasets} diff --git a/man/calc_catchment.Rd b/man/calc_catchment.Rd deleted file mode 100644 index 34e26d85..00000000 --- a/man/calc_catchment.Rd +++ /dev/null @@ -1,133 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/catchmentArea.R -\name{calc_catchment} -\alias{calc_catchment} -\title{Calculate catchment area and associated summary statistics.} -\usage{ -calc_catchment( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0("+proj=aea +lat_1=90 +lat_2=-18.416667 ", - "+lat_0=0 +lon_0=10 +x_0=0 +y_0=0 +ellps=GRS80", - " +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), - retainAreaProportion = FALSE, - dissolve = FALSE, - quadsegs = NULL -) -} -\arguments{ -\item{polygonlayer}{A SpatialPolygonsDataFrame containing zones from which -the summary statistics for the catchment variable will be calculated. -Smaller polygons will increase the accuracy of the results.} - -\item{targetlayer}{A SpatialPolygonsDataFrame, SpatialLinesDataFrame, -SpatialPointsDataFrame, SpatialPolygons, SpatialLines or SpatialPoints -object containing the specifications of the facility for which the -catchment area is being calculated. If the object contains more than one -facility (e.g., multiple cycle paths) the aggregate catchment area will be -calculated.} - -\item{calccols}{A vector of column names containing the variables in the -polygonlayer to be used in the calculation of the summary statistics for -the catchment area. If dissolve = FALSE, all other variables in the -original SpatialPolygonsDataFrame for zones that fall partly or entirely -within the catchment area will be included in the returned -SpatialPolygonsDataFrame but will not be adjusted for the proportion within -the catchment area.} - -\item{distance}{Defines the size of the catchment area as the distance -around the targetlayer in the units of the projection -(default = 500 metres)} - -\item{projection}{The proj4string used to define the projection to be used -for calculating the catchment areas or a character string 'austalbers' to -use the Australian Albers Equal Area projection. Ignored if the polygonlayer -is projected in which case the targetlayer will be converted to the -projection used by the polygonlayer. In all cases the resulting object will -be reprojected to the original coordinate system and projection of the -polygon layer. Default is an Albers Equal Area projection but for more -reliable results should use a local projection (e.g., Australian Albers -Equal Area project).} - -\item{retainAreaProportion}{Boolean value. If TRUE retains a variable in -the resulting SpatialPolygonsDataFrame containing the proportion of the -original area within the catchment area (Default = FALSE).} - -\item{dissolve}{Boolean value. If TRUE collapses the underlying zones -within the catchment area into a single region with statistics for the -whole catchment area.} - -\item{quadsegs}{Number of line segments to use to approximate a quarter -circle. Parameter passed to buffer functions, default is 5 for sp and -30 for sf.} -} -\description{ -Calculate catchment area and associated summary statistics. -} -\section{Details}{ - -Calculates the catchment area of a facility (e.g., cycle path) using -straight-line distance as well as summary statistics from variables -available in a SpatialPolygonsDataFrame with census tracts or other -zones. Assumes that the frequency of the variable is evenly distributed -throughout the zone. Returns a SpatialPolygonsDataFrame. -} - -\examples{ -\dontrun{ -data_dir <- system.file("extdata", package = "stplanr") -unzip(file.path(data_dir, "smallsa1.zip")) -unzip(file.path(data_dir, "testcycleway.zip")) -sa1income <- as(sf::read_sf("smallsa1.shp"), "Spatial") -testcycleway <- as(sf::read_sf("testcycleway.shp"), "Spatial") -cway_catch <- calc_catchment( - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - distance = 800, - projection = "austalbers", - dissolve = TRUE -) -plot(sa1income) -plot(cway_catch, add = TRUE, col = "green") -plot(testcycleway, col = "red", add = TRUE) -sa1income <- sf::read_sf("smallsa1.shp") -testcycleway <- sf::read_sf("testcycleway.shp") -f <- list.files(".", "testcycleway|smallsa1") -file.remove(f) -cway_catch <- calc_catchment( - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - distance = 800, - projection = "austalbers", - dissolve = TRUE -) -plot(sa1income$geometry) -plot(testcycleway$geometry, col = "red", add = TRUE) -plot(cway_catch["Total"], add = TRUE) -} -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/calc_catchment_sum.Rd b/man/calc_catchment_sum.Rd deleted file mode 100644 index cbda0697..00000000 --- a/man/calc_catchment_sum.Rd +++ /dev/null @@ -1,114 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/catchmentArea.R -\name{calc_catchment_sum} -\alias{calc_catchment_sum} -\title{Calculate summary statistics for catchment area.} -\usage{ -calc_catchment_sum( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = paste0("+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), - retainAreaProportion = FALSE, - quadsegs = NA -) -} -\arguments{ -\item{polygonlayer}{A SpatialPolygonsDataFrame containing zones from which -the summary statistics for the catchment variable will be calculated. -Smaller polygons will increase the accuracy of the results.} - -\item{targetlayer}{A SpatialPolygonsDataFrame, SpatialLinesDataFrame, -SpatialPointsDataFrame, SpatialPolygons, SpatialLines or SpatialPoints -object containing the specifications of the facility for which the -catchment area is being calculated. If the object contains more than one -facility (e.g., multiple cycle paths) the aggregate catchment area will be -calculated.} - -\item{calccols}{A vector of column names containing the variables in the -polygonlayer to be used in the calculation of the summary statistics for -the catchment area.} - -\item{distance}{Defines the size of the catchment area as the distance -around the targetlayer in the units of the projection -(default = 500 metres)} - -\item{projection}{The proj4string used to define the projection to be used -for calculating the catchment areas or a character string 'austalbers' to -use the Australian Albers Equal Area projection. Ignored if the polygonlayer -is projected in which case the targetlayer will be converted to the -projection used by the polygonlayer. In all cases the resulting object will -be reprojected to the original coordinate system and projection of the -polygon layer. Default is an Albers Equal Area projection but for more -reliable results should use a local projection (e.g., Australian Albers -Equal Area project).} - -\item{retainAreaProportion}{Boolean value. If TRUE retains a variable in -the resulting SpatialPolygonsDataFrame containing the proportion of the -original area within the catchment area (Default = FALSE).} - -\item{quadsegs}{Number of line segments to use to approximate a quarter -circle. Parameter passed to buffer functions, default is 5 for sp and -30 for sf.} -} -\description{ -Calculate summary statistics for catchment area. -} -\section{Details}{ - -Calculates the summary statistics for a catchment area of a facility -(e.g., cycle path) using straight-line distance from variables -available in a SpatialPolygonsDataFrame with census tracts or other -zones. Assumes that the frequency of the variable is evenly distributed -throughout the zone. Returns either a single value if calccols is of -length = 1, or a named vector otherwise. -} - -\examples{ -\dontrun{ -data_dir <- system.file("extdata", package = "stplanr") -unzip(file.path(data_dir, "smallsa1.zip")) -unzip(file.path(data_dir, "testcycleway.zip")) -sa1income <- rgdal::readOGR(".", "smallsa1") -testcycleway <- rgdal::readOGR(".", "testcycleway") -calc_catchment_sum( - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - distance = 800, - projection = "austalbers" -) - -calc_catchment_sum( - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - distance = 800, - projection = "austalbers" -) -} -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/calc_moving_catchment.Rd b/man/calc_moving_catchment.Rd deleted file mode 100644 index 4d2efeea..00000000 --- a/man/calc_moving_catchment.Rd +++ /dev/null @@ -1,96 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/catchmentArea.R -\name{calc_moving_catchment} -\alias{calc_moving_catchment} -\title{Calculate summary statistics for all features independently.} -\usage{ -calc_moving_catchment( - polygonlayer, - targetlayer, - calccols, - distance = 500, - projection = "worldalbers", - retainAreaProportion = FALSE -) -} -\arguments{ -\item{polygonlayer}{A SpatialPolygonsDataFrame containing zones from which -the summary statistics for the catchment variable will be calculated. -Smaller polygons will increase the accuracy of the results.} - -\item{targetlayer}{A SpatialPolygonsDataFrame, SpatialLinesDataFrame or -SpatialPointsDataFrame object containing the specifications of the -facilities and zones for which the catchment areas are being calculated.} - -\item{calccols}{A vector of column names containing the variables in the -polygonlayer to be used in the calculation of the summary statistics for -the catchment areas.} - -\item{distance}{Defines the size of the catchment areas as the distance -around the targetlayer in the units of the projection -(default = 500 metres)} - -\item{projection}{The proj4string used to define the projection to be used -for calculating the catchment areas or a character string 'austalbers' to -use the Australian Albers Equal Area projection. Ignored if the polygonlayer -is projected in which case the targetlayer will be converted to the -projection used by the polygonlayer. In all cases the resulting object will -be reprojected to the original coordinate system and projection of the -polygon layer. Default is an Albers Equal Area projection but for more -reliable results should use a local projection (e.g., Australian Albers -Equal Area project).} - -\item{retainAreaProportion}{Boolean value. If TRUE retains a variable in -the resulting SpatialPolygonsDataFrame containing the proportion of the -original area within the catchment area (Default = FALSE).} -} -\description{ -Calculate summary statistics for all features independently. -} -\section{Details}{ - -Calculates the summary statistics for a catchment area of multiple -facilities or zones using straight-line distance from variables -available in a SpatialPolygonsDataFrame with census tracts or other -zones. Assumes that the frequency of the variable is evenly distributed -throughout the zone. Returns the original source dataframe with additional -columns with summary variables. -} - -\examples{ -\dontrun{ -data_dir <- system.file("extdata", package = "stplanr") -unzip(file.path(data_dir, "smallsa1.zip")) -unzip(file.path(data_dir, "testcycleway.zip")) -sa1income <- readOGR(".", "smallsa1") -testcycleway <- readOGR(".", "testcycleway") -calc_moving_catchment( - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - distance = 800, - projection = "austalbers" -) -} -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/calc_network_catchment.Rd b/man/calc_network_catchment.Rd deleted file mode 100644 index c1459b11..00000000 --- a/man/calc_network_catchment.Rd +++ /dev/null @@ -1,119 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/catchmentArea.R -\name{calc_network_catchment} -\alias{calc_network_catchment} -\title{Calculate catchment area and associated summary statistics using network.} -\usage{ -calc_network_catchment( - sln, - polygonlayer, - targetlayer, - calccols, - maximpedance = 1000, - distance = 100, - projection = paste0("+proj=aea +lat_1=90 +lat_2=-18.416667", - " +lat_0=0 +lon_0=10 +x_0=0 +y_0=0", - " +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), - retainAreaProportion = FALSE, - dissolve = FALSE -) -} -\arguments{ -\item{sln}{The SpatialLinesNetwork to use.} - -\item{polygonlayer}{A SpatialPolygonsDataFrame containing zones from which -the summary statistics for the catchment variable will be calculated. -Smaller polygons will increase the accuracy of the results.} - -\item{targetlayer}{A SpatialPolygonsDataFrame, SpatialLinesDataFrame or -SpatialPointsDataFrame object containing the specifications of the -facilities and zones for which the catchment areas are being calculated.} - -\item{calccols}{A vector of column names containing the variables in the -polygonlayer to be used in the calculation of the summary statistics for -the catchment area. If dissolve = FALSE, all other variables in the -original SpatialPolygonsDataFrame for zones that fall partly or entirely -within the catchment area will be included in the returned -SpatialPolygonsDataFrame but will not be adjusted for the proportion within -the catchment area.} - -\item{maximpedance}{The maximum value of the network's weight attribute in -the units of the weight (default = 1000).} - -\item{distance}{Defines the additional catchment area around the network -in the units of the projection. -(default = 100 metres)} - -\item{projection}{The proj4string used to define the projection to be used -for calculating the catchment areas or a character string 'austalbers' to -use the Australian Albers Equal Area projection. Ignored if the polygonlayer -is projected in which case the targetlayer will be converted to the -projection used by the polygonlayer. In all cases the resulting object will -be reprojected to the original coordinate system and projection of the -polygon layer. Default is an Albers Equal Area projection but for more -reliable results should use a local projection (e.g., Australian Albers -Equal Area project).} - -\item{retainAreaProportion}{Boolean value. If TRUE retains a variable in -the resulting SpatialPolygonsDataFrame containing the proportion of the -original area within the catchment area (Default = FALSE).} - -\item{dissolve}{Boolean value. If TRUE collapses the underlying zones -within the catchment area into a single region with statistics for the -whole catchment area.} -} -\description{ -Calculate catchment area and associated summary statistics using network. -} -\section{Details}{ - -Calculates the catchment area of a facility (e.g., cycle path) using -network distance (or other weight variable) as well as summary statistics -from variables available in a SpatialPolygonsDataFrame with census tracts -or other zones. Assumes that the frequency of the variable is evenly -distributed throughout the zone. Returns a SpatialPolygonsDataFrame. -} - -\examples{ -\dontrun{ -data_dir <- system.file("extdata", package = "stplanr") -unzip(file.path(data_dir, "smallsa1.zip"), exdir = tempdir()) -unzip(file.path(data_dir, "testcycleway.zip"), exdir = tempdir()) -unzip(file.path(data_dir, "sydroads.zip"), exdir = tempdir()) -sa1income <- readOGR(tempdir(), "smallsa1") -testcycleway <- readOGR(tempdir(), "testcycleway") -sydroads <- readOGR(tempdir(), "roads") -sydnetwork <- SpatialLinesNetwork(sydroads) -calc_network_catchment( - sln = sydnetwork, - polygonlayer = sa1income, - targetlayer = testcycleway, - calccols = c("Total"), - maximpedance = 800, - distance = 200, - projection = "austalbers", - dissolve = TRUE -) -} -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/cents.Rd b/man/cents_sf.Rd similarity index 85% rename from man/cents.Rd rename to man/cents_sf.Rd index 05726296..4d95aecf 100644 --- a/man/cents.Rd +++ b/man/cents_sf.Rd @@ -1,15 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{cents} -\alias{cents} +\name{cents_sf} \alias{cents_sf} \title{Spatial points representing home locations} \format{ -A spatial dataset with 8 rows and 5 variables -} -\usage{ -data(cents) +A spatial dataset with 8 rows and 5 columns } \description{ These points represent population-weighted centroids of Medium Super Output Area (MSOA) zones within a 1 mile radius of of my home when I was writing this package. @@ -25,10 +21,6 @@ These points represent population-weighted centroids of Medium Super Output Area Cents was generated from the data repository pct-data: https://github.com/npct/pct-data. This data was accessed from within the pct repo: https://github.com/npct/pct, using the following code: } \examples{ -\dontrun{ -cents -plot(cents) -} - +cents_sf } \keyword{datasets} diff --git a/man/destination_zones.Rd b/man/destination_zones.Rd deleted file mode 100644 index 92344537..00000000 --- a/man/destination_zones.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{destination_zones} -\alias{destination_zones} -\alias{destinations} -\alias{destinations_sf} -\title{Example destinations data} -\format{ -A spatial dataset with 87 features -} -\usage{ -data(destination_zones) -} -\description{ -This dataset represents trip destinations on a different geographic -level than the origins stored in the object \code{cents}. -} -\examples{ -\dontrun{ -# This is how the dataset was constructed - see -# https://cowz.geodata.soton.ac.uk/download/ -download.file( - "https://cowz.geodata.soton.ac.uk/download/files/COWZ_EW_2011_BFC.zip", - "COWZ_EW_2011_BFC.zip" -) -unzip("COWZ_EW_2011_BFC.zip") -wz <- raster::shapefile("COWZ_EW_2011_BFC.shp") -to_remove <- list.files(pattern = "COWZ", full.names = TRUE, recursive = TRUE) -file.remove(to_remove) -proj4string(wz) -wz <- sp::spTransform(wz, proj4string(zones)) -destination_zones <- wz[zones, ] -plot(destination_zones) -devtools::use_data(destination_zones) -head(destination_zones@data) -destinations <- rgeos::gCentroid(destinations, byid = TRUE) -destinations <- sp::SpatialPointsDataFrame(destinations, destination_zones@data) -devtools::use_data(destinations, overwrite = TRUE) -destinations_sf <- sf::st_as_sf(destinations) -devtools::use_data(destinations_sf) -} -} -\seealso{ -Other example data: -\code{\link{flow_dests}}, -\code{\link{flowlines}}, -\code{\link{flow}}, -\code{\link{route_network}}, -\code{\link{routes_fast}}, -\code{\link{routes_slow}} -} -\concept{example data} -\keyword{datasets} diff --git a/man/destinations_sf.Rd b/man/destinations_sf.Rd new file mode 100644 index 00000000..98af4964 --- /dev/null +++ b/man/destinations_sf.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{destinations_sf} +\alias{destinations_sf} +\title{Example destinations data} +\format{ +A spatial dataset with 87 features +} +\description{ +This dataset represents trip destinations on a different geographic +level than the origins stored in the object \code{cents_sf}. +} +\examples{ +destinations_sf +} +\seealso{ +Other example data: +\code{\link{flow_dests}}, +\code{\link{flowlines_sf}}, +\code{\link{flow}}, +\code{\link{route_network_sf}}, +\code{\link{routes_fast_sf}}, +\code{\link{routes_slow_sf}} +} +\concept{example data} +\keyword{datasets} diff --git a/man/dist_google.Rd b/man/dist_google.Rd deleted file mode 100644 index 288fecd5..00000000 --- a/man/dist_google.Rd +++ /dev/null @@ -1,99 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/google-functions.R -\name{dist_google} -\alias{dist_google} -\title{Return travel network distances and time using the Google Maps API} -\usage{ -dist_google( - from, - to, - google_api = Sys.getenv("GOOGLEDIST"), - g_units = "metric", - mode = c("bicycling", "walking", "driving", "transit"), - arrival_time = "" -) -} -\arguments{ -\item{from}{Two-column matrix or data frame of coordinates representing -latitude and longitude of origins.} - -\item{to}{Two-column matrix or data frame of coordinates representing -latitude and longitude of destinations.} - -\item{google_api}{String value containing the Google API key to use.} - -\item{g_units}{Text string, either metric (default) or imperial.} - -\item{mode}{Text string specifying the mode of transport. Can be -bicycling (default), walking, driving or transit} - -\item{arrival_time}{Time of arrival in date format.} -} -\description{ -Return travel network distances and time using the Google Maps API -} -\details{ -Absent authorization, the google API is limited to a maximum of 100 -simultaneous queries, and so will, for example, only returns values for up to -10 origins times 10 destinations. -} -\section{Details}{ - -Estimate travel times accounting for the road network - see \url{https://developers.google.com/maps/documentation/distance-matrix/overview} -Note: Currently returns the json object returned by the Google Maps API and uses the same origins and destinations. -} - -\examples{ -\dontrun{ -# Distances from one origin to one destination -from <- c(-46.3, -23.4) -to <- c(-46.4, -23.4) -dist_google(from = from, to = to, mode = "walking") # not supported on last test -dist_google(from = from, to = to, mode = "driving") -dist_google(from = c(0, 52), to = c(0, 53)) -data("cents") -# Distances from between all origins and destinations -dists_cycle <- dist_google(from = cents, to = cents) -dists_drive <- dist_google(cents, cents, mode = "driving") -dists_trans <- dist_google(cents, cents, mode = "transit") -dists_trans_am <- dist_google(cents, cents, - mode = "transit", - arrival_time = strptime("2016-05-27 09:00:00", - format = "\%Y-\%m-\%d \%H:\%M:\%S", tz = "BST" - ) -) -# Find out how much longer (or shorter) cycling takes than walking -summary(dists_cycle$duration / dists_trans$duration) -# Difference between travelling now and for 9am arrival -summary(dists_trans_am$duration / dists_trans$duration) -odf <- points2odf(cents) -odf <- cbind(odf, dists) -head(odf) -flow <- points2flow(cents) -# show the results for duration (thicker line = shorter) -plot(flow, lwd = mean(odf$duration) / odf$duration) -dist_google(c("Hereford"), c("Weobley", "Leominster", "Kington")) -dist_google(c("Hereford"), c("Weobley", "Leominster", "Kington"), - mode = "transit", arrival_time = strptime("2016-05-27 17:30:00", - format = "\%Y-\%m-\%d \%H:\%M:\%S", tz = "BST" - ) -) -} -} -\seealso{ -Other od: -\code{\link{od2line}()}, -\code{\link{od2odf}()}, -\code{\link{od_aggregate_from}()}, -\code{\link{od_aggregate_to}()}, -\code{\link{od_coords2line}()}, -\code{\link{od_coords}()}, -\code{\link{od_dist}()}, -\code{\link{od_id}}, -\code{\link{od_oneway}()}, -\code{\link{od_to_odmatrix}()}, -\code{\link{odmatrix_to_od}()}, -\code{\link{points2flow}()}, -\code{\link{points2odf}()} -} -\concept{od} diff --git a/man/find_network_nodes.Rd b/man/find_network_nodes.Rd deleted file mode 100644 index 96daa49f..00000000 --- a/man/find_network_nodes.Rd +++ /dev/null @@ -1,66 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{find_network_nodes} -\alias{find_network_nodes} -\title{Find graph node ID of closest node to given coordinates} -\usage{ -find_network_nodes(sln, x, y = NULL, maxdist = 1000) -} -\arguments{ -\item{sln}{SpatialLinesNetwork to search.} - -\item{x}{Either the x (longitude) coordinate value, a vector of x values, -a dataframe or matrix with (at least) two columns, the first for coordinate -for x (longitude) values and a second for y (latitude) values, or a named -vector of length two with values of 'lat' and 'lon'. The output of -geo_code() either as a single result or as multiple (using -rbind() ) can also be used.} - -\item{y}{Either the y (latitude) coordinate value or a vector of y values.} - -\item{maxdist}{The maximum distance within which to match the nodes to -coordinates. If the SpatialLinesNetwork is projected then distance should -be in the same units as the projection. If longlat, then distance is in -metres. Default is 1000.} -} -\value{ -An integer value with the ID of the node closest to \verb{(x,y)} -with a value of \code{NA} the closest node is further than \code{maxdist} -from \verb{(x,y)}. If \code{x} is a vector, returns a vector of Node IDs. -} -\description{ -Find graph node ID of closest node to given coordinates -} -\section{Details}{ - -Finds the node ID of the closest point to a single coordinate pair (or a -set of coordinates) from a SpatialLinesNetwork. -} - -\examples{ -data(routes_fast) -rnet <- overline(routes_fast, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -find_network_nodes(sln, -1.516734, 53.828) -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/flow.Rd b/man/flow.Rd index 56256d10..8861f9aa 100644 --- a/man/flow.Rd +++ b/man/flow.Rd @@ -3,16 +3,13 @@ \docType{data} \name{flow} \alias{flow} -\title{data frame of commuter flows} +\title{Data frame of commuter flows} \format{ A data frame with 49 rows and 15 columns } -\usage{ -data(flow) -} \description{ This dataset represents commuter flows (work travel) between origin -and destination zones (see \code{\link[=cents]{cents()}}). +and destination zones. The data is from the UK and is available as open data: \url{https://wicid.ukdataservice.ac.uk/}. } @@ -29,44 +26,16 @@ The variables are as follows: Although these variable names are unique to UK data, the data structure is generalisable and typical of flow data from any source. The key variables are the origin and destination ids, which link to -the \code{cents} georeferenced spatial objects. -} -\examples{ -\dontrun{ -# This is how the dataset was constructed - see -# https://github.com/npct/pct - if download to ~/repos -flow <- readRDS("~/repos/pct/pct-data/national/flow.Rds") -data(cents) -o <- flow$Area.of.residence \%in\% cents$geo_code[-1] -d <- flow$Area.of.workplace \%in\% cents$geo_code[-1] -flow <- flow[o & d, ] # subset flows with o and d in study area -library(devtools) -flow$id <- paste(flow$Area.of.residence, flow$Area.of.workplace) -use_data(flow, overwrite = TRUE) - -# Convert flows to spatial lines dataset -flowlines <- od2line(flow = flow, zones = cents) -# use_data(flowlines, overwrite = TRUE) - -# Convert flows to routes -routes_fast <- line2route(l = flowlines, plan = "fastest") -routes_slow <- line2route(l = flowlines, plan = "quietest") - -use_data(routes_fast) -use_data(routes_slow) -routes_fast_sf <- sf::st_as_sf(routes_fast) -routes_slow_sf <- sf::st_as_sf(routes_slow) -} - +the georeferenced spatial objects. } \seealso{ Other example data: -\code{\link{destination_zones}}, +\code{\link{destinations_sf}}, \code{\link{flow_dests}}, -\code{\link{flowlines}}, -\code{\link{route_network}}, -\code{\link{routes_fast}}, -\code{\link{routes_slow}} +\code{\link{flowlines_sf}}, +\code{\link{route_network_sf}}, +\code{\link{routes_fast_sf}}, +\code{\link{routes_slow_sf}} } \concept{example data} \keyword{datasets} diff --git a/man/flow_dests.Rd b/man/flow_dests.Rd index b130c2be..ab2629e3 100644 --- a/man/flow_dests.Rd +++ b/man/flow_dests.Rd @@ -3,7 +3,7 @@ \docType{data} \name{flow_dests} \alias{flow_dests} -\title{data frame of invented +\title{Data frame of invented commuter flows with destinations in a different layer than the origins} \format{ A data frame with 49 rows and 15 columns @@ -12,7 +12,7 @@ A data frame with 49 rows and 15 columns data(flow_dests) } \description{ -data frame of invented +Data frame of invented commuter flows with destinations in a different layer than the origins } \examples{ @@ -27,12 +27,12 @@ devtools::use_data(flow_dests) } \seealso{ Other example data: -\code{\link{destination_zones}}, -\code{\link{flowlines}}, +\code{\link{destinations_sf}}, +\code{\link{flowlines_sf}}, \code{\link{flow}}, -\code{\link{route_network}}, -\code{\link{routes_fast}}, -\code{\link{routes_slow}} +\code{\link{route_network_sf}}, +\code{\link{routes_fast_sf}}, +\code{\link{routes_slow_sf}} } \concept{example data} \keyword{datasets} diff --git a/man/flowlines.Rd b/man/flowlines_sf.Rd similarity index 50% rename from man/flowlines.Rd rename to man/flowlines_sf.Rd index 7832d388..e3073ab0 100644 --- a/man/flowlines.Rd +++ b/man/flowlines_sf.Rd @@ -1,25 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{flowlines} -\alias{flowlines} +\name{flowlines_sf} \alias{flowlines_sf} -\title{spatial lines dataset of commuter flows} +\title{Spatial lines dataset of commuter flows} \format{ A spatial lines dataset with 49 rows and 15 columns } \description{ -Flow data after conversion to a spatial format -with \code{\link[=od2line]{od2line()}} (see \code{\link[=flow]{flow()}}). +Flow data after conversion to a spatial format.. } \seealso{ Other example data: -\code{\link{destination_zones}}, +\code{\link{destinations_sf}}, \code{\link{flow_dests}}, \code{\link{flow}}, -\code{\link{route_network}}, -\code{\link{routes_fast}}, -\code{\link{routes_slow}} +\code{\link{route_network_sf}}, +\code{\link{routes_fast_sf}}, +\code{\link{routes_slow_sf}} } \concept{example data} \keyword{datasets} diff --git a/man/geo_bb.Rd b/man/geo_bb.Rd index feb2fc80..1c2dca38 100644 --- a/man/geo_bb.Rd +++ b/man/geo_bb.Rd @@ -13,7 +13,7 @@ geo_bb( ) } \arguments{ -\item{shp}{Spatial object (from sf or sp packages)} +\item{shp}{Spatial object} \item{scale_factor}{Numeric vector determining how much the bounding box will grow or shrink. Two numbers refer to extending the bounding box in x and y dimensions, respectively. @@ -28,13 +28,12 @@ Takes a geographic object or bounding box as an input and outputs a bounding box represented as a bounding box, corner points or rectangular polygon. } \examples{ -# Simple features implementation: shp <- routes_fast_sf shp_bb <- geo_bb(shp, distance = 100) plot(shp_bb, col = "red", reset = FALSE) plot(geo_bb(routes_fast_sf, scale_factor = 0.8), col = "green", add = TRUE) -plot(geo_bb(routes_fast_sf, output = "points"), add = TRUE) plot(routes_fast_sf$geometry, add = TRUE) +geo_bb(shp, output = "point") } \seealso{ bb_scale @@ -42,7 +41,6 @@ bb_scale Other geo: \code{\link{bbox_scale}()}, \code{\link{geo_bb_matrix}()}, -\code{\link{quadrant}()}, -\code{\link{reproject}()} +\code{\link{quadrant}()} } \concept{geo} diff --git a/man/geo_bb_matrix.Rd b/man/geo_bb_matrix.Rd index 1230269f..72281725 100644 --- a/man/geo_bb_matrix.Rd +++ b/man/geo_bb_matrix.Rd @@ -7,15 +7,14 @@ geo_bb_matrix(shp) } \arguments{ -\item{shp}{Spatial object (from sf or sp packages)} +\item{shp}{Spatial object} } \description{ Converts a range of spatial data formats into a matrix representing the bounding box } \examples{ -geo_bb_matrix(routes_fast) geo_bb_matrix(routes_fast_sf) -geo_bb_matrix(cents[1, ]) +geo_bb_matrix(cents_sf[1, ]) geo_bb_matrix(c(-2, 54)) geo_bb_matrix(sf::st_coordinates(cents_sf)) } @@ -23,7 +22,6 @@ geo_bb_matrix(sf::st_coordinates(cents_sf)) Other geo: \code{\link{bbox_scale}()}, \code{\link{geo_bb}()}, -\code{\link{quadrant}()}, -\code{\link{reproject}()} +\code{\link{quadrant}()} } \concept{geo} diff --git a/man/geo_buffer.Rd b/man/geo_buffer.Rd index 5c07d474..e3e3cbce 100644 --- a/man/geo_buffer.Rd +++ b/man/geo_buffer.Rd @@ -14,7 +14,7 @@ around which a buffer should be drawn} \item{width}{The distance (in metres) of the buffer (when buffering sp objects)} -\item{...}{Arguments passed to the buffer (see \code{?rgeos::gBuffer} or \code{?sf::st_buffer} for details)} +\item{...}{Arguments passed to the buffer (see \code{?sf::st_buffer} for details)} } \description{ This function solves the problem that buffers will not be circular when used on @@ -32,9 +32,5 @@ if (lib_versions[3] >= "6.3.1") { buff_sf <- geo_buffer(routes_fast_sf, dist = 50) plot(buff_sf$geometry) geo_buffer(routes_fast_sf$geometry, dist = 50) - # on legacy sp objects (not tested) - # buff_sp <- geo_buffer(routes_fast, width = 100) - # class(buff_sp) - # plot(buff_sp, col = "red") } } diff --git a/man/geo_code.Rd b/man/geo_code.Rd index e72f7823..bd368803 100644 --- a/man/geo_code.Rd +++ b/man/geo_code.Rd @@ -22,8 +22,7 @@ geo_code( \item{return_all}{Should the request return all information returned by Google Maps? The default is \code{FALSE}: to return only two numbers: the longitude and latitude, in that order} -\item{pat}{The API key used. By default this is set to NULL and -this is usually aquired automatically through a helper, api_pat().} +\item{pat}{Personal access token} } \description{ Generate a lat/long pair from data using Google's geolocation API. @@ -37,8 +36,4 @@ geo_code("hereford", return_all = TRUE) geo_code("hereford", service = "google", pat = Sys.getenv("GOOGLE"), return_all = TRUE) } } -\seealso{ -Other nodes: -\code{\link{nearest_google}()} -} \concept{nodes} diff --git a/man/geo_length.Rd b/man/geo_length.Rd index f29ddd1f..f9efcf77 100644 --- a/man/geo_length.Rd +++ b/man/geo_length.Rd @@ -17,7 +17,6 @@ and returns a numeric value representing distance in meters. lib_versions <- sf::sf_extSoftVersion() lib_versions if (lib_versions[3] >= "6.3.1") { - geo_length(routes_fast) geo_length(routes_fast_sf) } } diff --git a/man/geo_projected.Rd b/man/geo_projected.Rd index 63ce76df..24dfdfc8 100644 --- a/man/geo_projected.Rd +++ b/man/geo_projected.Rd @@ -10,14 +10,14 @@ geo_projected(shp, fun, crs, silent, ...) \arguments{ \item{shp}{A spatial object with a geographic (WGS84) coordinate system} -\item{fun}{A function to perform on the projected object (e.g. the the rgeos or sf packages)} +\item{fun}{A function to perform on the projected object (e.g. from the sf package)} \item{crs}{An optional coordinate reference system (if not provided it is set automatically by \code{\link[=geo_select_aeq]{geo_select_aeq()}})} \item{silent}{A binary value for printing the CRS details (default: TRUE)} -\item{...}{Arguments to pass to \code{fun}, e.g. \code{byid = TRUE} if the function is \code{rgeos::gLength()}} +\item{...}{Arguments to pass to \code{fun}} } \description{ This function performs operations on projected data. diff --git a/man/geo_select_aeq.Rd b/man/geo_select_aeq.Rd index 9d2ef21c..4dbd0bdc 100644 --- a/man/geo_select_aeq.Rd +++ b/man/geo_select_aeq.Rd @@ -20,12 +20,6 @@ The function is based on this stackexchange answer: \url{https://gis.stackexchange.com/questions/121489} } \examples{ -sp::bbox(routes_fast) -new_crs <- geo_select_aeq(routes_fast) -rf_projected <- sp::spTransform(routes_fast, new_crs) -sp::bbox(rf_projected) -line_length <- rgeos::gLength(rf_projected, byid = TRUE) -plot(line_length, rf_projected$length) shp <- zones_sf geo_select_aeq(shp) } diff --git a/man/geo_toptail.Rd b/man/geo_toptail.Rd index f643c24d..439fac28 100644 --- a/man/geo_toptail.Rd +++ b/man/geo_toptail.Rd @@ -8,21 +8,22 @@ geo_toptail(l, toptail_dist, ...) } \arguments{ -\item{l}{A SpatialLines object} +\item{l}{An \code{sf} object representing lines} \item{toptail_dist}{The distance (in metres) to top and tail the line by. Can either be a single value or a vector of the same length as the SpatialLines object.} -\item{...}{Arguments passed to rgeos::gBuffer()} +\item{...}{Arguments passed to \code{sf::st_buffer()}} } \description{ Takes lines and removes the start and end point, to a distance determined by the user. } \details{ -Note: \code{\link[=toptailgs]{toptailgs()}} is around 10 times faster, but only works -on data with geographic CRS's due to its reliance on the geosphere +Note: see the function +\href{https://github.com/ropensci/stplanr/blob/master/R/toptail.R#L121}{\code{toptailgs()}} +in {stplanr} v0.8.5 for an implementation that uses the geosphere package. } \examples{ @@ -30,7 +31,6 @@ lib_versions <- sf::sf_extSoftVersion() lib_versions # dont test due to issues with sp classes on some set-ups if (lib_versions[3] >= "6.3.1") { - # l <- routes_fast[2:4, ] # to run with sp classes l <- routes_fast_sf[2:4, ] l_top_tail <- geo_toptail(l, 300) l_top_tail @@ -47,17 +47,12 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/gsection.Rd b/man/gsection.Rd index 9ccbac6e..5322ec42 100644 --- a/man/gsection.Rd +++ b/man/gsection.Rd @@ -30,33 +30,13 @@ if (lib_versions[3] >= "6.3.1") { rsec <- gsection(sl, buff_dist = 50) length(rsec) # 4 features: issue plot(rsec, col = seq(length(rsec))) - # dont test due to issues with sp classes on some set-ups - # sl <- routes_fast[2:4, ] - # rsec <- gsection(sl) - # rsec_buff <- gsection(sl, buff_dist = 1) - # plot(sl[1], lwd = 9, col = 1:nrow(sl)) - # plot(rsec, col = 5 + (1:length(rsec)), add = TRUE, lwd = 3) - # plot(rsec_buff, col = 5 + (1:length(rsec_buff)), add = TRUE, lwd = 3) } } \seealso{ Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, \code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, \code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_group}()} } \concept{rnet} diff --git a/man/is_linepoint.Rd b/man/is_linepoint.Rd index 6b192ecf..9b11a005 100644 --- a/man/is_linepoint.Rd +++ b/man/is_linepoint.Rd @@ -19,12 +19,11 @@ Returns a boolean vector. TRUE means that the associated line is in fact a point (has no distance). This can be useful for removing data that will not be plotted. } \examples{ -data(flowlines) -islp <- is_linepoint(flowlines) -nrow(flowlines) +islp <- is_linepoint(flowlines_sf) +nrow(flowlines_sf) sum(islp) # Remove invisible 'linepoints' -nrow(flowlines[!islp, ]) +nrow(flowlines_sf[!islp, ]) } \seealso{ Other lines: @@ -35,17 +34,12 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/islines.Rd b/man/islines.Rd index 971df64d..bf2a8444 100644 --- a/man/islines.Rd +++ b/man/islines.Rd @@ -18,11 +18,6 @@ not. } \examples{ \dontrun{ -rnet <- overline(routes_fast[c(2, 3, 22), ], attrib = "length") -plot(rnet) -lines(routes_fast[22, ], col = "red") # line without overlaps -islines(routes_fast[2, ], routes_fast[3, ]) -islines(routes_fast[2, ], routes_fast[22, ]) # sf implementation islines(routes_fast_sf[2, ], routes_fast_sf[3, ]) islines(routes_fast_sf[2, ], routes_fast_sf[22, ]) @@ -30,22 +25,9 @@ islines(routes_fast_sf[2, ], routes_fast_sf[22, ]) } \seealso{ Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{gsection}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, \code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, \code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_group}()} } \concept{rnet} diff --git a/man/l_poly.Rd b/man/l_poly.Rd deleted file mode 100644 index 9d6c8818..00000000 --- a/man/l_poly.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{l_poly} -\alias{l_poly} -\title{Line polygon} -\format{ -A SpatialPolygon -} -\usage{ -data(l_poly) -} -\description{ -This dataset represents road width for testing. -} -\examples{ -\dontrun{ -l <- routes_fast[13, ] -l_poly <- geo_projected(l, rgeos::gBuffer, 8) -plot(l_poly) -plot(routes_fast, add = TRUE) -# allocate road width to relevant line -devtools::use_data(l_poly) -} -} -\keyword{datasets} diff --git a/man/line2df.Rd b/man/line2df.Rd index 74d65960..3e5a70b5 100644 --- a/man/line2df.Rd +++ b/man/line2df.Rd @@ -14,10 +14,6 @@ This function returns a data frame with fx and fy and tx and ty variables representing the beginning and end points of spatial line features respectively. } \examples{ -data(flowlines) -line2df(flowlines[5, ]) # beginning and end of a single straight line -line2df(flowlines) # on multiple lines -line2df(routes_fast[5:6, ]) # beginning and end of routes line2df(routes_fast_sf[5:6, ]) # beginning and end of routes } \seealso{ @@ -29,17 +25,12 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line2points.Rd b/man/line2points.Rd index 06e8ffce..04cc7c6e 100644 --- a/man/line2points.Rd +++ b/man/line2points.Rd @@ -50,17 +50,12 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line2route.Rd b/man/line2route.Rd deleted file mode 100644 index 0443ca52..00000000 --- a/man/line2route.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/od-funs.R -\name{line2route} -\alias{line2route} -\title{Convert straight OD data (desire lines) into routes} -\usage{ -line2route( - l, - route_fun = stplanr::route_cyclestreets, - n_print = 10, - list_output = FALSE, - l_id = NA, - time_delay = 0, - ... -) -} -\arguments{ -\item{l}{A spatial (linestring) object} - -\item{route_fun}{A routing function to be used for converting the straight lines to routes -\code{\link[=od2line]{od2line()}}} - -\item{n_print}{A number specifying how frequently progress updates -should be shown} - -\item{list_output}{If FALSE (default) assumes spatial (linestring) object output. Set to TRUE to save output as a list.} - -\item{l_id}{Character string naming the id field from the input lines data, -typically the origin and destination ids pasted together. If absent, the row name of the -straight lines will be used.} - -\item{time_delay}{Number or seconds to wait between each query} - -\item{...}{Arguments passed to the routing function, e.g. \code{\link[=route_cyclestreets]{route_cyclestreets()}}} -} -\description{ -Convert straight OD data (desire lines) into routes -} -\section{Details}{ - - -See \code{\link[=route_cyclestreets]{route_cyclestreets()}} and other route functions for details. - -A parallel implementation of this was available until version 0.1.8. -} - -\examples{ -\dontrun{ -# does not run as requires API key -l <- flowlines[2:5, ] -r <- line2route(l) -rq <- line2route(l = l, plan = "quietest", silent = TRUE) -rsc <- line2route(l = l, route_fun = cyclestreets::journey) -plot(r) -plot(r, col = "red", add = TRUE) -plot(rq, col = "green", add = TRUE) -plot(rsc) -plot(l, add = T) -# Plot for a single line to compare 'fastest' and 'quietest' route -n <- 2 -plot(l[n, ]) -lines(r[n, ], col = "red") -lines(rq[n, ], col = "green") -} -} -\seealso{ -Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{route_dodgr}()}, -\code{\link{route_local}()}, -\code{\link{route_osrm}()}, -\code{\link{route_transportapi_public}()}, -\code{\link{route}()} -} -\concept{routes} diff --git a/man/line2routeRetry.Rd b/man/line2routeRetry.Rd deleted file mode 100644 index 6e106664..00000000 --- a/man/line2routeRetry.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/od-funs.R -\name{line2routeRetry} -\alias{line2routeRetry} -\title{Convert straight spatial (linestring) object from flow data into routes retrying -on connection (or other) intermittent failures} -\usage{ -line2routeRetry(lines, pattern = "^Error: ", n_retry = 3, ...) -} -\arguments{ -\item{lines}{A spatial (linestring) object} - -\item{pattern}{A regex that the error messages must not match to be retried, default -"^Error: " i.e. do not retry errors starting with "Error: "} - -\item{n_retry}{Number of times to retry} - -\item{...}{Arguments passed to the routing function, e.g. \code{\link[=route_cyclestreets]{route_cyclestreets()}}} -} -\description{ -Convert straight spatial (linestring) object from flow data into routes retrying -on connection (or other) intermittent failures -} -\section{Details}{ - - -See \code{\link[=line2route]{line2route()}} for the version that is not retried on errors. -} - -\examples{ -\dontrun{ -data(flowlines) -rf_list <- line2routeRetry(flowlines[1:2, ], pattern = "nonexistanceerror", silent = F) -} -} -\seealso{ -Other routes: -\code{\link{line2route}()}, -\code{\link{route_dodgr}()}, -\code{\link{route_local}()}, -\code{\link{route_osrm}()}, -\code{\link{route_transportapi_public}()}, -\code{\link{route}()} -} -\concept{routes} diff --git a/man/lineLabels.Rd b/man/lineLabels.Rd deleted file mode 100644 index e5305a2a..00000000 --- a/man/lineLabels.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/overline.R -\name{lineLabels} -\alias{lineLabels} -\title{Label SpatialLinesDataFrame objects} -\usage{ -lineLabels(sl, attrib) -} -\arguments{ -\item{sl}{A SpatialLinesDataFrame with overlapping elements} - -\item{attrib}{A text string corresponding to a named variable in \code{sl}} -} -\description{ -This function adds labels to lines plotted using base graphics. Largely -for illustrative purposes, not designed for publication-quality -graphics. -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\author{ -Barry Rowlingson -} -\concept{rnet} diff --git a/man/line_bearing.Rd b/man/line_bearing.Rd index 9dedd0e5..36ddad11 100644 --- a/man/line_bearing.Rd +++ b/man/line_bearing.Rd @@ -13,7 +13,7 @@ line_bearing(l, bidirectional = FALSE) Default is FALSE. If TRUE, the same line in the oposite direction would have the same bearing} } \description{ -This is a simple wrapper around the geosphere function \code{\link[=bearing]{bearing()}} to return the +This function returns the bearing (in degrees relative to north) of lines. } \details{ @@ -27,11 +27,7 @@ lib_versions 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, ]) - bearings_sp_1_9 - plot(bearings_sf_1_9, bearings_sp_1_9) line_bearing(flowlines_sf[1:5, ], bidirectional = TRUE) - line_bearing(flowlines[1:5, ], bidirectional = TRUE) } } \seealso{ @@ -43,17 +39,12 @@ Other lines: \code{\link{line2points}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line_breakup.Rd b/man/line_breakup.Rd index 25016384..98f7f41e 100644 --- a/man/line_breakup.Rd +++ b/man/line_breakup.Rd @@ -41,17 +41,12 @@ Other lines: \code{\link{line2points}()}, \code{\link{line_bearing}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line_length.Rd b/man/line_length.Rd deleted file mode 100644 index 028c802b..00000000 --- a/man/line_length.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/linefuns.R -\name{line_length} -\alias{line_length} -\title{Calculate length of lines in geographic CRS} -\usage{ -line_length(l, byid = TRUE) -} -\arguments{ -\item{l}{A spatial lines object} - -\item{byid}{Logical determining whether the length is returned per object (default is true)} -} -\description{ -Calculate length of lines in geographic CRS -} diff --git a/man/line_midpoint.Rd b/man/line_midpoint.Rd index 3d5ab931..f8c74bd6 100644 --- a/man/line_midpoint.Rd +++ b/man/line_midpoint.Rd @@ -4,18 +4,22 @@ \alias{line_midpoint} \title{Find the mid-point of lines} \usage{ -line_midpoint(l) +line_midpoint(l, tolerance = NULL) } \arguments{ \item{l}{A spatial lines object} + +\item{tolerance}{The tolerance used to break lines at verteces. +See \code{\link[lwgeom:st_linesubstring]{lwgeom::st_linesubstring()}}.} } \description{ -This is a wrapper around \code{\link[=SpatialLinesMidPoints]{SpatialLinesMidPoints()}} that allows it to find the midpoint -of lines that are not projected, which have a lat/long CRS. +Find the mid-point of lines } \examples{ -data(routes_fast) -line_midpoint(routes_fast[2:5, ]) +l = routes_fast_sf[2:5, ] +plot(l$geometry, col = 2:5) +midpoints = line_midpoint(l) +plot(midpoints, add = TRUE) } \seealso{ Other lines: @@ -26,17 +30,12 @@ Other lines: \code{\link{line2points}()}, \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line_sample.Rd b/man/line_sample.Rd deleted file mode 100644 index 90881ca9..00000000 --- a/man/line_sample.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/line_sample.R -\name{line_sample} -\alias{line_sample} -\title{Sample n points along lines with density proportional to a weight} -\usage{ -line_sample(l, n, weights) -} -\arguments{ -\item{l}{The SpatialLines object along which to create sample points} - -\item{n}{The total number of points to sample} - -\item{weights}{The relative probabilities of lines being samples} -} -\description{ -Sample n points along lines with density proportional to a weight -} -\examples{ -l <- flowlines[2:5, ] -n <- 100 -l_lengths <- line_length(l) -weights <- l$All -p <- line_sample(l, 50, weights) -plot(p) -p <- line_sample(l, 50, weights = 1:length(l)) -plot(p) -} -\seealso{ -Other lines: -\code{\link{angle_diff}()}, -\code{\link{geo_toptail}()}, -\code{\link{is_linepoint}()}, -\code{\link{line2df}()}, -\code{\link{line2points}()}, -\code{\link{line_bearing}()}, -\code{\link{line_breakup}()}, -\code{\link{line_midpoint}()}, -\code{\link{line_segment_sf}()}, -\code{\link{line_segment}()}, -\code{\link{line_via}()}, -\code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, -\code{\link{n_vertices}()}, -\code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} -} -\concept{lines} diff --git a/man/line_segment.Rd b/man/line_segment.Rd index 6f28b029..63601917 100644 --- a/man/line_segment.Rd +++ b/man/line_segment.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/linefuns.R \name{line_segment} \alias{line_segment} -\title{Divide SpatialLines dataset into regular segments} +\title{Divide sf LINESTRING objects into regular segments} \usage{ line_segment(l, n_segments, segment_length = NA) } @@ -14,14 +14,12 @@ line_segment(l, n_segments, segment_length = NA) \item{segment_length}{The approximate length of segments in the output (overides n_segments if set)} } \description{ -Divide SpatialLines dataset into regular segments +Divide sf LINESTRING objects into regular segments } \examples{ -data(routes_fast) -l <- routes_fast[2, ] -library(sp) +l <- routes_fast_sf[2, ] l_seg2 <- line_segment(l = l, n_segments = 2) -plot(l_seg2, col = l_seg2$group, lwd = 50) +plot(sf::st_geometry(l_seg2), col = 1:2, lwd = 5) } \seealso{ Other lines: @@ -33,16 +31,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/line_segment_sf.Rd b/man/line_segment_sf.Rd deleted file mode 100644 index 76598a95..00000000 --- a/man/line_segment_sf.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/line_segment.R -\name{line_segment_sf} -\alias{line_segment_sf} -\title{Divide sf LINESTRING objects into regular segments} -\usage{ -line_segment_sf(l, n_segments, segment_length = NA) -} -\arguments{ -\item{l}{A spatial lines object} - -\item{n_segments}{The number of segments to divide the line into} - -\item{segment_length}{The approximate length of segments in the output (overides n_segments if set)} -} -\description{ -Divide sf LINESTRING objects into regular segments -} -\examples{ -l <- routes_fast_sf[2, ] -l_seg2 <- line_segment_sf(l = l, n_segments = 2) -plot(sf::st_geometry(l_seg2), col = 1:2, lwd = 5) -} -\seealso{ -Other lines: -\code{\link{angle_diff}()}, -\code{\link{geo_toptail}()}, -\code{\link{is_linepoint}()}, -\code{\link{line2df}()}, -\code{\link{line2points}()}, -\code{\link{line_bearing}()}, -\code{\link{line_breakup}()}, -\code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment}()}, -\code{\link{line_via}()}, -\code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, -\code{\link{n_vertices}()}, -\code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} -} -\concept{lines} diff --git a/man/line_via.Rd b/man/line_via.Rd index 739c3243..8f4b19ba 100644 --- a/man/line_via.Rd +++ b/man/line_via.Rd @@ -46,16 +46,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/mats2line.Rd b/man/mats2line.Rd index 7285a9e0..996ed059 100644 --- a/man/mats2line.Rd +++ b/man/mats2line.Rd @@ -37,16 +37,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/n_sample_length.Rd b/man/n_sample_length.Rd deleted file mode 100644 index 895e6704..00000000 --- a/man/n_sample_length.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/line_sample.R -\name{n_sample_length} -\alias{n_sample_length} -\title{Sample integer number from given continuous vector of line lengths and probabilities, with total n} -\usage{ -n_sample_length(n, l_lengths, weights) -} -\arguments{ -\item{n}{Sum of integer values returned} - -\item{l_lengths}{Numeric vector of line lengths} - -\item{weights}{Relative probabilities of samples on lines} -} -\description{ -Sample integer number from given continuous vector of line lengths and probabilities, with total n -} -\examples{ -n <- 10 -l_lengths <- 1:5 -weights <- 9:5 -(res <- n_sample_length(n, l_lengths, weights)) -sum(res) -n <- 100 -l_lengths <- c(12, 22, 15, 14) -weights <- c(38, 10, 44, 34) -(res <- n_sample_length(n, l_lengths, weights)) -sum(res) -# more examples: -n_sample_length(5, 1:5, c(0.1, 0.9, 0, 0, 0)) -n_sample_length(5, 1:5, c(0.5, 0.3, 0.1, 0, 0)) -l <- flowlines[2:6, ] -l_lengths <- line_length(l) -n <- n_sample_length(10, l_lengths, weights = l$All) -} -\seealso{ -Other lines: -\code{\link{angle_diff}()}, -\code{\link{geo_toptail}()}, -\code{\link{is_linepoint}()}, -\code{\link{line2df}()}, -\code{\link{line2points}()}, -\code{\link{line_bearing}()}, -\code{\link{line_breakup}()}, -\code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, -\code{\link{line_segment}()}, -\code{\link{line_via}()}, -\code{\link{mats2line}()}, -\code{\link{n_vertices}()}, -\code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} -} -\concept{lines} diff --git a/man/n_vertices.Rd b/man/n_vertices.Rd index f7a1956b..b2a77bae 100644 --- a/man/n_vertices.Rd +++ b/man/n_vertices.Rd @@ -2,23 +2,20 @@ % Please edit documentation in R/linefuns.R \name{n_vertices} \alias{n_vertices} -\title{Retrieve the number of vertices from a SpatialLines or SpatialPolygons object} +\title{Retrieve the number of vertices in sf objects} \usage{ n_vertices(l) } \arguments{ -\item{l}{A SpatialLines or SpatalPolygons object} +\item{l}{An sf object with LINESTRING geometry} } \description{ -Returns a vector of the same length as the number of lines, -with the number of vertices per line or polygon. -} -\details{ -See \url{https://gis.stackexchange.com/questions/58147/} for more information. +Returns a vector of the same length as the number of sf objects. } \examples{ -n_vertices(routes_fast) -n_vertices(routes_fast_sf) +l = routes_fast_sf +n_vertices(l) +n_vertices(zones_sf) } \seealso{ Other lines: @@ -30,16 +27,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{onewaygeo}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/nearest_cyclestreets.Rd b/man/nearest_cyclestreets.Rd deleted file mode 100644 index fc2cfc4a..00000000 --- a/man/nearest_cyclestreets.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cyclestreets.R -\name{nearest_cyclestreets} -\alias{nearest_cyclestreets} -\title{Generate nearest point on the route network of a point using the CycleStreets.net} -\usage{ -nearest_cyclestreets(shp = NULL, lat, lng, pat = api_pat("cyclestreet")) -} -\arguments{ -\item{shp}{A spatial object} - -\item{lat}{Numeric vector containing latitude coordinate for each coordinate -to map. Also accepts dataframe with latitude in the first column and -longitude in the second column.} - -\item{lng}{Numeric vector containing longitude coordinate for each -coordinate to map.} - -\item{pat}{The API key used. By default this is set to NULL and -this is usually aquired automatically through a helper, api_pat().} -} -\description{ -Generate nearest point on the route network of a point using the CycleStreets.net -} -\section{Details}{ - -Retrieve coordinates of the node(s) on the network mapped from coordinates -passed to functions. - -Note: there is now a dedicated cyclestreets package: -https://github.com/Robinlovelace/cyclestreets -} - -\examples{ -\dontrun{ -nearest_cyclestreets(53, 0.02, pat = Sys.getenv("CYCLESTREETS")) -nearest_cyclestreets(cents[1, ], pat = Sys.getenv("CYCLESTREETS")) -nearest_cyclestreets(cents_sf[1, ], pat = Sys.getenv("CYCLESTREETS")) -} -} diff --git a/man/nearest_google.Rd b/man/nearest_google.Rd deleted file mode 100644 index f6b01ddc..00000000 --- a/man/nearest_google.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/google-functions.R -\name{nearest_google} -\alias{nearest_google} -\title{Generate nearest point on the route network of a point using the Google Maps API} -\usage{ -nearest_google(lat, lng, google_api) -} -\arguments{ -\item{lat}{Numeric vector containing latitude coordinate for each coordinate -to map. Also accepts dataframe with latitude in the first column and -longitude in the second column.} - -\item{lng}{Numeric vector containing longitude coordinate for each -coordinate to map.} - -\item{google_api}{String value containing the Google API key to use.} -} -\description{ -Generate nearest point on the route network of a point using the Google Maps API -} -\section{Details}{ - -Retrieve coordinates of the node(s) on the network mapped from coordinates -passed to functions. -} - -\examples{ -\dontrun{ -nearest_google(lat = 50.333, lng = 3.222, google_api = "api_key_here") -} -} -\seealso{ -Other nodes: -\code{\link{geo_code}()} -} -\concept{nodes} diff --git a/man/od2line.Rd b/man/od2line.Rd index 8b5a6330..0e38a9be 100644 --- a/man/od2line.Rd +++ b/man/od2line.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/od-funs.R \name{od2line} \alias{od2line} -\alias{od2line2} \title{Convert origin-destination data to spatial lines} \usage{ od2line( @@ -15,13 +14,11 @@ od2line( zone_code_d = NA, silent = FALSE ) - -od2line2(flow, zones) } \arguments{ \item{flow}{A data frame representing origin-destination data. The first two columns of this data frame should correspond -to the first column of the data in the zones. Thus in \code{\link[=cents]{cents()}}, +to the first column of the data in the zones. Thus in \code{\link[=cents_sf]{cents_sf()}}, the first column is geo_code. This corresponds to the first two columns of \code{\link[=flow]{flow()}}.} @@ -68,24 +65,14 @@ od_data <- stplanr::flow[1:20, ] l <- od2line(flow = od_data, zones = cents_sf) plot(sf::st_geometry(cents_sf)) plot(l, lwd = l$All / mean(l$All), add = TRUE) -l <- od2line(flow = od_data, zones = cents) -# When destinations are different -head(destinations[1:5]) -od_data2 <- flow_dests[1:12, 1:3] -od_data2 -flowlines_dests <- od2line(od_data2, cents_sf, destinations = destinations_sf) -flowlines_dests -plot(flowlines_dests) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od2odf.Rd b/man/od2odf.Rd index d7bcad40..5a0c4961 100644 --- a/man/od2odf.Rd +++ b/man/od2odf.Rd @@ -9,7 +9,7 @@ od2odf(flow, zones) \arguments{ \item{flow}{A data frame representing origin-destination data. The first two columns of this data frame should correspond -to the first column of the data in the zones. Thus in \code{\link[=cents]{cents()}}, +to the first column of the data in the zones. Thus in \code{\link[=cents_sf]{cents_sf()}}, the first column is geo_code. This corresponds to the first two columns of \code{\link[=flow]{flow()}}.} @@ -24,26 +24,22 @@ Origin-destination (OD) data is often provided in the form of 1 line per OD pair, with zone codes of the trip origin in the first column and the zone codes of the destination in the second column (see the \href{https://docs.ropensci.org/stplanr/articles/stplanr-od.html}{\code{vignette("stplanr-od")}}) for details. -\code{od2odf()} creates an 'origin-destination data frame', based on a data frame containing -origin and destination cones (\code{flow}) that match the first column in a -a spatial (polygon or point) object (\code{zones}). +\code{od2odf()} creates an 'origin-destination data frame', with columns containing +origin and destination codes (\code{flow}) that match the first column in a +a spatial (polygon or point \code{sf}) object (\code{zones}). The function returns a data frame with coordinates for the origin and destination. } \examples{ -data(flow) -data(zones) -od2odf(flow[1:2, ], zones) +od2odf(flow[1:2, ], zones_sf) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od_aggregate_from.Rd b/man/od_aggregate_from.Rd index 7241e24a..09c61a17 100644 --- a/man/od_aggregate_from.Rd +++ b/man/od_aggregate_from.Rd @@ -9,7 +9,7 @@ od_aggregate_from(flow, attrib = NULL, FUN = sum, ..., col = 1) \arguments{ \item{flow}{A data frame representing origin-destination data. The first two columns of this data frame should correspond -to the first column of the data in the zones. Thus in \code{\link[=cents]{cents()}}, +to the first column of the data in the zones. Thus in \code{\link[=cents_sf]{cents_sf()}}, the first column is geo_code. This corresponds to the first two columns of \code{\link[=flow]{flow()}}.} @@ -36,13 +36,11 @@ od_aggregate_from(flow) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od_aggregate_to.Rd b/man/od_aggregate_to.Rd index bae6ff0f..6ff03629 100644 --- a/man/od_aggregate_to.Rd +++ b/man/od_aggregate_to.Rd @@ -9,7 +9,7 @@ od_aggregate_to(flow, attrib = NULL, FUN = sum, ..., col = 2) \arguments{ \item{flow}{A data frame representing origin-destination data. The first two columns of this data frame should correspond -to the first column of the data in the zones. Thus in \code{\link[=cents]{cents()}}, +to the first column of the data in the zones. Thus in \code{\link[=cents_sf]{cents_sf()}}, the first column is geo_code. This corresponds to the first two columns of \code{\link[=flow]{flow()}}.} @@ -36,13 +36,11 @@ od_aggregate_to(flow) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od_coords.Rd b/man/od_coords.Rd index a986ac5c..a02e8d46 100644 --- a/man/od_coords.Rd +++ b/man/od_coords.Rd @@ -21,21 +21,17 @@ and returns a matrix of coordinates representing origin (fx, fy) and destination } \examples{ od_coords(from = c(0, 52), to = c(1, 53)) # lon/lat coordinates -od_coords(from = cents[1, ], to = cents[2, ]) # Spatial points od_coords(cents_sf[1:3, ], cents_sf[2:4, ]) # sf points # od_coords("Hereford", "Leeds") # geocode locations -od_coords(flowlines[1:3, ]) od_coords(flowlines_sf[1:3, ]) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od_coords2line.Rd b/man/od_coords2line.Rd index a080699c..368c20ba 100644 --- a/man/od_coords2line.Rd +++ b/man/od_coords2line.Rd @@ -39,13 +39,11 @@ nrow(l_with_duplicates) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/od_dist.Rd b/man/od_dist.Rd deleted file mode 100644 index 1eb517c9..00000000 --- a/man/od_dist.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/od-funs.R -\name{od_dist} -\alias{od_dist} -\title{Quickly calculate Euclidean distances of od pairs} -\usage{ -od_dist(flow, zones) -} -\arguments{ -\item{flow}{A data frame representing origin-destination data. -The first two columns of this data frame should correspond -to the first column of the data in the zones. Thus in \code{\link[=cents]{cents()}}, -the first column is geo_code. This corresponds to the first two columns -of \code{\link[=flow]{flow()}}.} - -\item{zones}{A spatial object representing origins (and destinations -if no separate destinations object is provided) of travel.} -} -\description{ -It is common to want to know the Euclidean distance between origins and destinations -in OD data. You can calculate this by first converting OD data to SpatialLines data, -e.g. with \code{\link[=od2line]{od2line()}}. However this can be slow and overkill if you just -want to know the distance. This function is a few orders of magnitude faster. -} -\details{ -Note: this function assumes that the zones or centroids in \code{cents} have a geographic -(lat/lon) CRS. -} -\examples{ -data(flow) -data(cents) -od_dist(flow, cents) -} -\seealso{ -Other od: -\code{\link{dist_google}()}, -\code{\link{od2line}()}, -\code{\link{od2odf}()}, -\code{\link{od_aggregate_from}()}, -\code{\link{od_aggregate_to}()}, -\code{\link{od_coords2line}()}, -\code{\link{od_coords}()}, -\code{\link{od_id}}, -\code{\link{od_oneway}()}, -\code{\link{od_to_odmatrix}()}, -\code{\link{odmatrix_to_od}()}, -\code{\link{points2flow}()}, -\code{\link{points2odf}()} -} -\concept{od} diff --git a/man/od_id.Rd b/man/od_id.Rd index 3c832e72..70387085 100644 --- a/man/od_id.Rd +++ b/man/od_id.Rd @@ -48,14 +48,12 @@ od_id_max_min(d[[1]], d[[2]]) od_oneway Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, \code{\link{odmatrix_to_od}()}, diff --git a/man/od_oneway.Rd b/man/od_oneway.Rd index 413930e0..cd689c99 100644 --- a/man/od_oneway.Rd +++ b/man/od_oneway.Rd @@ -45,7 +45,7 @@ If only the largest flow in either direction is captured in an analysis, for example, the true extent of travel will by heavily under-estimated for OD pairs which have similar amounts of travel in both directions. Flows in both direction are often represented by overlapping lines with -identical geometries (see \code{\link[=flowlines]{flowlines()}}) which can be confusing +identical geometries which can be confusing for users and are difficult to plot. } \examples{ @@ -59,30 +59,17 @@ attrib <- which(vapply(flow, is.numeric, TRUE)) flow_oneway <- od_oneway(flow, attrib = attrib) colSums(flow_oneway[attrib]) == colSums(flow[attrib]) # test if the colSums are equal # Demonstrate the results from oneway and onewaygeo are identical -flow_oneway_geo <- onewaygeo(flowlines, attrib = attrib) flow_oneway_sf <- od_oneway(flowlines_sf) -par(mfrow = c(1, 2)) -plot(flow_oneway_geo, lwd = flow_oneway_geo$All / mean(flow_oneway_geo$All)) plot(flow_oneway_sf$geometry, lwd = flow_oneway_sf$All / mean(flow_oneway_sf$All)) -par(mfrow = c(1, 1)) -od_max_min <- od_oneway(od_min, stplanr.key = od_id_character(od_min[[1]], od_min[[2]])) -cor(od_max_min$all, od_oneway$all) -# benchmark performance -# bench::mark(check = FALSE, iterations = 3, -# onewayid(flowlines_sf, attrib), -# od_oneway(flowlines_sf) -# ) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_to_odmatrix}()}, \code{\link{odmatrix_to_od}()}, diff --git a/man/od_to_odmatrix.Rd b/man/od_to_odmatrix.Rd index 2aa72cfe..3cc15393 100644 --- a/man/od_to_odmatrix.Rd +++ b/man/od_to_odmatrix.Rd @@ -31,14 +31,12 @@ od_to_odmatrix(flow[1:9, ], attrib = "Bicycle") } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{odmatrix_to_od}()}, diff --git a/man/odmatrix_to_od.Rd b/man/odmatrix_to_od.Rd index d441f5d4..fbb61350 100644 --- a/man/odmatrix_to_od.Rd +++ b/man/odmatrix_to_od.Rd @@ -29,14 +29,12 @@ odmatrix_to_od(od_to_odmatrix(flow[1:9, 1:3])) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/onewaygeo.Rd b/man/onewaygeo.Rd index d50375db..9e629298 100644 --- a/man/onewaygeo.Rd +++ b/man/onewaygeo.Rd @@ -24,30 +24,12 @@ the magnitude of flow along a route can be masked by flows the other direction. If only the largest flow in either direction is captured in an analysis, for example, the true extent of travel will by heavily under-estimated for OD pairs which have similar amounts of travel in both directions. -Flows in both direction are often represented by overlapping lines with -identical geometries (see \code{\link[=flowlines]{flowlines()}}) which can be confusing -for users and are difficult to plot. } \details{ This function aggregates directional flows into non-directional flows, potentially halving the number of lines objects and reducing the number of overlapping lines to zero. } -\examples{ -plot(flowlines[1:30, ], lwd = flowlines$On.foot[1:30]) -singlines <- onewaygeo(flowlines[1:30, ], attrib = which(names(flowlines) == "On.foot")) -plot(singlines, lwd = singlines$On.foot / 2, col = "red", add = TRUE) -\dontrun{ -plot(flowlines, lwd = flowlines$All / 10) -singlelines <- onewaygeo(flowlines, attrib = 3:14) -plot(singlelines, lwd = singlelines$All / 20, col = "red", add = TRUE) -sum(singlelines$All) == sum(flowlines$All) -nrow(singlelines) -singlelines_sf <- onewaygeo(flowlines_sf, attrib = 3:14) -sum(singlelines_sf$All) == sum(flowlines_sf$All) -summary(singlelines$All == singlelines_sf$All) -} -} \seealso{ Other lines: \code{\link{angle_diff}()}, @@ -58,16 +40,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/overline.Rd b/man/overline.Rd index 1503308a..37d9bbb2 100644 --- a/man/overline.Rd +++ b/man/overline.Rd @@ -93,7 +93,7 @@ as it does not help with other stages. } \examples{ sl <- routes_fast_sf[2:4, ] -sl$All <- flowlines$All[2:4] +sl$All <- flowlines_sf$All[2:4] rnet <- overline(sl = sl, attrib = "All") nrow(sl) nrow(rnet) @@ -106,12 +106,6 @@ summary(n_vertices(rnet_sf_raw)) plot(rnet_sf_raw) rnet_sf_raw$n <- 1:nrow(rnet_sf_raw) plot(rnet_sf_raw[10:25, ]) -# legacy implementation based on sp data -# sl <- routes_fast[2:4, ] -# rnet1 <- overline(sl = sl, attrib = "length") -# rnet2 <- overline(sl = sl, attrib = "length", buff_dist = 1) -# plot(rnet1, lwd = rnet1$length / mean(rnet1$length)) -# plot(rnet2, lwd = rnet2$length / mean(rnet2$length)) } \references{ Morgan M and Lovelace R (2020). Travel flow aggregation: Nationally scalable methods @@ -125,42 +119,16 @@ segments. Reproducible question from \url{https://gis.stackexchange.com}. See } \seealso{ Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{gsection}()}, \code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, \code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_group}()} Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{gsection}()}, \code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, \code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_group}()} } \author{ Barry Rowlingson diff --git a/man/overline_spatial.Rd b/man/overline_spatial.Rd deleted file mode 100644 index 8f765d07..00000000 --- a/man/overline_spatial.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/overline.R -\name{overline_spatial} -\alias{overline_spatial} -\title{Spatial aggregation of routes represented with sp classes} -\usage{ -overline_spatial(sl, attrib, fun = sum, na.zero = FALSE, buff_dist = 0) -} -\arguments{ -\item{sl}{SpatialLinesDataFrame with overlapping Lines to split by -number of overlapping features.} - -\item{attrib}{character, column names in sl to be aggregated} - -\item{fun}{Named list of functions to summaries the attributes by? \code{sum} is the default. -\code{list(sum = sum, average = mean)} will summarise all \code{attrib}utes by sum and mean.} - -\item{na.zero}{Sets whether aggregated values with a value of zero are -removed.} - -\item{buff_dist}{A number specifying the distance in meters of the buffer to be used to crop lines before running the operation. -If the distance is zero (the default) touching but non-overlapping lines may be aggregated.} -} -\description{ -This function, largely superseded by sf implementations, still works -but is not particularly fast. -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/plot-SpatialLinesNetwork-ANY-method.Rd b/man/plot-SpatialLinesNetwork-ANY-method.Rd deleted file mode 100644 index bf0ed741..00000000 --- a/man/plot-SpatialLinesNetwork-ANY-method.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{plot,SpatialLinesNetwork,ANY-method} -\alias{plot,SpatialLinesNetwork,ANY-method} -\title{Plot a SpatialLinesNetwork} -\usage{ -\S4method{plot}{SpatialLinesNetwork,ANY}(x, component = "sl", ...) -} -\arguments{ -\item{x}{The SpatialLinesNetwork to plot} - -\item{component}{The component of the network to plot. Valid values are "sl" -for the geographic (SpatialLines) representation or "graph" for the graph -representation.} - -\item{...}{Arguments to pass to relevant plot function.} -} -\description{ -Plot a SpatialLinesNetwork -} -\examples{ -sln <- SpatialLinesNetwork(route_network) -plot(sln) -plot(sln, component = "graph") -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/plot-sfNetwork-ANY-method.Rd b/man/plot-sfNetwork-ANY-method.Rd deleted file mode 100644 index 4f57e133..00000000 --- a/man/plot-sfNetwork-ANY-method.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{plot,sfNetwork,ANY-method} -\alias{plot,sfNetwork,ANY-method} -\title{Plot an sfNetwork} -\usage{ -\S4method{plot}{sfNetwork,ANY}(x, component = "sl", ...) -} -\arguments{ -\item{x}{The sfNetwork to plot} - -\item{component}{The component of the network to plot. Valid values are "sl" -for the geographic (sf) representation or "graph" for the graph -representation.} - -\item{...}{Arguments to pass to relevant plot function.} -} -\description{ -Plot an sfNetwork -} -\examples{ -sln_sf <- SpatialLinesNetwork(route_network_sf) -plot(sln_sf) -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/points2flow.Rd b/man/points2flow.Rd index e79ac68d..9c00cc9a 100644 --- a/man/points2flow.Rd +++ b/man/points2flow.Rd @@ -15,23 +15,17 @@ representing the potential flows, or 'spatial interaction', between every combin of points. } \examples{ -data(cents) -plot(cents) -flow <- points2flow(cents) -plot(flow, add = TRUE) -flow_sf <- points2flow(cents_sf) +flow_sf <- points2flow(cents_sf[1:4, ]) plot(flow_sf) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/points2line.Rd b/man/points2line.Rd index f00ecd06..30e3918f 100644 --- a/man/points2line.Rd +++ b/man/points2line.Rd @@ -10,19 +10,10 @@ points2line(p) \item{p}{A spatial (points) obect or matrix representing the coordinates of points.} } \description{ -This is a simple wrapper around \code{\link[=spLines]{spLines()}} that makes the creation of -\code{SpatialLines} objects easy and intuitive +This function makes that makes the creation of \code{sf} +objects with LINESTRING geometries easy. } \examples{ -p <- matrix(1:4, ncol = 2) -library(sp) -l <- points2line(p) -plot(l) -l <- points2line(cents) -plot(l) -p <- line2points(routes_fast) -l <- points2line(p) -plot(l) l_sf <- points2line(cents_sf) plot(l_sf) } @@ -36,16 +27,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{toptail_buff}()} } \concept{lines} diff --git a/man/points2odf.Rd b/man/points2odf.Rd index 9b7dcdec..ab9e91c4 100644 --- a/man/points2odf.Rd +++ b/man/points2odf.Rd @@ -15,22 +15,16 @@ representing the potential flows, or 'spatial interaction', between every combin of points. } \examples{ -data(cents) -df <- points2odf(cents) -cents_centroids <- rgeos::gCentroid(cents, byid = TRUE) -df2 <- points2odf(cents_centroids) -df3 <- points2odf(cents_sf) +points2odf(cents_sf) } \seealso{ Other od: -\code{\link{dist_google}()}, \code{\link{od2line}()}, \code{\link{od2odf}()}, \code{\link{od_aggregate_from}()}, \code{\link{od_aggregate_to}()}, \code{\link{od_coords2line}()}, \code{\link{od_coords}()}, -\code{\link{od_dist}()}, \code{\link{od_id}}, \code{\link{od_oneway}()}, \code{\link{od_to_odmatrix}()}, diff --git a/man/quadrant.Rd b/man/quadrant.Rd index 94c89055..270df7d6 100644 --- a/man/quadrant.Rd +++ b/man/quadrant.Rd @@ -4,36 +4,30 @@ \alias{quadrant} \title{Split a spatial object into quadrants} \usage{ -quadrant(sp_obj, number_out = FALSE) +quadrant(x, cent = NULL, number_out = FALSE) } \arguments{ -\item{sp_obj}{Spatial object} +\item{x}{Object of class sf} -\item{number_out}{Should the output be numbers from 1:4 (FALSE by default)} +\item{cent}{The centrepoint of the region of interest. +Quadrants will be defined based on this point. +By default this will be the geographic centroid of the zones.} + +\item{number_out}{Should the result be returned as a number?} } \description{ -Split a spatial object (initially tested on SpatialPolygons) into quadrants. -} -\details{ 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. } \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)) +x = zones_sf +(quads <- quadrant(x)) +plot(x$geometry, col = factor(quads)) } \seealso{ Other geo: \code{\link{bbox_scale}()}, \code{\link{geo_bb_matrix}()}, -\code{\link{geo_bb}()}, -\code{\link{reproject}()} +\code{\link{geo_bb}()} } \concept{geo} diff --git a/man/read_table_builder.Rd b/man/read_table_builder.Rd index d7dcc478..dc70441d 100644 --- a/man/read_table_builder.Rd +++ b/man/read_table_builder.Rd @@ -34,18 +34,10 @@ census and other datasets in a format that is difficult to use in R because it contains rows with additional information. This function imports the original (unzipped) TableBuilder files in .csv or .xlsx format before creating an R dataframe with the data. -} -\examples{ -data_dir <- system.file("extdata", package = "stplanr") -t1 <- read_table_builder(file.path(data_dir, "SA1Population.csv")) -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) -t3 <- read_table_builder(sa1pop) +Note: we recommend using the +\href{https://github.com/mattcowgill/readabs}{readabs} +package for this purpose. } + \concept{data} diff --git a/man/reproject.Rd b/man/reproject.Rd deleted file mode 100644 index df759bd3..00000000 --- a/man/reproject.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/crs-funs.R -\name{reproject} -\alias{reproject} -\title{Reproject lat/long spatial object so that they are in units of 1m} -\usage{ -reproject(shp, crs = geo_select_aeq(shp)) -} -\arguments{ -\item{shp}{A spatial object with a geographic (WGS84) coordinate system} - -\item{crs}{An optional coordinate reference system (if not provided it is set -automatically by \code{\link[=geo_select_aeq]{geo_select_aeq()}}).} -} -\description{ -Many GIS functions (e.g. finding the area) -} -\examples{ -data(routes_fast) -rf_aeq <- reproject(routes_fast[1:3, ]) -rf_osgb <- reproject(routes_fast[1:3, ], 27700) -} -\seealso{ -Other geo: -\code{\link{bbox_scale}()}, -\code{\link{geo_bb_matrix}()}, -\code{\link{geo_bb}()}, -\code{\link{quadrant}()} -} -\concept{geo} diff --git a/man/rnet_breakup_vertices.Rd b/man/rnet_breakup_vertices.Rd index 1b954564..ef93ffdb 100644 --- a/man/rnet_breakup_vertices.Rd +++ b/man/rnet_breakup_vertices.Rd @@ -18,7 +18,7 @@ up the input object. } \description{ This function breaks up a LINESTRING geometry into multiple LINESTRING(s). It -is used mainly for preserving routability of an \code{sfNetwork} object that is +is used mainly for preserving routability of an object that is created using Open Street Map data. See details, \href{https://github.com/ropensci/stplanr/issues/282}{stplanr/issues/282}, and \href{https://github.com/ropensci/stplanr/issues/416}{stplanr/issues/416}. @@ -34,13 +34,13 @@ LINESTRING (see the rnet_cycleway_intersection example). } The problem with the first example is that, according to algorithm behind -\code{\link[=SpatialLinesNetwork]{SpatialLinesNetwork()}}, two LINESTRINGS are connected if and only if they +\code{SpatialLinesNetwork()}, two LINESTRINGS are connected if and only if they share at least one point in their boundaries. The roads and the roundabout are clearly connected in the "real" world but the corresponding LINESTRING objects do not share two distinct boundary points. In fact, by Open Street Map standards, a roundabout is represented as a closed and circular LINESTRING, and this implies that the roundabout is not connected to the -other roads according to \code{\link[=SpatialLinesNetwork]{SpatialLinesNetwork()}} definition. By the same +other roads according to \code{SpatialLinesNetwork()} definition. By the same reasoning, the roads in the second example are clearly connected in the "real" world, but they do not share any point in their boundaries. This function is used to solve this type of problem. @@ -115,22 +115,9 @@ par(def_par) } \seealso{ Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{gsection}()}, \code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, \code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_group}()} } \concept{rnet} diff --git a/man/rnet_group.Rd b/man/rnet_group.Rd index d1037f72..d1245356 100644 --- a/man/rnet_group.Rd +++ b/man/rnet_group.Rd @@ -5,7 +5,6 @@ \alias{rnet_group.default} \alias{rnet_group.sfc} \alias{rnet_group.sf} -\alias{rnet_group.sfNetwork} \title{Assign segments in a route network to groups} \usage{ rnet_group(rnet, ...) @@ -27,8 +26,6 @@ rnet_group(rnet, ...) as.undirected = TRUE, ... ) - -\method{rnet_group}{sfNetwork}(rnet, cluster_fun = igraph::clusters, ...) } \arguments{ \item{rnet}{An sf, sfc, or sfNetwork object representing a route network.} @@ -81,30 +78,12 @@ rnet$group_louvain <- rnet_group(rnet, igraph::cluster_louvain) plot(rnet["group_louvain"]) rnet$group_fast_greedy <- rnet_group(rnet, igraph::cluster_fast_greedy) plot(rnet["group_fast_greedy"]) - -# show sfNetwork implementation -sfn <- SpatialLinesNetwork(rnet) -sfn <- rnet_group(sfn) -plot(sfn@sl["rnet_group"]) } \seealso{ Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, \code{\link{gsection}()}, \code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, \code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} +\code{\link{rnet_breakup_vertices}()} } \concept{rnet} diff --git a/man/route.Rd b/man/route.Rd index f56c91b2..22c47c47 100644 --- a/man/route.Rd +++ b/man/route.Rd @@ -22,11 +22,9 @@ route( \item{to}{An object representing destinations} -\item{l}{Only needed if from and to are empty, in which case this -should be a spatial object representing desire lines} +\item{l}{A spatial (linestring) object} -\item{route_fun}{A routing function to be used for converting the straight lines to routes -\code{\link[=od2line]{od2line()}}} +\item{route_fun}{A routing function to be used for converting the lines to routes} \item{wait}{How long to wait between routes? 0 seconds by default, can be useful when sending requests to rate limited APIs.} @@ -34,11 +32,12 @@ should be a spatial object representing desire lines} \item{n_print}{A number specifying how frequently progress updates should be shown} -\item{list_output}{If FALSE (default) assumes spatial (linestring) object output. Set to TRUE to save output as a list.} +\item{list_output}{If FALSE (default) assumes spatial (linestring) object output. +Set to TRUE to save output as a list.} \item{cl}{Cluster} -\item{...}{Arguments passed to the routing function, e.g. \code{\link[=route_cyclestreets]{route_cyclestreets()}}} +\item{...}{Arguments passed to the routing function} } \description{ Takes origins and destinations, finds the optimal routes between them @@ -46,46 +45,15 @@ and returns the result as a spatial (sf or sp) object. The definition of optimal depends on the routing function used } \examples{ -library(sf) -l = od_data_lines[2, ] -\donttest{ -if(curl::has_internet()) { -r_walk = route(l = l, route_fun = route_osrm, osrm.profile = "foot") -r_bike = route(l = l, route_fun = route_osrm, osrm.profile = "bike") -plot(r_walk$geometry) -plot(r_bike$geometry, col = "blue", add = TRUE) -# r_bc = route(l = l, route_fun = route_bikecitizens) -# plot(r_bc) -# route(l = l, route_fun = route_bikecitizens, wait = 1) -library(osrm) -r_osrm <- route( - l = l, - route_fun = osrmRoute, - returnclass = "sf" -) -nrow(r_osrm) -plot(r_osrm) -sln <- stplanr::SpatialLinesNetwork(route_network_sf) -# calculate shortest paths -plot(sln) -plot(l$geometry, add = TRUE) -r_local <- stplanr::route( - l = l, - route_fun = stplanr::route_local, - sln = sln -) -plot(r_local["all"], add = TRUE, lwd = 5) - -} -} +# Todo: add examples } \seealso{ Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{line2route}()}, \code{\link{route_dodgr}()}, -\code{\link{route_local}()}, -\code{\link{route_osrm}()}, -\code{\link{route_transportapi_public}()} +\code{\link{route_osrm}()} + +Other routes: +\code{\link{route_dodgr}()}, +\code{\link{route_osrm}()} } \concept{routes} diff --git a/man/route_cyclestreets.Rd b/man/route_cyclestreets.Rd deleted file mode 100644 index d5580e1b..00000000 --- a/man/route_cyclestreets.Rd +++ /dev/null @@ -1,92 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/route_cyclestreets.R -\name{route_cyclestreets} -\alias{route_cyclestreets} -\title{Plan a single route with CycleStreets.net} -\usage{ -route_cyclestreets( - from, - to, - plan = "fastest", - silent = TRUE, - pat = NULL, - base_url = "https://www.cyclestreets.net", - reporterrors = TRUE, - save_raw = "FALSE" -) -} -\arguments{ -\item{from}{Text string or coordinates (a numeric vector of -\code{length = 2} representing latitude and longitude) representing a point -on Earth.} - -\item{to}{Text string or coordinates (a numeric vector of -\code{length = 2} representing latitude and longitude) representing a point -on Earth. This represents the destination of the trip.} - -\item{plan}{Text strong of either "fastest" (default), "quietest" or "balanced"} - -\item{silent}{Logical (default is FALSE). TRUE hides request sent.} - -\item{pat}{The API key used. By default this is set to NULL and -this is usually aquired automatically through a helper, api_pat().} - -\item{base_url}{The base url from which to construct API requests -(with default set to main server)} - -\item{reporterrors}{Boolean value (TRUE/FALSE) indicating if cyclestreets (TRUE by default). -should report errors (FALSE by default).} - -\item{save_raw}{Boolean value which returns raw list from the json if TRUE (FALSE by default).} -} -\description{ -Provides an R interface to the CycleStreets.net cycle planning API, -a route planner made by cyclists for cyclists. -The function returns a SpatialLinesDataFrame object representing the -an estimate of the fastest, quietest or most balance route. -Currently only works for the United Kingdom and part of continental Europe, -though other areas may be requested by contacting CycleStreets. -See \url{https://www.cyclestreets.net/api/}for more information. -} -\details{ -This function uses the online routing service -CycleStreets.net to find routes suitable for cyclists -between origins and destinations. Requires an -internet connection, a CycleStreets.net API key -and origins and destinations within the UK (and various areas beyond) to run. - -Note that if \code{from} and \code{to} are supplied as -character strings (instead of lon/lat pairs), Google's -geo-coding services are used via \code{geo_code()}. - -You need to have an api key for this code to run. -Loading a locally saved copy of the api key text string -before running the function, for example, will ensure it -is available on any computer: - -\verb{mytoken <- readLines("~/Dropbox/dotfiles/cyclestreets-api-key-rl") Sys.setenv(CYCLESTREETS = mytoken)} - -if you want the API key to be available in future -sessions, set it using the .Renviron file -with \code{usethis::edit_r_environ()} - -Read more about the .Renviron here: \code{?.Renviron} -} -\examples{ - -\dontrun{ -from <- c(-1.55, 53.80) # geo_code("leeds") -to <- c(-1.76, 53.80) # geo_code("bradford uk") -json_output <- route_cyclestreets(from = from, to = to, plan = "quietest", save_raw = TRUE) -str(json_output) # what does cyclestreets give you? -rf_lb <- route_cyclestreets(from, to, plan = "fastest") -rf_lb@data -plot(rf_lb) -(rf_lb$length / (1000 * 1.61)) / # distance in miles - (rf_lb$time / (60 * 60)) # time in hours - average speed here: ~8mph -} - -} -\seealso{ -line2route -} diff --git a/man/route_dodgr.Rd b/man/route_dodgr.Rd index 2e99b514..6e69683b 100644 --- a/man/route_dodgr.Rd +++ b/man/route_dodgr.Rd @@ -12,8 +12,7 @@ route_dodgr(from = NULL, to = NULL, l = NULL, net = NULL) \item{to}{An object representing destinations} -\item{l}{Only needed if from and to are empty, in which case this -should be a spatial object representing desire lines} +\item{l}{A spatial (linestring) object} \item{net}{sf object representing the route network} } @@ -36,11 +35,7 @@ if (requireNamespace("dodgr")) { } \seealso{ Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{line2route}()}, -\code{\link{route_local}()}, \code{\link{route_osrm}()}, -\code{\link{route_transportapi_public}()}, \code{\link{route}()} } \concept{routes} diff --git a/man/route_google.Rd b/man/route_google.Rd index 5eafa9b0..7fcd0f38 100644 --- a/man/route_google.Rd +++ b/man/route_google.Rd @@ -17,7 +17,7 @@ route_google(from, to, mode = "walking", key = Sys.getenv("GOOGLE"), ...) \item{key}{Google key. By default it is \code{Sys.getenv("GOOGLE")}. Set it with: \code{usethis::edit_r_environ()}.} -\item{...}{Arguments passed to the routing function, e.g. \code{\link[=route_cyclestreets]{route_cyclestreets()}}} +\item{...}{Arguments passed to the routing function} } \description{ Find the shortest path using Google's services. diff --git a/man/route_local.Rd b/man/route_local.Rd deleted file mode 100644 index f91bc12d..00000000 --- a/man/route_local.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/route_local.R -\name{route_local} -\alias{route_local} -\title{Plan a route with local data} -\usage{ -route_local(sln, from, to, l = NULL, ...) -} -\arguments{ -\item{sln}{The SpatialLinesNetwork or sfNetwork to use.} - -\item{from}{An object representing origins -(if lines are provided as the first argument, from is assigned to \code{l})} - -\item{to}{An object representing destinations} - -\item{l}{Only needed if from and to are empty, in which case this -should be a spatial object representing desire lines} - -\item{...}{Arguments to pass to \code{sum_network_links}} -} -\description{ -This function returns the shortest path between locations -in, or near to, segements on a \code{SpatialLinesNetwork}. -} -\examples{ -from <- c(-1.535181, 53.82534) -to <- c(-1.52446, 53.80949) -sln <- SpatialLinesNetwork(route_network_sf) -r <- route_local(sln, from, to) -plot(sln) -plot(r$geometry, add = TRUE, col = "red", lwd = 5) -plot(cents[c(3, 4), ], add = TRUE) -r2 <- route_local(sln = sln, cents_sf[3, ], cents_sf[4, ]) -plot(r2$geometry, add = TRUE, col = "blue", lwd = 3) -l <- flowlines_sf[3:5, ] -r3 <- route_local(l = l, sln = sln) -plot(r2$geometry, add = TRUE, col = "blue", lwd = 3) -} -\seealso{ -Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{line2route}()}, -\code{\link{route_dodgr}()}, -\code{\link{route_osrm}()}, -\code{\link{route_transportapi_public}()}, -\code{\link{route}()} -} -\concept{routes} diff --git a/man/route_network.Rd b/man/route_network_sf.Rd similarity index 51% rename from man/route_network.Rd rename to man/route_network_sf.Rd index 152da7eb..e77c04b7 100644 --- a/man/route_network.Rd +++ b/man/route_network_sf.Rd @@ -1,35 +1,24 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{route_network} -\alias{route_network} +\name{route_network_sf} \alias{route_network_sf} \title{spatial lines dataset representing a route network} \format{ A spatial lines dataset 80 rows and 1 column } -\usage{ -data(route_network) -} \description{ The flow of commuters using different segments of the road network represented in the -\code{\link[=flowlines]{flowlines()}} and \code{\link[=routes_fast]{routes_fast()}} datasets -} -\examples{ -\dontrun{ -# Generate route network -route_network <- overline(routes_fast, "All", fun = sum) -route_network_sf <- sf::st_as_sf(route_network) -} +\code{\link[=flowlines_sf]{flowlines_sf()}} and \code{\link[=routes_fast_sf]{routes_fast_sf()}} datasets } \seealso{ Other example data: -\code{\link{destination_zones}}, +\code{\link{destinations_sf}}, \code{\link{flow_dests}}, -\code{\link{flowlines}}, +\code{\link{flowlines_sf}}, \code{\link{flow}}, -\code{\link{routes_fast}}, -\code{\link{routes_slow}} +\code{\link{routes_fast_sf}}, +\code{\link{routes_slow_sf}} } \concept{example data} \keyword{datasets} diff --git a/man/route_osrm.Rd b/man/route_osrm.Rd index 064acc90..1a4cf277 100644 --- a/man/route_osrm.Rd +++ b/man/route_osrm.Rd @@ -34,27 +34,24 @@ slower R interface to OSRM routing services compared with the excellent } \examples{ \donttest{ -l1 = od_data_lines[49, ] -l1m = od_coords(l1) -from = l1m[, 1:2] -to = l1m[, 3:4] -if(curl::has_internet()) { -r_foot = route_osrm(from, to) -r_bike = route_osrm(from, to, osrm.profile = "bike") -r_car = route_osrm(from, to, osrm.profile = "car") -plot(r_foot$geometry, lwd = 9, col = "grey") -plot(r_bike, col = "blue", add = TRUE) -plot(r_car, col = "red", add = TRUE) -} +# Examples no longer working due to API being down +# l1 = od_data_lines[49, ] +# l1m = od_coords(l1) +# from = l1m[, 1:2] +# to = l1m[, 3:4] +# if(curl::has_internet()) { +# r_foot = route_osrm(from, to) +# r_bike = route_osrm(from, to, osrm.profile = "bike") +# r_car = route_osrm(from, to, osrm.profile = "car") +# plot(r_foot$geometry, lwd = 9, col = "grey") +# plot(r_bike, col = "blue", add = TRUE) +# plot(r_car, col = "red", add = TRUE) +# } } } \seealso{ Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{line2route}()}, \code{\link{route_dodgr}()}, -\code{\link{route_local}()}, -\code{\link{route_transportapi_public}()}, \code{\link{route}()} } \concept{routes} diff --git a/man/route_transportapi_public.Rd b/man/route_transportapi_public.Rd deleted file mode 100644 index 0ec72ffd..00000000 --- a/man/route_transportapi_public.Rd +++ /dev/null @@ -1,77 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/route-transport-api.R -\name{route_transportapi_public} -\alias{route_transportapi_public} -\title{Plan a single route with TransportAPI.com} -\usage{ -route_transportapi_public( - from, - to, - silent = FALSE, - region = "southeast", - modes = NA, - not_modes = NA -) -} -\arguments{ -\item{from}{Text string or coordinates (a numeric vector of -\code{length = 2} representing latitude and longitude) representing a point -on Earth.} - -\item{to}{Text string or coordinates (a numeric vector of -\code{length = 2} representing latitude and longitude) representing a point -on Earth. This represents the destination of the trip.} - -\item{silent}{Logical (default is FALSE). TRUE hides request sent.} - -\item{region}{String for the active region to use for journey plans. -Possible values are 'southeast' (default) or 'tfl'.} - -\item{modes}{Vector of character strings containing modes to use. Default is -to use all modes.} - -\item{not_modes}{Vector of character strings containing modes not to use. -Not used if \code{modes} is set.} -} -\description{ -Provides an R interface to the TransportAPI.com public transport API. -The function returns a SpatialLinesDataFrame object representing the -public route. -Currently only works for the United Kingdom. -See \url{https://developer.transportapi.com/documentation}for more information. -} -\details{ -This function uses the online routing service -TransportAPI.com to find public routes -between origins and destinations. It does not require -any key to access the API. - -Note that if \code{from} and \code{to} are supplied as -character strings (instead of lon/lat pairs), Google's -geo-coding services are used via \code{geo_code}. - -Note: there is now a dedicated transportAPI package: -https://github.com/ITSLeeds/transportAPI -} -\examples{ - -\dontrun{ -# Plan the 'public' route from Hereford to Leeds -rqh <- route_transportapi_public(from = "Hereford", to = "Leeds") -plot(rq_hfd) -} - -# Aim plan public transport routes with transportAPI -} -\seealso{ -line2route - -Other routes: -\code{\link{line2routeRetry}()}, -\code{\link{line2route}()}, -\code{\link{route_dodgr}()}, -\code{\link{route_local}()}, -\code{\link{route_osrm}()}, -\code{\link{route}()} -} -\concept{routes} diff --git a/man/routes_fast.Rd b/man/routes_fast_sf.Rd similarity index 51% rename from man/routes_fast.Rd rename to man/routes_fast_sf.Rd index 1e72e39f..192d2dc5 100644 --- a/man/routes_fast.Rd +++ b/man/routes_fast_sf.Rd @@ -1,30 +1,28 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{routes_fast} -\alias{routes_fast} +\name{routes_fast_sf} \alias{routes_fast_sf} -\title{spatial lines dataset of commuter flows on the travel network} +\title{Spatial lines dataset of commuter flows on the travel network} \format{ A spatial lines dataset with 49 rows and 15 columns } \usage{ -data(routes_fast) +routes_fast_sf } \description{ Simulated travel route allocated to the transport network -representing the 'fastest' between \code{\link[=cents]{cents()}} -objects -with \code{\link[=od2line]{od2line()}} (see \code{\link[=flow]{flow()}}). +representing the 'fastest' between \code{cents_sf} +objects. } \seealso{ Other example data: -\code{\link{destination_zones}}, +\code{\link{destinations_sf}}, \code{\link{flow_dests}}, -\code{\link{flowlines}}, +\code{\link{flowlines_sf}}, \code{\link{flow}}, -\code{\link{route_network}}, -\code{\link{routes_slow}} +\code{\link{route_network_sf}}, +\code{\link{routes_slow_sf}} } \concept{example data} \keyword{datasets} diff --git a/man/routes_slow.Rd b/man/routes_slow.Rd deleted file mode 100644 index f171be46..00000000 --- a/man/routes_slow.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{routes_slow} -\alias{routes_slow} -\alias{routes_slow_sf} -\title{spatial lines dataset of commuter flows on the travel network} -\format{ -A spatial lines dataset 49 rows and 15 columns -} -\usage{ -data(routes_slow) -} -\description{ -Simulated travel route allocated to the transport network -representing the 'quietest' between \code{\link[=cents]{cents()}} -objects -with \code{\link[=od2line]{od2line()}} (see \code{\link[=flow]{flow()}}). -} -\seealso{ -Other example data: -\code{\link{destination_zones}}, -\code{\link{flow_dests}}, -\code{\link{flowlines}}, -\code{\link{flow}}, -\code{\link{route_network}}, -\code{\link{routes_fast}} -} -\concept{example data} -\keyword{datasets} diff --git a/man/routes_slow_sf.Rd b/man/routes_slow_sf.Rd new file mode 100644 index 00000000..dec9450e --- /dev/null +++ b/man/routes_slow_sf.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{routes_slow_sf} +\alias{routes_slow_sf} +\title{Spatial lines dataset of commuter flows on the travel network} +\format{ +A spatial lines dataset 49 rows and 15 columns +} +\description{ +Simulated travel route allocated to the transport network +representing the 'quietest' between \code{cents_sf}. +} +\seealso{ +Other example data: +\code{\link{destinations_sf}}, +\code{\link{flow_dests}}, +\code{\link{flowlines_sf}}, +\code{\link{flow}}, +\code{\link{route_network_sf}}, +\code{\link{routes_fast_sf}} +} +\concept{example data} +\keyword{datasets} diff --git a/man/sfNetwork-class.Rd b/man/sfNetwork-class.Rd deleted file mode 100644 index 76fd8605..00000000 --- a/man/sfNetwork-class.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\docType{class} -\name{sfNetwork-class} -\alias{sfNetwork-class} -\title{An S4 class representing a (typically) transport network} -\description{ -This class uses a combination of a sf layer and an igraph -object to represent transport networks that can be used for routing and -other network analyses. -} -\section{Slots}{ - -\describe{ -\item{\code{sl}}{A sf line layer with the geometry and other attributes -for each link the in network.} - -\item{\code{g}}{The graph network corresponding to \code{sl}.} - -\item{\code{nb}}{A list containing vectors of the nodes connected to each node -in the network.} - -\item{\code{weightfield}}{A character vector containing the variable (column) name -from the SpatialLinesDataFrame to be used for weighting the network.} -}} - diff --git a/man/sln2points.Rd b/man/sln2points.Rd deleted file mode 100644 index c6ca9591..00000000 --- a/man/sln2points.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{sln2points} -\alias{sln2points} -\title{Generate spatial points representing nodes on a SpatialLinesNetwork -or sfNetwork.} -\usage{ -sln2points(sln) -} -\arguments{ -\item{sln}{The SpatialLinesNetwork or sfNetwork to use.} -} -\description{ -Generate spatial points representing nodes on a SpatialLinesNetwork -or sfNetwork. -} -\examples{ -data(routes_fast) -rnet <- overline(routes_fast, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -(sln_nodes <- sln2points(sln)) -plot(sln) -plot(sln_nodes, add = TRUE) -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sum_network_links}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/sln_add_node.Rd b/man/sln_add_node.Rd deleted file mode 100644 index b64efed1..00000000 --- a/man/sln_add_node.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/node-funs.R -\name{sln_add_node} -\alias{sln_add_node} -\title{Add node to spatial lines object} -\usage{ -sln_add_node(sln, p) -} -\arguments{ -\item{sln}{A spatial lines (\code{sfNetwork}) object created by \code{SpatialLinesNetwork}} - -\item{p}{A point represented by an \code{sf} object the will split the \code{route}} -} -\description{ -Add node to spatial lines object -} -\examples{ -sample_routes <- routes_fast_sf[2:6, NULL] -sample_routes$value <- rep(1:3, length.out = 5) -rnet <- overline2(sample_routes, attrib = "value") -sln <- SpatialLinesNetwork(rnet) -p <- sf::st_sfc(sf::st_point(c(-1.540, 53.826)), crs = sf::st_crs(rnet)) -sln_nodes <- sln2points(sln) -sln_new <- sln_add_node(sln, p) -route <- route_local(sln_new, p, sln_nodes[9, ]) -plot(sln) -plot(sln_nodes, pch = as.character(1:nrow(sln_nodes)), add = TRUE) -plot(route$geometry, lwd = 9, add = TRUE) -} diff --git a/man/sln_clean_graph.Rd b/man/sln_clean_graph.Rd deleted file mode 100644 index 3ff98bc3..00000000 --- a/man/sln_clean_graph.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{sln_clean_graph} -\alias{sln_clean_graph} -\title{Clean spatial network - return an sln with a single connected graph} -\usage{ -sln_clean_graph(sln) -} -\arguments{ -\item{sln}{A spatial lines (\code{sfNetwork}) object created by \code{SpatialLinesNetwork}} -} -\value{ -An sfNetwork object -} -\description{ -See https://github.com/ropensci/stplanr/issues/344 -} diff --git a/man/stplanr-package.Rd b/man/stplanr-package.Rd index d2d18f64..01573813 100644 --- a/man/stplanr-package.Rd +++ b/man/stplanr-package.Rd @@ -10,15 +10,6 @@ The stplanr package provides functions to access and analyse data for transportation research, including origin-destination analysis, route allocation and modelling travel patterns. } -\section{Interesting functions}{ - -\itemize{ -\item \code{\link[=overline]{overline()}} - Aggregate overlaying route lines and data intelligently -\item \code{\link[=calc_catchment]{calc_catchment()}} - Create a 'catchment area' to show the areas serving a destination -\item \code{\link[=route_cyclestreets]{route_cyclestreets()}} - Finds the fastest routes for cyclists between two places. -} -} - \seealso{ \url{https://github.com/ropensci/stplanr} } diff --git a/man/sum_network_links.Rd b/man/sum_network_links.Rd deleted file mode 100644 index 12d50958..00000000 --- a/man/sum_network_links.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{sum_network_links} -\alias{sum_network_links} -\title{Summarise links from shortest paths data} -\usage{ -sum_network_links(sln, routedata) -} -\arguments{ -\item{sln}{The SpatialLinesNetwork or sfNetwork to use.} - -\item{routedata}{A dataframe where the first column contains the Node ID(s) -of the start of the routes, the second column indicates the Node ID(s) of -the end of the routes, and any additional columns are summarised by link. -If there are no additional colums, then overlapping routes are counted.} -} -\description{ -Summarise links from shortest paths data -} -\section{Details}{ - -Find the shortest path on the network between specified nodes and returns -a SpatialLinesDataFrame or sf containing the path(s) and summary statistics -of each one. -} - -\examples{ -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) -) -weightfield(sln_sf) # field used to determine shortest path -library(sf) -shortpath_sf <- sum_network_links(sln_sf, nodes_df) -plot(shortpath_sf["count"], lwd = shortpath_sf$count, add = TRUE) -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_routes}()} -} -\concept{rnet} diff --git a/man/sum_network_routes.Rd b/man/sum_network_routes.Rd deleted file mode 100644 index 13d86de6..00000000 --- a/man/sum_network_routes.Rd +++ /dev/null @@ -1,95 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{sum_network_routes} -\alias{sum_network_routes} -\title{Summarise shortest path between nodes on network} -\usage{ -sum_network_routes( - sln, - start, - end, - sumvars = weightfield(sln), - combinations = FALSE -) -} -\arguments{ -\item{sln}{The SpatialLinesNetwork or sfNetwork to use.} - -\item{start}{Integer of node indices where route starts.} - -\item{end}{Integer of node indices where route ends.} - -\item{sumvars}{Character vector of variables for which to calculate -summary statistics. The default value is \code{weightfield(sln)}.} - -\item{combinations}{Boolean value indicating if all combinations of start -and ends should be calculated. If TRUE then every start Node ID will be routed -to every end Node ID. This is faster than passing every combination to start -and end. Default is \code{FALSE}.} -} -\description{ -Summarise shortest path between nodes on network -} -\section{Details}{ - -Find the shortest path on the network between specified nodes and returns a -\code{SpatialLinesDataFrame} (or an \code{sf} object with LINESTRING geometry) -containing the path(s) and summary statistics of each one. - -The start and end arguments must be integers representing the node index. -To find which node is closest to a geographic point, use \code{find_nearest_node()}. - -If the start and end node are identical, the function will return a -degenerate line with just two (identical) points. See -\href{https://github.com/ropensci/stplanr/issues/444}{#444}. -} - -\examples{ -sln <- SpatialLinesNetwork(route_network) -weightfield(sln) # field used to determine shortest path -shortpath <- sum_network_routes(sln, start = 1, end = 50, sumvars = "length") -plot(shortpath, col = "red", lwd = 4) -plot(sln, add = TRUE) - -# with sf objects -sln <- SpatialLinesNetwork(route_network_sf) -weightfield(sln) # field used to determine shortest path -shortpath <- sum_network_routes(sln, start = 1, end = 50, sumvars = "length") -plot(sf::st_geometry(shortpath), col = "red", lwd = 4) -plot(sln, add = TRUE) - -# find shortest path between two coordinates -sf::st_bbox(sln@sl) -start_coords <- c(-1.546, 53.826) -end_coords <- c(-1.519, 53.816) -plot(sln) -plot(sf::st_point(start_coords), cex = 3, add = TRUE, col = "red") -plot(sf::st_point(end_coords), cex = 3, add = TRUE, col = "blue") -nodes <- find_network_nodes(sln, rbind(start_coords, end_coords)) -shortpath <- sum_network_routes(sln, nodes[1], nodes[2]) -plot(sf::st_geometry(shortpath), col = "darkred", lwd = 3, add = TRUE) - -# degenerate path -sum_network_routes(sln, start = 1, end = 1) -} -\seealso{ -Other rnet: -\code{\link{SpatialLinesNetwork}}, -\code{\link{calc_catchment_sum}()}, -\code{\link{calc_catchment}()}, -\code{\link{calc_moving_catchment}()}, -\code{\link{calc_network_catchment}()}, -\code{\link{find_network_nodes}()}, -\code{\link{gsection}()}, -\code{\link{islines}()}, -\code{\link{lineLabels}()}, -\code{\link{overline_spatial}()}, -\code{\link{overline}()}, -\code{\link{plot,SpatialLinesNetwork,ANY-method}}, -\code{\link{plot,sfNetwork,ANY-method}}, -\code{\link{rnet_breakup_vertices}()}, -\code{\link{rnet_group}()}, -\code{\link{sln2points}()}, -\code{\link{sum_network_links}()} -} -\concept{rnet} diff --git a/man/summary-SpatialLinesNetwork-method.Rd b/man/summary-SpatialLinesNetwork-method.Rd deleted file mode 100644 index f72b26a7..00000000 --- a/man/summary-SpatialLinesNetwork-method.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{summary,SpatialLinesNetwork-method} -\alias{summary,SpatialLinesNetwork-method} -\title{Print a summary of a SpatialLinesNetwork} -\usage{ -\S4method{summary}{SpatialLinesNetwork}(object, ...) -} -\arguments{ -\item{object}{The SpatialLinesNetwork} - -\item{...}{Arguments to pass to relevant summary function.} -} -\description{ -Print a summary of a SpatialLinesNetwork -} -\examples{ -data(routes_fast) -rnet <- overline(routes_fast, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -summary(sln) -} diff --git a/man/summary-sfNetwork-method.Rd b/man/summary-sfNetwork-method.Rd deleted file mode 100644 index 0eb4ec5a..00000000 --- a/man/summary-sfNetwork-method.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{summary,sfNetwork-method} -\alias{summary,sfNetwork-method} -\title{Print a summary of a sfNetwork} -\usage{ -\S4method{summary}{sfNetwork}(object, ...) -} -\arguments{ -\item{object}{The sfNetwork} - -\item{...}{Arguments to pass to relevant summary function.} -} -\description{ -Print a summary of a sfNetwork -} -\examples{ -data(routes_fast) -rnet <- overline(routes_fast, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -summary(sln) -} diff --git a/man/toptail_buff.Rd b/man/toptail_buff.Rd index 8ec9e210..7d8a5440 100644 --- a/man/toptail_buff.Rd +++ b/man/toptail_buff.Rd @@ -2,20 +2,20 @@ % Please edit documentation in R/toptail.R \name{toptail_buff} \alias{toptail_buff} -\title{Clip the beginning and ends SpatialLines to the edge of SpatialPolygon borders} +\title{Clip the beginning and ends of \code{sf} LINESTRING objects} \usage{ toptail_buff(l, buff, ...) } \arguments{ -\item{l}{An sf LINESTRING object} +\item{l}{An \code{sf} object representing lines} -\item{buff}{An sf POLYGON object to act as the buffer} +\item{buff}{An \code{sf} object with POLYGON geometry to buffer the linestring.} -\item{...}{Arguments passed to rgeos::gBuffer()} +\item{...}{Arguments passed to \code{sf::st_buffer()}} } \description{ Takes lines and removes the start and end point, to a distance determined -by the nearest polygon border. +by the nearest \code{buff} polygon border. } \examples{ l <- routes_fast_sf @@ -37,16 +37,11 @@ Other lines: \code{\link{line_bearing}()}, \code{\link{line_breakup}()}, \code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, \code{\link{line_segment}()}, \code{\link{line_via}()}, \code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, \code{\link{n_vertices}()}, \code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptailgs}()}, -\code{\link{update_line_geometry}()} +\code{\link{points2line}()} } \concept{lines} diff --git a/man/toptailgs.Rd b/man/toptailgs.Rd deleted file mode 100644 index 45a57b54..00000000 --- a/man/toptailgs.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/toptail.R -\name{toptailgs} -\alias{toptailgs} -\title{Clip the first and last n metres of SpatialLines} -\usage{ -toptailgs(l, toptail_dist, tail_dist = NULL) -} -\arguments{ -\item{l}{A SpatialLines object} - -\item{toptail_dist}{The distance (in metres) to top the line by. -Can be either a single value or a vector of the same length as the -SpatialLines object. If tail_dist is missing, is used as the tail distance.} - -\item{tail_dist}{The distance (in metres) to tail the line by. Can be -either a single value or a vector of the same length as the SpatialLines -object.} -} -\description{ -Takes lines and removes the start and end point, to a distance determined -by the user. Uses the geosphere::distHaversine function and requires -coordinates in WGS84 (lng/lat). -} -\examples{ -data("routes_fast") -rf <- routes_fast[2:3, ] -r_toptail <- toptailgs(rf, toptail_dist = 300) -plot(rf, lwd = 3) -plot(r_toptail, col = "red", add = TRUE) -plot(cents, add = TRUE) -} -\seealso{ -Other lines: -\code{\link{angle_diff}()}, -\code{\link{geo_toptail}()}, -\code{\link{is_linepoint}()}, -\code{\link{line2df}()}, -\code{\link{line2points}()}, -\code{\link{line_bearing}()}, -\code{\link{line_breakup}()}, -\code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, -\code{\link{line_segment}()}, -\code{\link{line_via}()}, -\code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, -\code{\link{n_vertices}()}, -\code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{update_line_geometry}()} -} -\concept{lines} diff --git a/man/update_line_geometry.Rd b/man/update_line_geometry.Rd deleted file mode 100644 index f07fd719..00000000 --- a/man/update_line_geometry.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/od-funs.R -\name{update_line_geometry} -\alias{update_line_geometry} -\title{Update line geometry} -\usage{ -update_line_geometry(l, nl) -} -\arguments{ -\item{l}{A SpatialLines object, whose geometry is to be modified} - -\item{nl}{A SpatialLines object of the same length as \code{l} to provide the new geometry} -} -\description{ -Take two SpatialLines objects and update the geometry of the former with that of the latter, -retaining the data of the former. -} -\examples{ -data(flowlines) -l <- flowlines[2:5, ] -nl <- routes_fast -nrow(l) -nrow(nl) -l <- l[!is_linepoint(l), ] -names(l) -names(routes_fast) -l_newgeom <- update_line_geometry(l, nl) -plot(l, lwd = l$All / mean(l$All)) -plot(l_newgeom, lwd = l$All / mean(l$All)) -names(l_newgeom) -} -\seealso{ -Other lines: -\code{\link{angle_diff}()}, -\code{\link{geo_toptail}()}, -\code{\link{is_linepoint}()}, -\code{\link{line2df}()}, -\code{\link{line2points}()}, -\code{\link{line_bearing}()}, -\code{\link{line_breakup}()}, -\code{\link{line_midpoint}()}, -\code{\link{line_sample}()}, -\code{\link{line_segment_sf}()}, -\code{\link{line_segment}()}, -\code{\link{line_via}()}, -\code{\link{mats2line}()}, -\code{\link{n_sample_length}()}, -\code{\link{n_vertices}()}, -\code{\link{onewaygeo}()}, -\code{\link{points2line}()}, -\code{\link{toptail_buff}()}, -\code{\link{toptailgs}()} -} -\concept{lines} diff --git a/man/weightfield.Rd b/man/weightfield.Rd deleted file mode 100644 index ddb7a91b..00000000 --- a/man/weightfield.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SpatialLinesNetwork.R -\name{weightfield} -\alias{weightfield} -\alias{weightfield<-} -\alias{weightfield,SpatialLinesNetwork-method} -\alias{weightfield,sfNetwork-method} -\alias{weightfield<-,SpatialLinesNetwork,ANY-method} -\alias{weightfield<-,sfNetwork,ANY-method} -\alias{weightfield<-,SpatialLinesNetwork,character-method} -\alias{weightfield<-,sfNetwork,character-method} -\title{Get or set weight field in SpatialLinesNetwork} -\usage{ -weightfield(x) - -weightfield(x, varname) <- value - -weightfield(x, varname) <- value - -\S4method{weightfield}{SpatialLinesNetwork}(x) - -\S4method{weightfield}{sfNetwork}(x) - -\S4method{weightfield}{SpatialLinesNetwork,ANY}(x) <- value - -\S4method{weightfield}{sfNetwork,ANY}(x) <- value - -\S4method{weightfield}{SpatialLinesNetwork,character}(x, varname) <- value - -\S4method{weightfield}{sfNetwork,character}(x, varname) <- value -} -\arguments{ -\item{x}{SpatialLinesNetwork to use} - -\item{varname}{The name of the variable to set/use.} - -\item{value}{Either the name of the variable to use as the weight field or -a dataframe or vector containing the weights to use if \code{varname} is -passed to the replacement function. If the dataframe contains multiple -columns, the column with the same name as \code{varname} is used, -otherwise the first column is used.} -} -\description{ -Get or set value of weight field in SpatialLinesNetwork -} -\section{Details}{ - -These functions manipulate the value of weightfield in a -SpatialLinesNetwork. When changing the value of weightfield, the weights -of the graph network are updated with the values of the corresponding -variables. -} - -\examples{ -# with sp objects -data(routes_fast) -rnet <- overline(routes_fast, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -weightfield(sln) <- "length" -weightfield(sln, "randomnum") <- sample(1:10, size = nrow(sln@sl), replace = TRUE) -data(routes_fast_sf) -rnet <- overline(routes_fast_sf, attrib = "length") -sln <- SpatialLinesNetwork(rnet) -weightfield(sln) <- "length" -sln@sl$randomnum <- sample(1:10, size = nrow(sln@sl), replace = TRUE) -weightfield(sln) <- "randomnum" -# todo: show the difference that it makes -} diff --git a/man/writeGeoJSON.Rd b/man/writeGeoJSON.Rd deleted file mode 100644 index 66644ed7..00000000 --- a/man/writeGeoJSON.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/geo-functions.R -\name{writeGeoJSON} -\alias{writeGeoJSON} -\title{Write to geojson easily} -\usage{ -writeGeoJSON(shp, filename) -} -\arguments{ -\item{shp}{Spatial data object} - -\item{filename}{File name of the output geojson} -} -\description{ -Provides a user-friendly wrapper for \code{sf::st_write()}. Note, -\code{geojson_write} from the geojsonio package -provides the same functionality \url{https://github.com/ropensci/geojsonio}. -} diff --git a/man/zones.Rd b/man/zones_sf.Rd similarity index 82% rename from man/zones.Rd rename to man/zones_sf.Rd index a38ced51..e4144682 100644 --- a/man/zones.Rd +++ b/man/zones_sf.Rd @@ -1,16 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{zones} -\alias{zones} +\name{zones_sf} \alias{zones_sf} \title{Spatial polygons of home locations for flow analysis.} \description{ -Note: we recommend using the \code{zones_sf} data. +These correspond to the \code{cents_sf} data. } \details{ -These correspond to the \code{cents_sf} data. - \itemize{ \item geo_code. the official code of the zone } diff --git a/src/Makevars b/src/Makevars deleted file mode 100644 index 5dcc7ccd..00000000 --- a/src/Makevars +++ /dev/null @@ -1,10 +0,0 @@ -## Emacs please make this a -*- mode: Makefile; -*- -## -## We could set particular variables here. Examples are -## PKG_LIBS for external libraries -## PKG_CXXFLAGS for additional headers or defines -## CXX_STD to select C++11 via 'CXX11' -## But for standard builds without external dependencies, nothing is needed -CXX_STD=CXX11 -PKG_CXXFLAGS=-DARMA_DONT_PRINT_OPENMP_WARNING -PKG_LIBS= diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp deleted file mode 100644 index 550a90c6..00000000 --- a/src/RcppExports.cpp +++ /dev/null @@ -1,78 +0,0 @@ -// Generated by using Rcpp::compileAttributes() -> do not edit by hand -// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -#include -#include - -using namespace Rcpp; - -#ifdef RCPP_USE_GLOBAL_ROSTREAM -Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); -Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); -#endif - -// coord_matches -List coord_matches(SEXP sldf, double tolval); -RcppExport SEXP _stplanr_coord_matches(SEXP sldfSEXP, SEXP tolvalSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type sldf(sldfSEXP); - Rcpp::traits::input_parameter< double >::type tolval(tolvalSEXP); - rcpp_result_gen = Rcpp::wrap(coord_matches(sldf, tolval)); - return rcpp_result_gen; -END_RCPP -} -// join_spatiallines_coords -arma::mat join_spatiallines_coords(SEXP sldf, double startx, double starty); -RcppExport SEXP _stplanr_join_spatiallines_coords(SEXP sldfSEXP, SEXP startxSEXP, SEXP startySEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type sldf(sldfSEXP); - Rcpp::traits::input_parameter< double >::type startx(startxSEXP); - Rcpp::traits::input_parameter< double >::type starty(startySEXP); - rcpp_result_gen = Rcpp::wrap(join_spatiallines_coords(sldf, startx, starty)); - return rcpp_result_gen; -END_RCPP -} -// coord_matches_sf -List coord_matches_sf(arma::mat x, arma::mat sortedx, unsigned int sllength, double tolval); -RcppExport SEXP _stplanr_coord_matches_sf(SEXP xSEXP, SEXP sortedxSEXP, SEXP sllengthSEXP, SEXP tolvalSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::mat >::type x(xSEXP); - Rcpp::traits::input_parameter< arma::mat >::type sortedx(sortedxSEXP); - Rcpp::traits::input_parameter< unsigned int >::type sllength(sllengthSEXP); - Rcpp::traits::input_parameter< double >::type tolval(tolvalSEXP); - rcpp_result_gen = Rcpp::wrap(coord_matches_sf(x, sortedx, sllength, tolval)); - return rcpp_result_gen; -END_RCPP -} -// join_spatiallines_coords_sf -arma::mat join_spatiallines_coords_sf(List lines, double startx, double starty); -RcppExport SEXP _stplanr_join_spatiallines_coords_sf(SEXP linesSEXP, SEXP startxSEXP, SEXP startySEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< List >::type lines(linesSEXP); - Rcpp::traits::input_parameter< double >::type startx(startxSEXP); - Rcpp::traits::input_parameter< double >::type starty(startySEXP); - rcpp_result_gen = Rcpp::wrap(join_spatiallines_coords_sf(lines, startx, starty)); - return rcpp_result_gen; -END_RCPP -} - -static const R_CallMethodDef CallEntries[] = { - {"_stplanr_coord_matches", (DL_FUNC) &_stplanr_coord_matches, 2}, - {"_stplanr_join_spatiallines_coords", (DL_FUNC) &_stplanr_join_spatiallines_coords, 3}, - {"_stplanr_coord_matches_sf", (DL_FUNC) &_stplanr_coord_matches_sf, 4}, - {"_stplanr_join_spatiallines_coords_sf", (DL_FUNC) &_stplanr_join_spatiallines_coords_sf, 3}, - {NULL, NULL, 0} -}; - -RcppExport void R_init_stplanr(DllInfo *dll) { - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/src/spatialnetworks.cpp b/src/spatialnetworks.cpp deleted file mode 100644 index eef4e9b6..00000000 --- a/src/spatialnetworks.cpp +++ /dev/null @@ -1,238 +0,0 @@ -#include -#include -#include -using namespace Rcpp; - -// [[Rcpp::depends(RcppArmadillo)]] - -// [[Rcpp::export]] -List coord_matches(SEXP sldf, double tolval = 0.000) { - - Rcpp::S4 xlines(sldf); - List lines = xlines.slot("lines"); - - unsigned int sllength = lines.length(); - - arma::mat x(lines.length()*2,3); - - unsigned int counti = 0; - for (unsigned int i = 0; i < sllength; i++) { - List Lines = Rcpp::S4(lines(i)).slot("Lines"); - arma::mat thiscoords = as(Rcpp::S4(Lines(0)).slot("coords")); - x(counti, 0) = thiscoords(0,0); - x(counti, 1) = thiscoords(0,1); - x(counti, 2) = counti + 1; - x(counti+1, 0) = thiscoords(thiscoords.n_rows-1,0); - x(counti+1, 1) = thiscoords(thiscoords.n_rows-1,1); - x(counti+1, 2) = counti + 2; - counti = counti + 2; - } - - double curlat = x(0,0); - double curlng = x(0,1); - double curid = x(0,2); - - Environment base("package:base"); - Function order = base["order"]; - arma::uvec sortedidx = as(order(wrap(arma::vec(x.col(0))),wrap(arma::vec(x.col(1))))); - sortedidx = sortedidx - 1; - arma::mat &sortedxo = x; - arma::mat sortedx = arma::mat(sortedxo.rows(sortedidx)); - - arma::mat matchedcoords(x.n_rows,2); - curlat = sortedx(0,0); - curlng = sortedx(0,1); - curid = sortedx(0,2); - unsigned int curmatches = 0; - for (unsigned int i = 1; i < sortedx.n_rows; i++) { - if (std::abs(sortedx(i,0) - curlat) <= tolval && std::abs(sortedx(i,1) - curlng) <= tolval) { - matchedcoords(curmatches,0) = curid; - matchedcoords(curmatches,1) = sortedx(i,2); - curmatches += 1; - } - else { - curlat = sortedx(i,0); - curlng = sortedx(i,1); - curid = sortedx(i,2); - } - } - arma::mat matchedcoords2 = matchedcoords.rows(0,curmatches-1); - arma::uvec pts = arma::linspace(0,x.n_rows-1,x.n_rows); - - if (matchedcoords2.n_rows > 0) { - for(unsigned int i = 0; i < matchedcoords2.n_rows; i++) { - pts(matchedcoords2(i,1)-1) = pts(matchedcoords2(i, 0)-1); - } - } - - arma::uvec upts = unique(pts); - arma::uvec pts0(pts.n_rows); - for (unsigned int i = 0; i < pts.n_rows; i++) { - pts0(i) = arma::uvec(find(abs(upts - pts(i)) <= tolval,1))(0)+1; - } - pts = pts+1; - - arma::uvec node(sllength*2); - unsigned int countval = 1; - for (unsigned int i = 0; i < (sllength*2); i+=2) { - node(i) = countval; - node(i+1) = countval; - countval += 1; - } - - std::vector mainlist(upts.n_rows); - for (unsigned int i = 0; i < upts.n_rows; i++) { - mainlist[i] = arma::uvec(node.rows(find(pts0 == i+1))); - } - - return List::create(Named("s")=x, - Named("zd")=matchedcoords2, - Named("pts")=pts, - Named("pts0")=pts0, - Named("upts")=upts, - Named("nb")=wrap(mainlist)); -} - -// [[Rcpp::export]] -arma::mat join_spatiallines_coords(SEXP sldf, double startx, double starty) { - - Rcpp::S4 obj(sldf); - List lines = obj.slot("lines"); - arma::mat fullcoords; - - double prevx = startx; - double prevy = starty; - - for (unsigned int i = 0; i < lines.length(); i++) { - List Lines = Rcpp::S4(lines(i)).slot("Lines"); - arma::mat thiscoords = as(Rcpp::S4(Lines(0)).slot("coords")); - if (thiscoords(0,0) == prevx && thiscoords(0,1) == prevy) { - thiscoords = thiscoords.rows((i>0),thiscoords.n_rows-1); - } - else { - thiscoords = thiscoords.rows(arma::linspace(thiscoords.n_rows-((i>0)+1), 0, thiscoords.n_rows)); - } - fullcoords.insert_rows(fullcoords.n_rows, thiscoords); - prevx = fullcoords(fullcoords.n_rows-1,0); - prevy = fullcoords(fullcoords.n_rows-1,1); - } - - return fullcoords; - -} - - - -// [[Rcpp::export]] -List coord_matches_sf(arma::mat x, arma::mat sortedx, unsigned int sllength, double tolval = 0.000) { - - // Rcpp::S4 xlines(sldf); - // List lines = xlines.slot("lines"); - // - // unsigned int sllength = lines.length(); - // - // arma::mat x(lines.length()*2,3); - // - // unsigned int counti = 0; - // for (unsigned int i = 0; i < sllength; i++) { - // List Lines = Rcpp::S4(lines(i)).slot("Lines"); - // arma::mat thiscoords = as(Rcpp::S4(Lines(0)).slot("coords")); - // x(counti, 0) = thiscoords(0,0); - // x(counti, 1) = thiscoords(0,1); - // x(counti, 2) = counti + 1; - // x(counti+1, 0) = thiscoords(thiscoords.n_rows-1,0); - // x(counti+1, 1) = thiscoords(thiscoords.n_rows-1,1); - // x(counti+1, 2) = counti + 2; - // counti = counti + 2; - // } - // - double curlat = x(0,0); - double curlng = x(0,1); - double curid = x(0,2); - // - // Environment base("package:base"); - // Function order = base["order"]; - // arma::uvec sortedidx = as(order(wrap(arma::vec(x.col(0))),wrap(arma::vec(x.col(1))))); - // sortedidx = sortedidx - 1; - // arma::mat &sortedxo = x; - // arma::mat sortedx = arma::mat(sortedxo.rows(sortedidx)); - - arma::mat matchedcoords(x.n_rows,2); - curlat = sortedx(0,0); - curlng = sortedx(0,1); - curid = sortedx(0,2); - unsigned int curmatches = 0; - for (unsigned int i = 1; i < sortedx.n_rows; i++) { - if (std::abs(sortedx(i,0) - curlat) <= tolval && std::abs(sortedx(i,1) - curlng) <= tolval) { - matchedcoords(curmatches,0) = curid; - matchedcoords(curmatches,1) = sortedx(i,2); - curmatches += 1; - } - else { - curlat = sortedx(i,0); - curlng = sortedx(i,1); - curid = sortedx(i,2); - } - } - arma::mat matchedcoords2 = matchedcoords.rows(0,curmatches-1); - arma::uvec pts = arma::linspace(0,x.n_rows-1,x.n_rows); - - if (matchedcoords2.n_rows > 0) { - for(unsigned int i = 0; i < matchedcoords2.n_rows; i++) { - pts(matchedcoords2(i,1)-1) = pts(matchedcoords2(i, 0)-1); - } - } - - arma::uvec upts = unique(pts); - arma::uvec pts0(pts.n_rows); - for (unsigned int i = 0; i < pts.n_rows; i++) { - pts0(i) = arma::uvec(find(abs(upts - pts(i)) <= tolval,1))(0)+1; - } - pts = pts+1; - - arma::uvec node(sllength*2); - unsigned int countval = 1; - for (unsigned int i = 0; i < (sllength*2); i+=2) { - node(i) = countval; - node(i+1) = countval; - countval += 1; - } - - std::vector mainlist(upts.n_rows); - for (unsigned int i = 0; i < upts.n_rows; i++) { - mainlist[i] = arma::uvec(node(find(pts0 == i+1))); - } - - return List::create(Named("s")=x, - Named("zd")=matchedcoords2, - Named("pts")=pts, - Named("pts0")=pts0, - Named("upts")=upts, - Named("nb")=wrap(mainlist)); -} - - -// [[Rcpp::export]] -arma::mat join_spatiallines_coords_sf(List lines, double startx, double starty) { - - arma::mat fullcoords; - - double prevx = startx; - double prevy = starty; - - for (unsigned int i = 0; i < lines.length(); i++) { - arma::mat thiscoords = as(lines(i)); - if (thiscoords(0,0) == prevx && thiscoords(0,1) == prevy) { - thiscoords = thiscoords.rows((i>0),thiscoords.n_rows-1); - } - else { - thiscoords = thiscoords.rows(arma::linspace(thiscoords.n_rows-((i>0)+1), 0, thiscoords.n_rows)); - } - fullcoords.insert_rows(fullcoords.n_rows, thiscoords); - prevx = fullcoords(fullcoords.n_rows-1,0); - prevy = fullcoords(fullcoords.n_rows-1,1); - } - - return fullcoords; - -} diff --git a/stplanr.Rproj b/stplanr.Rproj index f30c4eca..09105473 100644 --- a/stplanr.Rproj +++ b/stplanr.Rproj @@ -16,6 +16,7 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes +PackageCleanBeforeInstall: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageCheckArgs: --as-cran PackageRoxygenize: rd,collate,namespace diff --git a/tests/benchmarks/line2route-parallel.R b/tests/benchmarks/line2route-parallel.R deleted file mode 100644 index 7a851b21..00000000 --- a/tests/benchmarks/line2route-parallel.R +++ /dev/null @@ -1,51 +0,0 @@ -# Aim: test the performance of parallel code -library(stplanr) -# Relies on having large lines dataset -n <- 1000 # number of lines to route -ii <- round(n / nrow(flowlines)) -for (i in 1:ii) { - if (i == 1) { - l <- flowlines - } else { - l <- rbind(l, flowlines) - } -} - -system.time({ - r1 <- line2route(l) -}) -# result1 - rl -# user system elapsed -# 55.864 1.384 198.586 -# result2 - rl -# user system elapsed -# 44.336 0.392 125.790 -# user system elapsed -# 36.476 2.500 186.043 -detach("package:stplanr", unload = TRUE) -devtools::install_github(repo = "ropensci/stplanr", ref = "0.1.8") -library(stplanr) -system.time({ - r2 <- line2route(l = l, n_processes = 8) -}) -# result1 - rl -# user system elapsed -# 0.620 0.148 30.679 -# result2 - rl n_process = 10 -# user system elapsed -# 1.588 0.212 22.789 -# rl n_processes = 30 -# user system elapsed -# 32.264 0.904 43.245 -# tests -# rl n_processes = 20 -# user system elapsed -# 1.564 0.332 31.438 -# rl n_processes = 4 -# user system elapsed -# 1.384 0.624 30.513 -identical(r1, r2) # not identical -nrow(r1) == nrow(r2) # identical -identical(raster::geom(r1), raster::geom(r2)) # not identical geometries -plot(r1) -plot(r2) # very different appearance... diff --git a/tests/benchmarks/test-error-handling-line2route.R b/tests/benchmarks/test-error-handling-line2route.R deleted file mode 100644 index 122f0984..00000000 --- a/tests/benchmarks/test-error-handling-line2route.R +++ /dev/null @@ -1,8 +0,0 @@ -devtools::install_github("nikolai-b/stplanr", ref = "add_error_handelling") -r <- line2route(flowlines, reporterror = TRUE) -r$error # shows error - -# now switch off internet partway (manually) -r <- line2route(flowlines, reporterror = TRUE) - -r2 <- stplanr:::line2routeRetry(flowlines, silent = F) diff --git a/tests/testthat/test-read_table_builder.R b/tests/testthat/test-read_table_builder.R deleted file mode 100644 index 73351735..00000000 --- a/tests/testthat/test-read_table_builder.R +++ /dev/null @@ -1,10 +0,0 @@ -context("Test the read_table_builder function") - -test_that( - desc = "read_table_builder returns a data.frame", - code = { - data_dir <- system.file("extdata", package = "stplanr") - t1 <- read_table_builder(file.path(data_dir, "SA1Population.csv")) - expect_is(t1, "data.frame") - } -) diff --git a/tests/testthat/test-route_cyclestreet.R b/tests/testthat/test-route_cyclestreet.R deleted file mode 100644 index f97a4166..00000000 --- a/tests/testthat/test-route_cyclestreet.R +++ /dev/null @@ -1,11 +0,0 @@ -context("Test route_cyclestreet function") - -test_that( - desc = "route_cyclestreet generates a SpatialLinesDataFrame output", - code = { - if (!Sys.getenv("CYCLESTREETS") == "" & curl::has_internet()) { # only run test if user has set an api key - route_f <- route_cyclestreets(c(-1.55, 53.80), c(-1.76, 53.80)) - expect_true(grepl(pattern = "SpatialLinesDataFrame|sf", class(route_f))) - } - } -) diff --git a/vignettes/stplanr-od.Rmd b/vignettes/stplanr-od.Rmd index 508816e9..f49f6d8b 100644 --- a/vignettes/stplanr-od.Rmd +++ b/vignettes/stplanr-od.Rmd @@ -46,7 +46,7 @@ Additional disaggregations of overall counts may include trip counts at differen Many OD datasets omit information. If there is only one time period, then this resides in the metadata for the whole data set. There is rarely any information about the path taken between the start and end points. -It is typically the job of the analyst to use a routing service (such as [OSRM](https://github.com/riatelab/osrm), [Google Directions API](https://symbolixau.github.io/googleway/articles/googleway-vignette.html#google-directions-api), [CycleStreets.net](https://github.com/Robinlovelace/cyclestreets/) or [OpenRouteService](https://github.com/GIScience/openrouteservice-r/)) or an assignment model (such as those contained in proprietary software such as [SATURN](https://saturnsoftware2.co.uk/) and [Visum](https://www.ptvgroup.com/en/solutions/products/ptv-visum/)) to identify likely routes with reference to shortest path algorithms or generalised cost minimisation algorithms (which account for monetary plus time and quality 'costs'). +It is typically the job of the analyst to use a routing service (such as [OSRM](https://github.com/riatelab/osrm), [Google Directions API](https://symbolixau.github.io/googleway/articles/googleway-vignette.html#google-directions-api), [CycleStreets.net](https://github.com/Robinlovelace/cyclestreets/) or [OpenRouteService](https://github.com/GIScience/openrouteservice-r/)) or an assignment model (such as those contained in proprietary software such as [SATURN](https://saturnsoftware2.co.uk/) and [Visum](https://www.myptv.com/en/mobility-software/ptv-visum)) to identify likely routes with reference to shortest path algorithms or generalised cost minimisation algorithms (which account for monetary plus time and quality 'costs'). # The importance of OD data diff --git a/vignettes/stplanr-paper.Rmd b/vignettes/stplanr-paper.Rmd index d294690d..3c5d1402 100644 --- a/vignettes/stplanr-paper.Rmd +++ b/vignettes/stplanr-paper.Rmd @@ -34,6 +34,13 @@ knitr::opts_chunk$set(fig.width = 7, fig.height = 5, eval = FALSE) This paper has now been peer reviewed and published by the R Journal. Please see the published version at [journal.r-project.org](https://journal.r-project.org/archive/2018/RJ-2018-053/index.html) and cite it as @lovelace_stplanr_2018. +The code presented in this paper requires stplanr 0.8.5 or earlier, which can be installed as follows: + +```r +remotes::install_github("ropensci/stplanr", ref = "v0.8.5") +``` + + # Introduction Transport planning can broadly be defined as the process of designing @@ -467,7 +474,8 @@ Calculating the catchment area is straightforward and in addition to specifying Since proportioning the areas assumes projected data, unprojected data are automatically projected to either a common projection (if one is already projected) or a specified projection. It should be emphasised that the choice of projection is important and has an effect on the results meaning setting a local projection is recommended to achieve the most accurate results. -```{r calccatchment, results='hide'} +```{r calccatchment, results='hide', eval=FALSE} +remotes::install_github("ropensci/stplanr") catch800m <- calc_catchment( polygonlayer = sa1income, targetlayer = testcycleway, diff --git a/vignettes/stplanr-route-nets.Rmd b/vignettes/stplanr-route-nets.Rmd index bf558028..26b149b6 100644 --- a/vignettes/stplanr-route-nets.Rmd +++ b/vignettes/stplanr-route-nets.Rmd @@ -89,49 +89,8 @@ We can identify these groups as follows: rnet_disconnected$group = rnet_igroup(rnet_disconnected) ``` -# SpatialLineNetworks - -An important feature of route networks is that they are simultaneously spatial and graph entities. -This duality is captured in `sfNetwork` objects, which can be created by the function `SpatialLinesNetwork()`: - -```{r rnet-routing1} -sln <- SpatialLinesNetwork(rnet) -class(sln) -``` - -`sln` has both spatial and graph components, with the number of lines equal to the number graph edges: - -```{r} -class(sln@sl) -nrow(sln@sl) -class(sln@g) -length(igraph::edge.attributes(sln@g)[["weight"]]) -class(sln@nb) -length(unique(unlist(sln@nb))) -identical(sln@sl$geometry, rnet$geometry) -``` - -```{r} -sln_nodes <- sln2points(sln) -nrow(sln_nodes) -length(sln@nb) -``` - -```{r} -rnet_coordinates <- sf::st_coordinates(rnet) -set.seed(85) -x <- runif(n = 2, min = min(rnet_coordinates[, 1]), max = max(rnet_coordinates[, 1])) -y <- runif(n = 2, min = min(rnet_coordinates[, 2]), max = max(rnet_coordinates[, 2])) -crs <- sf::st_crs(rnet) -xy_sf <- sf::st_as_sf(data.frame(n = 1:2, x, y), coords = c("x", "y"), crs = crs) -xy_nodes <- stplanr::find_network_nodes(sln = sln, x = x, y = y) -``` - # Routing on route networks -Currently not running due to issues with dev version of `dplyr`: - -https://github.com/ropensci/stplanr/issues/383 ```{r, out.width="49%", fig.show='hide'} # plot(rnet$geometry) @@ -150,17 +109,7 @@ Imagine we want to create a point half way along the the most westerly route seg ```{r netpoint} new_point_coordinates <- c(-1.540, 53.826) -p <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = crs) -``` - -We can identify the nearest point on the network at this point and use that to split the associated linestring: - -```{r, fig.show='hold', out.width="49%"} -sln_new <- sln_add_node(sln = sln, p = p) -route_new <- route_local(sln = sln_new, from = p, to = xy_sf[1, ]) -plot(sln_new) -plot(p, add = TRUE) -plot(route_new, lwd = 5, add = TRUE) +p <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = 4326) ``` # Other approaches