🔨 costs from cell

DESCRIPTION

@@ -2,7 +2,7 @@ Package: enerscape
 Type: Package
 Title: Compute
  Energy Landscapes
-Version: 1.1.0
+Version: 1.1.1
 Author: Emilio Berti
 Maintainer: Emilio Berti <[email protected]>
 Description: Compute energy landscapes using a digital elevation model raster and body mass of animals.
@@ -18,7 +18,7 @@ Suggests:
     rmarkdown,
     testthat (>= 3.0.0)
 LinkingTo: Rcpp
-RoxygenNote: 7.2.0
+RoxygenNote: 7.3.2
 Depends: 
     R (>= 2.10)
 Config/testthat/edition: 3

R/RcppExports.R

@@ -30,9 +30,10 @@ energy <- function(slope, distance, mass, res, kcal = TRUE) {
 #' @param mass body mass of species (kg).
 #' @param res numeric value (double) of the spatial resolution of the matrix.
 #' @param kcal (boolean) if to return the result in kCal (true) or J (false).
+#' @param out (integer) if to calculate the costs for moving into the cell (0) or from it (1).
 #' @return Matrix with the energy cost of locomotion (EnergyScape).
-energyscape <- function(x, n = 4L, mass = 0, res = 0, kcal = TRUE) {
-    .Call(`_enerscape_energyscape`, x, n, mass, res, kcal)
+energyscape <- function(x, n = 4L, mass = 0, res = 0, kcal = TRUE, out = 0L) {
+    .Call(`_enerscape_energyscape`, x, n, mass, res, kcal, out)
 }
 
 #' Neighbours
@@ -51,8 +52,9 @@ neighbours <- function(i, j, n, x) {
 #' @param x matrix with values
 #' @param center numeric value (double) with the value of the focal cell
 #' @param res numeric value (double) of the spatial resolution of the matrix
+#' @param out (integer) if to calculate the costs for moving into the cell (0) or from it (1).
 #' @return Vector with values the slopes (degrees) between x and center
-slope <- function(x, center, res) {
-    .Call(`_enerscape_slope`, x, center, res)
+slope <- function(x, center, res, out) {
+    .Call(`_enerscape_slope`, x, center, res, out)
 }
 

R/enerscape.R

@@ -9,6 +9,8 @@ data("sirente")#' Compute Energy Landscapes
 #' @param m species body mass (kg).
 #' @param unit if joules ('joule') or kilocalories ('kcal').
 #' @param neigh number of neighbor cells that are connected together.
+#' @param direction character specifying if costs are to be calcualted for
+#'  moving into the focal cell (`in`) or from it (`out`).
 #' @return A list with elements a rasterStack of the digital elevation model,
 #'   slope, energy landscape, and conductance and the conductance as a transitionLayer for
 #'   path analysis.
@@ -34,7 +36,8 @@ enerscape <- function(
     dem,
     m,
     unit = "joule",
-    neigh = 8
+    neigh = 8,
+    direction = "in"
 ) {
   if (is.null(dem) | is.null(m)) {
     stop("Missing mandatory input - see ?enerscape for details.")
@@ -48,17 +51,27 @@ enerscape <- function(
   if (neigh != 4 && neigh != 8) {
     stop("'neigh' should be either 4 or 8.")
   }
+  if (direction != "in" && direction != "out") {
+    stop("'direction' must be either 'in' or 'out'.")
+  }
   # check units of DEM
   work_in_kcal <- ifelse(unit == "kcal", TRUE, FALSE)
-  stopifnot( abs(res(dem)[1] - res(dem)[2]) <= 1e-2 ) #tolerance = 1 cm 
+  stopifnot( abs(res(dem)[1] - res(dem)[2]) <= 1e-2 )  # tolerance = 1 cm 
   en_res <- res(dem)[1]
   message("DEM is assumed to have planar CRS in meters.")
+  out <- ifelse(direction == "in", 0L, 1L)
+  if (out) {
+    message("Costs are calculated for moving from the cell.")
+  }
   x <- matrix(dem, nrow = nrow(dem), ncol = ncol(dem), byrow = TRUE)
-  en <- energyscape(x,
-                    n = neigh,
-                    mass = m,
-                    kcal = work_in_kcal,
-                    res = en_res)
+  en <- energyscape(
+    x,
+    n = neigh,
+    mass = m,
+    kcal = work_in_kcal,
+    res = en_res,
+    out = out
+  )
   ans <- rast(en)
   names(ans) <- "EnergyScape"
   crs(ans) <- crs(dem)

README.md

@@ -15,6 +15,14 @@ Calculate Energy Landscapes For Terrestrial Animals.
 
 # Changelog
 
+## 1.1.1
+
+Add options to calculate costs _from_ cell rather than _to_ it.
+
+## 1.1.0
+
+Update the enerscape model following https://doi.org/10.1098/rsbl.2023.0492.
+
 ## 1.0.0
 
 This follows the transfer of functionalists of old GIS packages to _terra_, with _rgdal_, _rgeos_ scheduled to be retired in 2023: <https://r-spatial.org/r/2022/04/12/evolution.html>. I removed dependencies on _gDistance_, _raster_, _sp_, _rgeos_, and _rgdal_.

src/RcppExports.cpp

@@ -39,8 +39,8 @@ BEGIN_RCPP
 END_RCPP
 }
 // energyscape
-NumericMatrix energyscape(NumericMatrix x, int n, double mass, double res, bool kcal);
-RcppExport SEXP _enerscape_energyscape(SEXP xSEXP, SEXP nSEXP, SEXP massSEXP, SEXP resSEXP, SEXP kcalSEXP) {
+NumericMatrix energyscape(NumericMatrix x, int n, double mass, double res, bool kcal, int out);
+RcppExport SEXP _enerscape_energyscape(SEXP xSEXP, SEXP nSEXP, SEXP massSEXP, SEXP resSEXP, SEXP kcalSEXP, SEXP outSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
@@ -49,7 +49,8 @@ BEGIN_RCPP
     Rcpp::traits::input_parameter< double >::type mass(massSEXP);
     Rcpp::traits::input_parameter< double >::type res(resSEXP);
     Rcpp::traits::input_parameter< bool >::type kcal(kcalSEXP);
-    rcpp_result_gen = Rcpp::wrap(energyscape(x, n, mass, res, kcal));
+    Rcpp::traits::input_parameter< int >::type out(outSEXP);
+    rcpp_result_gen = Rcpp::wrap(energyscape(x, n, mass, res, kcal, out));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -68,25 +69,26 @@ BEGIN_RCPP
 END_RCPP
 }
 // slope
-NumericVector slope(NumericVector x, double center, double res);
-RcppExport SEXP _enerscape_slope(SEXP xSEXP, SEXP centerSEXP, SEXP resSEXP) {
+NumericVector slope(NumericVector x, double center, double res, int out);
+RcppExport SEXP _enerscape_slope(SEXP xSEXP, SEXP centerSEXP, SEXP resSEXP, SEXP outSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP);
     Rcpp::traits::input_parameter< double >::type center(centerSEXP);
     Rcpp::traits::input_parameter< double >::type res(resSEXP);
-    rcpp_result_gen = Rcpp::wrap(slope(x, center, res));
+    Rcpp::traits::input_parameter< int >::type out(outSEXP);
+    rcpp_result_gen = Rcpp::wrap(slope(x, center, res, out));
     return rcpp_result_gen;
 END_RCPP
 }
 
 static const R_CallMethodDef CallEntries[] = {
     {"_enerscape_distances", (DL_FUNC) &_enerscape_distances, 3},
     {"_enerscape_energy", (DL_FUNC) &_enerscape_energy, 5},
-    {"_enerscape_energyscape", (DL_FUNC) &_enerscape_energyscape, 5},
+    {"_enerscape_energyscape", (DL_FUNC) &_enerscape_energyscape, 6},
     {"_enerscape_neighbours", (DL_FUNC) &_enerscape_neighbours, 4},
-    {"_enerscape_slope", (DL_FUNC) &_enerscape_slope, 3},
+    {"_enerscape_slope", (DL_FUNC) &_enerscape_slope, 4},
     {NULL, NULL, 0}
 };
 

src/enerscape.cpp

@@ -14,10 +14,10 @@ using namespace Rcpp;
 //' @return Vector with the energy cost of locomotion (EnergyScape)
 // [[Rcpp::export]]
 NumericVector energy (
-    NumericVector slope ,
-    NumericVector distance ,
-    double mass ,
-    double res ,
+    NumericVector slope,
+    NumericVector distance,
+    double mass,
+    double res,
     bool kcal = true
 ) {
   const double PI =  3.1415926535;
@@ -44,14 +44,16 @@ NumericVector energy (
 //' @param mass body mass of species (kg).
 //' @param res numeric value (double) of the spatial resolution of the matrix.
 //' @param kcal (boolean) if to return the result in kCal (true) or J (false).
+//' @param out (integer) if to calculate the costs for moving into the cell (0) or from it (1).
 //' @return Matrix with the energy cost of locomotion (EnergyScape).
 // [[Rcpp::export]]
 NumericMatrix energyscape (
     NumericMatrix x,
     int n = 4,
     double mass = 0,
     double res = 0,
-    bool kcal = true
+    bool kcal = true,
+    int out = 0
 ) {
   if (mass == 0 || res == 0) {
     return 0;
@@ -69,7 +71,7 @@ NumericMatrix energyscape (
       if (neigh.size() == 0) {
         continue;
       }
-      sl = slope(neigh, x(i, j), res);
+      sl = slope(neigh, x(i, j), res, out);
       dist = distances(neigh, x(i, j), res);
       en = energy(sl, dist, mass, res, kcal);
       ans(i, j) = mean(en);

src/slope.h

@@ -6,9 +6,15 @@ using namespace Rcpp;
 //' @param x matrix with values
 //' @param center numeric value (double) with the value of the focal cell
 //' @param res numeric value (double) of the spatial resolution of the matrix
+//' @param out (integer) if to calculate the costs for moving into the cell (0) or from it (1).
 //' @return Vector with values the slopes (degrees) between x and center
 // [[Rcpp::export]]
-NumericVector slope ( NumericVector x , double center , double res ) {
+NumericVector slope (
+  NumericVector x,
+  double center,
+  double res,
+  int out
+) {
   const double PI =  3.1415926535;
   int n = x.size();
   NumericVector ans(n);
@@ -28,5 +34,8 @@ NumericVector slope ( NumericVector x , double center , double res ) {
     h = center - x[7];
     ans[7] = atan(h / (sqrt(2) * res)) * 180 / PI;
   }
+  if (out == 1) {
+    ans = -ans;
+  }
   return ans;
 }

tests/testthat/test-in-and-out.R

@@ -0,0 +1,19 @@
+test_that("in and out work", {
+  library(terra)
+  library(enerscape)
+  m <- matrix(sample(1:1e5, 9), ncol = 3)
+  in_slope <- slope(m, 5, m[2, 2], out = 0)
+  out_slope <- slope(m, 5, m[2, 2], out = 1)
+  expect_equal(in_slope, -out_slope)
+})
+
+test_that("in and out work", {
+  library(terra)
+  library(enerscape)
+  m <- matrix(sample(1:1e3, 1e2), ncol = 1e1)
+  r <- rast(m)
+  en_in <- enerscape(r, 1, direction = "in")
+  en_out <- enerscape(r, 1, direction = "out")
+  vals <- values(c(en_in, en_out))
+  expect_false(all(vals[, 1] == vals[, 2]))
+})

vignettes/enerscape.Rmd

@@ -70,6 +70,15 @@ plot(en_log)
 terra::contour(dem, add = TRUE, nlevels = 20)
 ```
 
+# In or Out movement
+By default, enerscape calculates the cost of moving _into_ a cell.
+However, it is possible to calculate the cost of moving _from_ the cell since enerscape v1.1.1.
+This is achieved by using the optional argument `direction = "out"`.
+```{r out}
+en_out_log <- log(enerscape(dem, 10, neigh = 4, unit = "kcal", direction = "out"))
+plot(c(en_log, en_out_log))
+```
+
 # Initialization files for Circuitscape/Omniscape
 
 Circuitscape and Omniscape are circuit theory approaches to calculate connectivity in landscapes.