From 36cec5f3ae3a8fcd25e3102960215094fa862d85 Mon Sep 17 00:00:00 2001 From: RFlx Date: Tue, 16 Jun 2026 17:48:33 +0100 Subject: [PATCH 1/3] #66 update column index reference from numeric to L1 in elevation_add() --- R/slopes.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/slopes.R b/R/slopes.R index d8ee76a..b2c8977 100644 --- a/R/slopes.R +++ b/R/slopes.R @@ -276,7 +276,7 @@ elevation_add <- function(routes, dem = NULL, method = "bilinear", terra = NULL) m_xyz <- cbind(m[, 1:2], z) } n <- nrow(routes) - linestrings <- lapply(seq(n), function(i) sf::st_linestring(m_xyz[m[, 3] == i, ])) + linestrings <- lapply(seq(n), function(i) sf::st_linestring(m_xyz[m[, "L1"] == i, ])) rgeom3d_sfc <- sf::st_sfc(linestrings, crs = sf::st_crs(routes)) sf::st_geometry(routes) <- rgeom3d_sfc routes From 753ec37b3d4f07b1cd66c17a9b8da9e1b6832fc6 Mon Sep 17 00:00:00 2001 From: RFlx Date: Tue, 16 Jun 2026 18:20:27 +0100 Subject: [PATCH 2/3] fix vignette with linestring break segments and add stplanar example for fixed lenght #66 --- vignettes/slopes.Rmd | 57 ++++++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 23 deletions(-) diff --git a/vignettes/slopes.Rmd b/vignettes/slopes.Rmd index e0ee341..c9309e7 100644 --- a/vignettes/slopes.Rmd +++ b/vignettes/slopes.Rmd @@ -98,7 +98,7 @@ library(sf) # Load example data data(lisbon_route) -dem_lisbon = dem_lisbon() +dem_lisbon <- dem_lisbon() ``` ## Add elevation to a linestring @@ -106,7 +106,7 @@ dem_lisbon = dem_lisbon() If you have a 2D linestring and a DEM, you can add elevation data to the linestring using `elevation_add()`: ```{r} -sf_linestring_xyz_local = elevation_add(lisbon_route, dem = dem_lisbon) +sf_linestring_xyz_local <- elevation_add(lisbon_route, dem = dem_lisbon) head(sf::st_coordinates(sf_linestring_xyz_local)) ``` @@ -123,7 +123,7 @@ If you don't have a local DEM, `elevation_add()` can download elevation data (th Once you have a 3D linestring (with XYZ coordinates), you can calculate its average slope using `slope_xyz()`: ```{r} -slope = slope_xyz(sf_linestring_xyz_local) +slope <- slope_xyz(sf_linestring_xyz_local) slope ``` @@ -141,37 +141,48 @@ plot_slope(sf_linestring_xyz_local, pal = pal, brks = brks) ## Working with segments -The `slopes` package can also work with individual segments of a linestring. -First, let's segment the `lisbon_route`: +The `slopes` package can also work with individual segments of a linestring. +There are two ways to split a route into segments: -```{r} -lisbon_route_segments = sf::st_segmentize(lisbon_route, dfMaxLength = 100) # Arbitrary length -lisbon_route_segments = sf::st_cast(lisbon_route_segments, "LINESTRING") -# Add elevation to segments -lisbon_route_segments_xyz = elevation_add(lisbon_route_segments, dem = dem_lisbon) -``` +### By vertex (native segments of the linestring) -Now calculate the slope for each segment: +`route_to_segments()` splits the route at every existing vertex, producing one 2-point segment per coordinate pair: ```{r} -lisbon_route_segments_xyz$slope = slope_xyz(lisbon_route_segments_xyz) +lisbon_route_xyz <- elevation_add(lisbon_route, dem = dem_lisbon()) +lisbon_route_segments_xyz <- route_to_segments(lisbon_route_xyz) +lisbon_route_segments_xyz$slope <- slope_xyz(lisbon_route_segments_xyz) summary(lisbon_route_segments_xyz$slope) ``` -You can plot these segments, for example, colored by their slope. Here we use `tmap` for a more advanced plot (requires `tmap` package). - -```{r, eval=FALSE} -# Requires tmap package -# library(tmap) -# qtm(lisbon_route_segments_xyz, lines.col = "slope", lines.lwd = 3) +```{r} +plot(st_geometry(lisbon_route_segments_xyz), + col = heat.colors(length(lisbon_route_segments_xyz$slope))[rank(lisbon_route_segments_xyz$slope)], + lwd = 3, main = "Slope by vertex segment" +) ``` -Alternatively, using base R graphics: +### By fixed length (using stplanr) + +`stplanr::line_segment()` splits the route into segments of a given length (e.g. 100 m). +Elevation must be added after segmenting, since the new endpoints won't have Z coordinates yet: ```{r} -plot(st_geometry(lisbon_route_segments_xyz), col = heat.colors(length(lisbon_route_segments_xyz$slope))[rank(lisbon_route_segments_xyz$slope)], lwd = 3) +if (requireNamespace("stplanr", quietly = TRUE)) { + lisbon_route_100m <- stplanr::line_segment(lisbon_route, segment_length = 100) + lisbon_route_100m_xyz <- elevation_add(lisbon_route_100m, dem = dem_lisbon()) + lisbon_route_100m_xyz$slope <- slope_xyz(lisbon_route_100m_xyz) + summary(lisbon_route_100m_xyz$slope) +} ``` -This vignette provides a basic overview. For more detailed information and advanced use cases, please refer to the other vignettes and the function documentation. - +```{r} +if (requireNamespace("stplanr", quietly = TRUE)) { + plot(st_geometry(lisbon_route_100m_xyz), + col = heat.colors(length(lisbon_route_100m_xyz$slope))[rank(lisbon_route_100m_xyz$slope)], + lwd = 3, main = "Slope by 100 m segment" + ) +} +``` +This vignette provides a basic overview. For more detailed information and advanced use cases, please refer to the other vignettes and the function documentation. From 9eb82468b7d2d49ecd07d778c6de12b5251c3894 Mon Sep 17 00:00:00 2001 From: RFlx Date: Tue, 16 Jun 2026 18:20:58 +0100 Subject: [PATCH 3/3] #66 add route_to_segments function to split linestrings into vertex-to-vertex segments --- NAMESPACE | 1 + R/slopes.R | 23 +++++++++++++++++++++++ man/route_to_segments.Rd | 26 ++++++++++++++++++++++++++ 3 files changed, 50 insertions(+) create mode 100644 man/route_to_segments.Rd diff --git a/NAMESPACE b/NAMESPACE index 415d49f..ca51d28 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(elevation_extract) export(elevation_get) export(plot_dz) export(plot_slope) +export(route_to_segments) export(sequential_dist) export(slope_distance) export(slope_distance_mean) diff --git a/R/slopes.R b/R/slopes.R index b2c8977..a6b3934 100644 --- a/R/slopes.R +++ b/R/slopes.R @@ -287,3 +287,26 @@ has_terra <- function() requireNamespace("terra", quietly = TRUE) is_linestring <- function(x) unique(sf::st_geometry_type(x)) == "LINESTRING" stop_is_not_linestring <- function(x) if (!is_linestring(x)) stop("Only works with LINESTRINGs. Convert with sf::st_cast()") stopifnotsf <- function(x, arg_name = "routes") if (!methods::is(x, "sf")) stop(arg_name, " is not an sf object. Try again with an sf object.") + +#' Split a route into vertex-to-vertex segments +#' +#' Splits a linestring with XYZ coordinates into individual 2-point segments, +#' one per consecutive vertex pair. Useful for computing per-segment slopes +#' with [slope_xyz()]. +#' +#' @param route_xyz An sf object with a single LINESTRING geometry with Z coordinates, +#' as returned by [elevation_add()]. +#' @return An sf object with one LINESTRING feature per vertex-to-vertex segment. +#' @export +#' @examples +#' route_xyz = elevation_add(lisbon_route, dem = dem_lisbon()) +#' segs = route_to_segments(route_xyz) +#' segs$slope = slope_xyz(segs) +#' summary(segs$slope) +route_to_segments <- function(route_xyz) { + coords <- sf::st_coordinates(route_xyz) + n <- nrow(coords) + segs <- lapply(seq_len(n - 1), function(i) sf::st_linestring(coords[i:(i + 1), 1:3])) + sf::st_sf(geometry = sf::st_sfc(segs, crs = sf::st_crs(route_xyz))) +} + diff --git a/man/route_to_segments.Rd b/man/route_to_segments.Rd new file mode 100644 index 0000000..3d9ab22 --- /dev/null +++ b/man/route_to_segments.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/slopes.R +\name{route_to_segments} +\alias{route_to_segments} +\title{Split a route into vertex-to-vertex segments} +\usage{ +route_to_segments(route_xyz) +} +\arguments{ +\item{route_xyz}{An sf object with a single LINESTRING geometry with Z coordinates, +as returned by \code{\link[=elevation_add]{elevation_add()}}.} +} +\value{ +An sf object with one LINESTRING feature per vertex-to-vertex segment. +} +\description{ +Splits a linestring with XYZ coordinates into individual 2-point segments, +one per consecutive vertex pair. Useful for computing per-segment slopes +with \code{\link[=slope_xyz]{slope_xyz()}}. +} +\examples{ +route_xyz = elevation_add(lisbon_route, dem = dem_lisbon()) +segs = route_to_segments(route_xyz) +segs$slope = slope_xyz(segs) +summary(segs$slope) +}