/
get_boundaries.R
144 lines (111 loc) · 4.88 KB
/
get_boundaries.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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#' get_boundaries
#'
#' @description Get boundary cells of patches
#'
#' @param landscape SpatRaster or matrix.
#' @param consider_boundary Logical if cells that only neighbour the landscape
#' boundary should be considered as edge.
#' @param edge_depth Distance (in cells) a cell has the be away from the patch
#' edge to be considered as core cell.
#' @param as_NA If true, non-boundary cells area labeld NA.
#' @param patch_id If true, boundary/edge cells are labeled with the original patch id.
#' @param return_raster If false, matrix is returned.
#'
#' @details
#' All boundary/edge cells are labeled 1, all non-boundary cells 0. NA values are
#' not changed. Boundary cells are defined as cells that neighbour either a NA
#' cell or a cell with a different value than itself. Non-boundary cells only
#' neighbour cells with the same value than themself.
#'
#' @return List with SpatRaster or matrix
#'
#' @examples
#' landscape <- terra::rast(landscapemetrics::landscape)
#' class_1 <- get_patches(landscape, class = 1)[[1]][[1]]
#'
#' get_boundaries(class_1)
#' get_boundaries(class_1, return_raster = FALSE)
#'
#' @export
get_boundaries <- function(landscape,
consider_boundary = FALSE, edge_depth = 1,
as_NA = FALSE, patch_id = FALSE, return_raster = TRUE) {
landscape <- landscape_as_list(landscape)
result <- lapply(X = landscape, function(x) {
result_temp <- get_boundaries_calc(terra::as.matrix(x, wide = TRUE),
consider_boundary = consider_boundary,
edge_depth = edge_depth,
as_NA = as_NA,
patch_id = patch_id)
# convert back to raster
if (return_raster && !inherits(x = x, what = "matrix")) {
result_temp <- matrix_to_raster(matrix = result_temp,
landscape = x)
} else if (return_raster && inherits(x = x, what = "matrix")) {
warning("'return_raster = TRUE' not able for matrix input.",
call. = FALSE)
}
return(result_temp)
})
# names(result) <- paste0("layer_", 1:length(result))
return(result)
}
get_boundaries_calc <- function(landscape,
consider_boundary,
edge_depth,
as_NA,
patch_id) {
# add padding for landscape boundary
if (!consider_boundary) {
landscape <- pad_raster_internal(landscape, pad_raster_value = NA,
pad_raster_cells = 1, global = FALSE)
}
# get boundaries
landscape_boundaries <- rcpp_get_boundaries(landscape, directions = 4)
# loop if edge_depth > 1
if (edge_depth > 1) {
# save original landscape
landscape_boundaries_temp <- landscape_boundaries
# first edge depth already labels
for (i in seq_len(edge_depth - 1)) {
# set all already edge to NA
landscape_boundaries_temp[landscape_boundaries_temp == 1] <- NA
# set current_edge + 1 to new edge
landscape_boundaries_temp <- rcpp_get_boundaries(landscape_boundaries_temp,
directions = 4)
landscape_boundaries[which(landscape_boundaries_temp[] == 1)] <- 1
}
}
# remove padded rows/cols
if (!consider_boundary) {
landscape_boundaries <- unpad_raster_internal(landscape_boundaries,
unpad_raster_cells = 1)
}
# use original patch id
if (patch_id) {
# issue if class 0 is present because used for non-edge cells
present_classes <- get_unique_values_int(landscape, verbose = FALSE)
if (any(present_classes == 0)) {
warning("Not able to use original patch id because at least one id equals zero.",
call. = FALSE)
}
# relabel edge cells (value = 1) with original patch id
else {
# remove padded rows/cols
if (!consider_boundary) {
landscape <- unpad_raster(landscape,
unpad_raster_cells = 1,
return_raster = FALSE,
to_disk = FALSE)[[1]]
}
landscape_boundaries[landscape_boundaries == 1 &
!is.na(landscape_boundaries)] <- landscape[landscape_boundaries == 1 &
!is.na(landscape_boundaries)]
}
}
# convert all 0 as NA
if (as_NA) {
landscape_boundaries[which(landscape_boundaries == 0)] <- NA
}
return(landscape_boundaries)
}