From 846cd86da4517d01707dd655b15cf181cb3c42ad Mon Sep 17 00:00:00 2001 From: Robin Lovelace Date: Fri, 3 Sep 2021 17:25:26 +0100 Subject: [PATCH] Add directed, progress on #20 --- DESCRIPTION | 3 ++- R/slopes.R | 33 ++++++++++++++++++++++++++------- man/slope_matrix.Rd | 15 ++++++++++++--- man/slope_vector.Rd | 13 ++++++++++--- man/z_value.Rd | 1 + 5 files changed, 51 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e6509c..ec29edf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Suggests: stplanr, dplyr, rgdal, - tmap + tmap, + leaflet VignetteBuilder: knitr Config/testthat/edition: 3 diff --git a/R/slopes.R b/R/slopes.R index 95fb456..0c95f1a 100644 --- a/R/slopes.R +++ b/R/slopes.R @@ -21,6 +21,9 @@ #' @param x Vector of locations #' @param d Vector of distances between points #' @param elevations Elevations in same units as x (assumed to be metres) +#' @param directed Should the value be directed? `FALSE` by default. +#' If `TRUE` the result will be negative when it represents a downslope +#' (when the end point is lower than the start point). #' @return A vector of slope gradients associated with each linear element #' (each line between consecutive vertices) associated with linear features. #' Returned values for `slope_distance_mean()` and @@ -60,7 +63,8 @@ slope_distance = function(d, elevations) { slope_distance_mean = function(d, elevations, directed = FALSE) { e_change = diff(elevations) if(directed) { - mean(abs(e_change) / d) * sign(tail(elevations, 1) - head(elevations, 1)) + mean(abs(e_change) / d) * + sign(utils::tail(elevations, 1) - utils::head(elevations, 1)) } else { mean(abs(e_change) / d) } @@ -71,7 +75,7 @@ slope_distance_weighted = function(d, elevations, directed = FALSE) { e_change = diff(elevations) if(directed) { stats::weighted.mean(abs(e_change) / d, d) * - sign(tail(elevations, 1) - head(elevations, 1)) + sign(utils::tail(elevations, 1) - utils::head(elevations, 1)) } else { stats::weighted.mean(abs(e_change) / d, d) } @@ -103,10 +107,15 @@ slope_distance_weighted = function(d, elevations, directed = FALSE) { #' @examples #' x = c(0, 2, 3, 4, 5, 9) #' y = c(0, 0, 0, 0, 0, 9) -#' z = c(1, 2, 2, 4, 3, 1) / 10 +#' z = c(1, 2, 2, 4, 3, 0) / 10 #' m = cbind(x, y, z) #' slope_matrix_weighted(m, lonlat = FALSE) +#' slope_matrix_weighted(m, lonlat = FALSE, directed = TRUE) +#' # 0 value returned if no change in elevation: +#' slope_matrix_weighted(m,lonlat = FALSE, directed = TRUE, +#' elevations = c(1, 2, 2, 4, 3, 1)) #' slope_matrix_mean(m, lonlat = FALSE) +#' slope_matrix_mean(m, lonlat = FALSE, directed = TRUE) #' plot(x, z, ylim = c(-0.5, 0.5), type = "l") #' (gx = slope_vector(x, z)) #' (gxy = slope_matrix(m, lonlat = FALSE)) @@ -123,17 +132,27 @@ slope_matrix = function(m, elevations = m[, 3], lonlat = TRUE) { } #' @rdname slope_matrix #' @export -slope_matrix_mean = function(m, elevations = m[, 3], lonlat = TRUE) { +slope_matrix_mean = function(m, elevations = m[, 3], lonlat = TRUE, directed = FALSE) { g1 = slope_matrix(m, elevations = elevations, lonlat = lonlat) d = sequential_dist(m = m, lonlat = lonlat) - mean(abs(g1), na.rm = TRUE) + if(directed) { + mean(abs(g1), na.rm = TRUE) * + sign(utils::tail(elevations, 1) - utils::head(elevations, 1)) + } else { + mean(abs(g1), na.rm = TRUE) + } } #' @rdname slope_matrix #' @export -slope_matrix_weighted = function(m, elevations = m[, 3], lonlat = TRUE) { +slope_matrix_weighted = function(m, elevations = m[, 3], lonlat = TRUE, directed = FALSE) { g1 = slope_matrix(m, elevations = elevations, lonlat = lonlat) d = sequential_dist(m = m, lonlat = lonlat) - stats::weighted.mean(abs(g1), d, na.rm = TRUE) + if(directed) { + stats::weighted.mean(abs(g1), d, na.rm = TRUE) * + sign(utils::tail(elevations, 1) - utils::head(elevations, 1)) + } else { + stats::weighted.mean(abs(g1), d, na.rm = TRUE) + } } #' Calculate the sequential distances between sequential coordinate pairs diff --git a/man/slope_matrix.Rd b/man/slope_matrix.Rd index 5c5e0be..98ba9bf 100644 --- a/man/slope_matrix.Rd +++ b/man/slope_matrix.Rd @@ -8,9 +8,9 @@ \usage{ slope_matrix(m, elevations = m[, 3], lonlat = TRUE) -slope_matrix_mean(m, elevations = m[, 3], lonlat = TRUE) +slope_matrix_mean(m, elevations = m[, 3], lonlat = TRUE, directed = FALSE) -slope_matrix_weighted(m, elevations = m[, 3], lonlat = TRUE) +slope_matrix_weighted(m, elevations = m[, 3], lonlat = TRUE, directed = FALSE) } \arguments{ \item{m}{Matrix containing coordinates and elevations. @@ -26,6 +26,10 @@ Default value: \code{m[, 3]}, meaning the 'z' coordinate in a matrix of coordinates.} \item{lonlat}{Are the coordinates in lon/lat (geographic) coordinates? TRUE by default.} + +\item{directed}{Should the value be directed? \code{FALSE} by default. +If \code{TRUE} the result will be negative when it represents a downslope +(when the end point is lower than the start point).} } \value{ A vector of slope gradients associated with each linear element @@ -44,10 +48,15 @@ Calculate the gradient of line segments from a 3D matrix of coordinates \examples{ x = c(0, 2, 3, 4, 5, 9) y = c(0, 0, 0, 0, 0, 9) -z = c(1, 2, 2, 4, 3, 1) / 10 +z = c(1, 2, 2, 4, 3, 0) / 10 m = cbind(x, y, z) slope_matrix_weighted(m, lonlat = FALSE) +slope_matrix_weighted(m, lonlat = FALSE, directed = TRUE) +# 0 value returned if no change in elevation: +slope_matrix_weighted(m,lonlat = FALSE, directed = TRUE, + elevations = c(1, 2, 2, 4, 3, 1)) slope_matrix_mean(m, lonlat = FALSE) +slope_matrix_mean(m, lonlat = FALSE, directed = TRUE) plot(x, z, ylim = c(-0.5, 0.5), type = "l") (gx = slope_vector(x, z)) (gxy = slope_matrix(m, lonlat = FALSE)) diff --git a/man/slope_vector.Rd b/man/slope_vector.Rd index 3a371d5..325669f 100644 --- a/man/slope_vector.Rd +++ b/man/slope_vector.Rd @@ -11,9 +11,9 @@ slope_vector(x, elevations) slope_distance(d, elevations) -slope_distance_mean(d, elevations) +slope_distance_mean(d, elevations, directed = FALSE) -slope_distance_weighted(d, elevations) +slope_distance_weighted(d, elevations, directed = FALSE) } \arguments{ \item{x}{Vector of locations} @@ -21,6 +21,10 @@ slope_distance_weighted(d, elevations) \item{elevations}{Elevations in same units as x (assumed to be metres)} \item{d}{Vector of distances between points} + +\item{directed}{Should the value be directed? \code{FALSE} by default. +If \code{TRUE} the result will be negative when it represents a downslope +(when the end point is lower than the start point).} } \value{ A vector of slope gradients associated with each linear element @@ -52,12 +56,15 @@ on the resulting gradient estimate (see examples). } \examples{ x = c(0, 2, 3, 4, 5, 9) -elevations = c(1, 2, 2, 4, 3, 1) / 10 +elevations = c(1, 2, 2, 4, 3, 0) / 10 # downward slope overall slope_vector(x, elevations) m = sf::st_coordinates(lisbon_road_segment) d = sequential_dist(m, lonlat = FALSE) elevations = elevation_extract(m, dem_lisbon_raster) slope_distance(d, elevations) slope_distance_mean(d, elevations) +slope_distance_mean(d, elevations, directed = TRUE) +slope_distance_mean(rev(d), rev(elevations), directed = TRUE) slope_distance_weighted(d, elevations) +slope_distance_weighted(d, elevations, directed = TRUE) } diff --git a/man/z_value.Rd b/man/z_value.Rd index 98cee85..6d631f2 100644 --- a/man/z_value.Rd +++ b/man/z_value.Rd @@ -52,4 +52,5 @@ z_end(x) z_direction(x) z_elevation_change_start_end(x) z_direction(x) +z_cumulative_difference(x) }