-
Notifications
You must be signed in to change notification settings - Fork 1
/
to_rast.R
94 lines (81 loc) · 2.98 KB
/
to_rast.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#' Transformation `sim_results` To Raster
#'
#' This function transforms selected subset of abundance matrices from
#' `sim_results` into [`SpatRaster`][terra::SpatRaster-class] object. Layers are
#' specified by `time_points` that can be one point in time or many.
#'
#' @param sim_results `sim_results` object created by [`sim`]
#' @param time_points numeric vector of length 1 or more; specifies points in
#' time from which [`SpatRaster`][terra::SpatRaster-class] will be created
#' - as default the last year of simulation; if `length(time_points) > 0`
#' [`SpatRaster`][terra::SpatRaster-class] will be returned with layers for
#' each element of `time_points`
#' @param template [`SpatRaster`][terra::SpatRaster-class] object; can be used
#' as template to create returned object
#'
#' @return [`SpatRaster`][terra::SpatRaster-class] based on `sim_results` object
#' with layers corresponding to `time_points`
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # data preparation
#' library(terra)
#'
#' n1_small <- rast(system.file("input_maps/n1_small.tif", package = "rangr"))
#' K_small <- rast(system.file("input_maps/K_small.tif", package = "rangr"))
#'
#' sim_data <- initialise(
#' n1_map = n1_small,
#' K_map = K_small,
#' r = log(2),
#' rate = 1 / 1e3
#' )
#'
#' # simulation
#' sim_1 <- sim(obj = sim_data, time = 100)
#'
#' # raster construction
#' my_rast <- to_rast(
#' sim_1,
#' time_points = c(1, 10, 20, 100),
#' template = sim_data$K_map
#' )
#'
#' # visualization
#' plot(my_rast, range = range(sim_1$N_map, na.rm = TRUE))
#'
#' }
#'
#' @srrstats {G1.4} uses roxygen documentation
#' @srrstats {G2.0a} documented lengths expectation
#' @srrstats {G2.1a, SP2.6} documented types expectation
#' @srrstats {SP2.0a} conversion to [`SpatRaster`][terra::SpatRaster-class]
#' @srrstats {SP2.3} load data in spatial formats
#' @srrstats {SP4.0, SP4.0b} returns [`SpatRaster`][terra::SpatRaster-class]
#' object
#' @srrstats {SP4.1} returned object has the same unit as the input
#' (if the template is provided)
#' @srrstats {SP4.2} returned values are documented
#'
to_rast <- function(
sim_results, time_points = sim_results$simulated_time, template = NULL) {
#' @srrstats {SP2.7} validate input class
assert_that(inherits(sim_results, "sim_results"))
if(is.null(template)) {
#' @srrstats {G2.9} make default raster and show warning
warning("No template provided. Returned SpatRaster lacks geographical information (you can use one of the input maps from the sim_data object as template)") #nolint
out <- rast(sim_results$N_map[, , time_points])
} else {
# check if template and x have the same dimension
if (!all(dim(sim_results$N_map)[c(1, 2)] == dim(template)[c(1, 2)])) {
stop("sim_resulst and template are not compatible with each other - dimensions of the study area do not match")
}
out <- template
nlyr(out) <- length(time_points)
values(out) <- sim_results$N_map[, , time_points]
}
names(out) <- paste("t", time_points, sep = "_")
return(out)
}