R/hf_rasterize.R

Defines functions hf_rasterize

Documented in hf_rasterize

#' Terrain to raster
#'
#' Converts a cost `terrain` into a raster representing
#' travel cost, specifically the average cost of moving from/to each
#' cell. Mostly useful for visualizing with `terra::plot()`
#' as a sanity check.
#'
#' @param x a cost `terrain` generated by `hf_terrain()`.
#'
#' @return a `SpatRaster` with travel cost values.
#' @export
#'
#' @examples
#' library(terra)
#'
#' fn <- system.file("extdata/red_butte_dem.tif", package = "hiker")
#' red_butte_dem <- rast(fn)
#'
#' terrain <- hf_terrain(red_butte_dem)
#'
#' r_terrain <- hf_rasterize(terrain)
#'
hf_rasterize <- function(x) {

  stop_if_not_terrain(x)

  rr <- terra::rast(
    nrow   = x$nrow,
    ncol   = x$ncol,
    extent = terra::ext(x$bb8),
    crs    = x$crs
  )

  # this part is basically what Jacob van Etten does with
  # gdistance::raster(TransitionLayer), though that offers more options
  # here I am just averaging the vertical and horizontal sums
  total_row <- Matrix::rowSums(x$conductance)
  total_col <- Matrix::colSums(x$conductance)


  #logical sparse matrix, identifies number of adjacent cells
  lm <- methods::as(x$conductance, "lMatrix")

  n_row <- Matrix::rowSums(lm)
  n_col <- Matrix::colSums(lm)

  # average cost of moving from/to each cell
  # values <- total_cost / n_adjacent
  v_row <- total_row / n_row
  v_col <- total_col / n_col

  values <- (v_row + v_col)/2

  terra::setValues(rr, (1/values))

}
kbvernon/hiker documentation built on Dec. 9, 2022, 11:16 p.m.