Potential create_cost_rasters function for spatialplanr

[ric325]

#' Creates a terra raster stack of cost layers with specified patterns and value ranges.
#' Useful for generating cost layers for testing
#'
#' All cost layers have the same range of costs
#' Cost 1: cost increases left to right
#' Cost 2: cost increases right to left
#' Cost 3: cost increases bottom to top
#' Cost 4: cost increases top to bottom
#' Cost 5: cost increases bottom left to top right
#' Cost 6: cost increases bottom right to top left
#' Cost 7: cost increases top left to bottom right
#' Cost 8: cost increases top right to bottom left
#' Cost 9: high in the middle, declines to outside
#' Cost 10: high on the outside, declines to middle
#' Additional layers: random cost raster

#' @param nrows The number of rows in the cost layer
#' @param ncols The number of columns in the cost layer
#' @param numrasters The number of raster layers in the raster stack
#' @param mincost The minimum cost for each raster layer
#' @param maxcost The maximum cost for each raster layer
#' @param layername The name for each raster layer, which is appended with the layer number for the name of each layer
#'
#' @return A terra raster stack of the specified number, size and values for different cost layers
#'
#' @examples
#' \dontrun{
#' cost_stack <- create_cost_rasters(nrows = 100, ncols = 100, numrasters = 10, mincost = 1, maxcost = 100, layername = "cost")
#' plot(cost_stack)
#' }
create_cost_rasters <- function(nrows = 100, ncols = 100, numrasters = 10, mincost = 1, maxcost = 100, layername = "cost") {
make_cost_raster <- function(direction = "left_to_right") {
if (direction == "left_to_right") {
vals <- rep(seq(mincost, maxcost, length.out = ncols), each = nrows)
mat <- matrix(vals, nrow = nrows, ncol = ncols, byrow = FALSE)
} else if (direction == "right_to_left") {
vals <- rep(seq(maxcost, mincost, length.out = ncols), each = nrows)
mat <- matrix(vals, nrow = nrows, ncol = ncols, byrow = FALSE)
} else if (direction == "bottom_to_top") {
vals <- rep(seq(mincost, maxcost, length.out = nrows), times = ncols)
mat <- matrix(vals, nrow = nrows, ncol = ncols, byrow = FALSE)
} else if (direction == "top_to_bottom") {
vals <- rep(seq(maxcost, mincost, length.out = nrows), times = ncols)
mat <- matrix(vals, nrow = nrows, ncol = ncols, byrow = FALSE)
} else if (direction == "bottom_left_to_top_right") {
mat <- outer(seq(mincost, maxcost, length.out = nrows),
seq(mincost, maxcost, length.out = ncols), FUN = "+")
mat <- mincost + (mat - 2 * mincost) / (2 * (maxcost - mincost)) * (maxcost - mincost)
} else if (direction == "bottom_right_to_top_left") {
mat <- outer(seq(mincost, maxcost, length.out = nrows),
seq(maxcost, mincost, length.out = ncols), FUN = "+")
mat <- mincost + (mat - 2 * mincost) / (2 * (maxcost - mincost)) * (maxcost - mincost)
} else if (direction == "top_left_to_bottom_right") {
mat <- outer(seq(maxcost, mincost, length.out = nrows),
seq(mincost, maxcost, length.out = ncols), FUN = "+")
mat <- mincost + (mat - 2 * mincost) / (2 * (maxcost - mincost)) * (maxcost - mincost)
} else if (direction == "top_right_to_bottom_left") {
mat <- outer(seq(maxcost, mincost, length.out = nrows),
seq(maxcost, mincost, length.out = ncols), FUN = "+")
mat <- mincost + (mat - 2 * mincost) / (2 * (maxcost - mincost)) * (maxcost - mincost)
} else if (direction == "high_middle") {
# High in the middle, declines to the outside
x <- seq(-1, 1, length.out = ncols)
y <- seq(-1, 1, length.out = nrows)
mat <- outer(y, x, function(a, b) sqrt(a^2 + b^2))
mat <- maxcost - (mat / max(mat)) * (maxcost - mincost)
} else if (direction == "high_outside") {
# High on the outside, declines to the middle
x <- seq(-1, 1, length.out = ncols)
y <- seq(-1, 1, length.out = nrows)
mat <- outer(y, x, function(a, b) sqrt(a^2 + b^2))
mat <- mincost + (mat / max(mat)) * (maxcost - mincost)
} else {
mat <- matrix(runif(nrows * ncols, mincost, maxcost), nrow = nrows, ncol = ncols)
}
terra::rast(mat)
}

raster_list <- list()
if (numrasters >= 1) raster_list[[1]] <- make_cost_raster("left_to_right")
if (numrasters >= 2) raster_list[[2]] <- make_cost_raster("right_to_left")
if (numrasters >= 3) raster_list[[3]] <- make_cost_raster("bottom_to_top")
if (numrasters >= 4) raster_list[[4]] <- make_cost_raster("top_to_bottom")
if (numrasters >= 5) raster_list[[5]] <- make_cost_raster("bottom_left_to_top_right")
if (numrasters >= 6) raster_list[[6]] <- make_cost_raster("bottom_right_to_top_left")
if (numrasters >= 7) raster_list[[7]] <- make_cost_raster("top_left_to_bottom_right")
if (numrasters >= 8) raster_list[[8]] <- make_cost_raster("top_right_to_bottom_left")
if (numrasters >= 9) raster_list[[9]] <- make_cost_raster("high_middle")
if (numrasters >= 10) raster_list[[10]] <- make_cost_raster("high_outside")
if (numrasters > 10) {
for (i in 11:numrasters) {
raster_list[[i]] <- make_cost_raster("random")
}
}

raster_stack <- terra::rast(raster_list)
names(raster_stack) <- paste0(layername, seq_len(numrasters))
return(raster_stack)
}