-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathkud_tools.R
272 lines (251 loc) · 11.9 KB
/
kud_tools.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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
######################################
######################################
#### kud_habitat()
#' @title Define a `habitat' grid for kernel smoothing
#' @description This function defines a `habitat' grid for kernel smoothing (e.g., via \code{\link[flapper]{kud_around_coastline}}).
#' @param map A \code{\link[raster]{raster}} that defines grid properties.
#' @param mask,mask_inside Mask options passed to \code{\link[flapper]{mask_io}}.
#' @param plot,... A logical input that defines whether or not to plot the habitat grid, alongside any additional arguments passed to \code{\link[sp]{plot.SpatialPixelsDataFrame}}.
#' @return The function returns a \code{\link[sp]{SpatialPixelsDataFrame}} object that defines `habitat' (1) versus `non-habitat' (0).
#' @examples
#' kud_habitat(map = dat_gebco, mask_inside = FALSE)
#' kud_habitat(map = dat_gebco, mask = dat_coast, mask_inside = TRUE)
#' @seealso \code{\link[flapper]{kud_around_coastline}}
#' @author Edward Lavender
#' @export
kud_habitat <- function(map, mask = map, mask_inside = FALSE, plot = TRUE, ...) {
par_param <- graphics::par(no.readonly = TRUE)
area <- raster::setValues(map, 1)
if (!is.null(mask)) area <- mask_io(area, mask = mask, mask_inside = mask_inside, updatevalue = 0)
grid <- methods::as(area, "SpatialPixelsDataFrame")
if (plot) sp::plot(grid, ...)
on.exit(graphics::par(par_param), add = TRUE)
return(grid)
}
######################################
######################################
#### kud_around_coastline_*()
#' @title Process a kernel utilisation distribution around a barrier
#' @description Given an animal movement path over a gridded surface, \code{\link[flapper]{kud_around_coastline}} estimates a `raw' kernel utilisation distribution (from \code{\link[adehabitatHR]{kernelUD}}) and then processes the distribution to account for barriers to movement, such as coastline. \code{\link[flapper]{kud_around_coastline_fast}} is a bare-bones implementation of this function for iterative applications. To implement these functions, the movement path(s) should be supplied as a SpatialPointsDataFrame and the grid over which estimation is implemented as a SpatialPixelsDataFrame with values 0 and 1 defining unsuitable and suitable habitat respectively.
#'
#' @param xy A \code{\link[sp]{SpatialPointsDataFrame}} object that defines the movement path(s). This should contain a column that defines the individual ID(s) as a factor. \code{\link[flapper]{kud_around_coastline_fast}} can only handle one individual.
#' @param grid A \code{\link[sp]{SpatialPixelsDataFrame}} object that defines the grid over which estimation is implemented and binary habitat suitability (0, unsuitable; or 1, suitable).
#' @param ... Additional arguments passed to \code{\link[adehabitatHR]{kernelUD}}.
#'
#' @details Utilisation distributions (UDs) are bivariate probability distributions that describe the probability (density) of locating an individual in any given area at a randomly chosen time. These can be estimated using the \code{\link[adehabitatHR]{kernelUD}} function. The algorithms implemented by \code{\link[adehabitatHR]{kernelUD}} function can incorporate simple barriers, but restrictions on the shapes of barriers mean that in many real-world settings (e.g., in areas with complex coastline) barriers cannot be implemented. As a result, a pragmatic (if somewhat unsatisfactory) approach is to post-process the raw utilisation distribution by removing areas in which movement is impossible and then re-normalise the distribution (so that probabilities sum to one). These functions achieve this by implementing the estimation over a grid, which defines whether (1) or not (0) an area is `habitat'. After the estimation of the raw UD across the grid, probability density scores are combined (multiplied) with the habitat suitability score (0, 1) and then renormalised (by dividing by the total score across suitable areas).
#'
#' To implement these routines, \code{\link[flapper]{kud_around_coastline}} is typically the preferable option. \code{\link[flapper]{kud_around_coastline}} is a bare-bones implementation of the routines within \code{\link[flapper]{kud_around_coastline}} that has is designed to be (marginally) faster (e.g., for iterative applications). This function skips checks on user inputs, assuming that \code{xy} and \code{grid} have been correctly specified (as a \code{\link[sp]{SpatialPointsDataFrame}} for a specific individual and a \code{\link[sp]{SpatialPixelsDataFrame}} respectively), implements the estimation and returns a \code{\link[raster]{raster}} rather than an `estUDm' object (see Value).
#'
#' @return
#' \itemize{
#' \item \code{\link[flapper]{kud_around_coastline}} returns an object of class `estUDm'. This is a list, with one component per animal, of \code{\link[adehabitatHR]{estUD-class}} objects. The `h' slot of the output (\code{output@h}) has been modified so that the method (`meth') is given as `specified'.
#' \item \code{\link[flapper]{kud_around_coastline_fast}} returns an object of class `RasterLayer'.
#' }
#'
#' @examples
#' #### Set up
#' ## (1) Simulate path for which to compute UD
#' # Focus on a sample of the marine environment off Oban, West Scotland
#' sea <- invert_poly(dat_coast)
#' sea <- raster::crop(sea, update_extent(raster::extent(sea), x_shift = -2500))
#' prettyGraphics::pretty_map(add_polys = list(x = sea, col = "skyblue"))
#' # Simulate path
#' n <- 1000
#' path_ls <- sim_path_sa(
#' n = n,
#' area = sea,
#' sim_step = function(...) stats::rgamma(1, shape = 20, scale = 20),
#' seed = 1,
#' plot = FALSE
#' )
#' prettyGraphics::add_sp_path(path_ls$xy_mat,
#' col = viridis::viridis(n),
#' length = 0.02
#' )
#' ## (2) Define path as a SpatialPointsDataFrame (SpatialPoints is not allowed)
#' path <- sp::SpatialPointsDataFrame(
#' path_ls$xy_mat,
#' data = data.frame(ID = factor(rep(1, nrow(path_ls$xy_mat)))),
#' proj4string = raster::crs(dat_coast)
#' )
#' ## (3) Define grid over which to implement estimation
#' # ... The grid needs to be sufficiently small to capture the coastline
#' # ... reasonably while being large enough to enable calculation
#' # ... of the home range.
#' r <- raster::raster(raster::extent(dat_coast), nrows = 100, ncols = 100)
#' raster::values(r) <- 0
#' r <- raster::mask(r, dat_coast, updatevalue = 1)
#' habitat <- methods::as(r, "SpatialPixelsDataFrame")
#' sp::plot(habitat)
#'
#' #### Example (1) Implement estimation and processing
#' ## Estimate raw UD
#' ud_raw <- adehabitatHR::kernelUD(xy = path, grid = habitat)
#' # Object is of class estUDm, which is a list of estUD objects
#' # The outputs for each animal can be accessed by indexing
#' ud_raw[[1]]
#' # Check smoothing parameters
#' ud_raw[[1]]@h
#' ## Estimate raw UD and post-process
#' ud_pro <- kud_around_coastline(xy = path, grid = habitat)
#' # The same type of object is returned
#' ud_pro[[1]]
#' # Smoothing parameters have been modified
#' ud_pro[[1]]@h
#' ## Compare plots
#' # ... Notice that the processed version doesn't 'bleed' onto land
#' # ... and the scale differs due to the re-normalisation
#' ud_raw_r <- raster::raster(ud_raw[[1]])
#' ud_pro_r <- raster::raster(ud_pro[[1]])
#' pp <- graphics::par(mfrow = c(1, 2))
#' prettyGraphics::pretty_map(
#' add_rasters = list(x = ud_raw_r),
#' add_polys = list(x = dat_coast),
#' add_paths = list(
#' x = path,
#' col = viridis::viridis(n),
#' lwd = 0.25,
#' length = 0.02
#' )
#' )
#' prettyGraphics::pretty_map(
#' add_rasters = list(x = ud_pro_r),
#' add_polys = list(x = dat_coast),
#' add_paths = list(
#' x = path,
#' col = viridis::viridis(n),
#' lwd = 0.25,
#' length = 0.02
#' )
#' )
#' graphics::par(pp)
#'
#' #### Further analysis can be implemented as usual
#' # For example we can compute the home range contours from the UD
#' # ... using adehabitatHR::getvolumeUD(). In practice, this converts from the
#' # ... probability density scale to a more intuitive % home range scale.
#' # Get volume
#' vol_raw <- adehabitatHR::getvolumeUD(ud_raw, standardize = TRUE)
#' vol_pro <- adehabitatHR::getvolumeUD(ud_pro, standardize = TRUE)
#' # Get contours
#' ver_raw <- adehabitatHR::getverticeshr(ud_raw[[1]], standardize = TRUE)
#' ver_pro <- adehabitatHR::getverticeshr(ud_pro[[1]], standardize = TRUE)
#' # Rasterise
#' vol_raw_r <- raster::raster(vol_raw[[1]])
#' vol_pro_r <- raster::raster(vol_pro[[1]])
#' # For neatness on the plot, it is convenient to exclude areas beyond 95 %
#' vol_raw_r[vol_raw_r[] > 95] <- NA
#' vol_pro_r[vol_pro_r[] > 95] <- NA
#' # Plot
#' pp <- graphics::par(mfrow = c(1, 2))
#' prettyGraphics::pretty_map(
#' add_rasters = list(x = vol_raw_r),
#' add_polys = list(
#' list(x = dat_coast),
#' list(
#' x = ver_raw,
#' border = "blue",
#' lwd = 2
#' )
#' ),
#' add_paths = list(
#' x = path,
#' col = viridis::viridis(n),
#' lwd = 0.25,
#' length = 0.02
#' )
#' )
#' prettyGraphics::pretty_map(
#' add_rasters = list(x = vol_pro_r),
#' add_polys = list(
#' list(x = dat_coast),
#' list(
#' x = ver_pro,
#' border = "blue",
#' lwd = 2
#' )
#' ),
#' add_paths = list(
#' x = path,
#' col = viridis::viridis(n),
#' lwd = 0.25,
#' length = 0.02
#' )
#' )
#' graphics::par(pp)
#'
#' @source This forum is a useful resource: http://r-sig-geo.2731867.n2.nabble.com/Walruses-and-adehabitatHR-class-estUDm-exclusion-of-non-habitat-pixels-and-summary-over-all-animals-td6497315.html.
#' @author Edward Lavender
#' @name kud_around_coastline
NULL
#### kud_around_coastline()
#' @rdname kud_around_coastline
#' @export
kud_around_coastline <- function(xy, grid, ...) {
## Define raw UD
ud <- adehabitatHR::kernelUD(xy, grid = grid, ...)
names_ud <- names(ud)
## Checks
if (!inherits(xy, "SpatialPointsDataFrame")) {
message("'xy' is not a SpatialPointsDataFrame: returning raw UD as post-processing cannot be implemented.")
return(ud)
}
if (!inherits(grid, "SpatialPointsDataFrame")) {
message("'grid' is not a SpatialPixelsDataFrame: returning raw UD as post-processing cannot be implemented.")
return(ud)
}
## Convert it to SpatialPixelsDataFrame:
ud <- adehabitatHR::estUDm2spixdf(ud) # ud as SpatialPointsDataFrame required for estUDm2spixdf function.
## Convert to SpatialGridDataFrames
sp::fullgrid(ud) <- TRUE
sp::fullgrid(grid) <- TRUE
## Exclude areas of 'unsuitable habitat' and renormalise
# ... by multiplying the value of the UD by the habitat (0, 1) and
# ... dividing by the total value of the UD
ud_vals_renorm <- lapply(1:ncol(ud), function(i) {
ud[[i]] * grid[[1]] / sum(ud[[i]] * grid[[1]])
})
ud_vals_renorm <- as.data.frame(ud_vals_renorm)
names(ud_vals_renorm) <- "ud"
## Add to UD as data slot
ud@data <- ud_vals_renorm
# sum(ud@data) == 1
## Coerce object back to estUD-class
# This is simplify a SpatialPixelsDataFrame with a slot for h and a slot for vol
sp::fullgrid(ud) <- FALSE
ud_ade <- lapply(1:ncol(ud), function(i) {
so <- methods::new("estUD", ud[, i])
so@h <- list(h = 0, meth = "specified")
so@vol <- FALSE
return(so)
})
names(ud_ade) <- names_ud
class(ud_ade) <- "estUDm"
## Return
return(ud_ade)
}
#### kud_around_coastline_fast
#' @rdname kud_around_coastline
#' @export
kud_around_coastline_fast <- function(xy, grid, ...) {
## Define raw UD
ud <- adehabitatHR::kernelUD(xy, grid = grid, ...)
## Define SpatialGridDataFrames:
# This assumes xy is a SpatialPointsDataFrame
ud <- adehabitatHR::estUDm2spixdf(ud)
sp::fullgrid(ud) <- TRUE
sp::fullgrid(grid) <- TRUE
## Exclude areas of 'unsuitable habitat' and renormalise
# ... by multiplying the value of the UD by the habitat (0, 1) and
# ... dividing by the total value of the UD
ud_vals_renorm <- lapply(1:ncol(ud), function(i) {
ud[[i]] * grid[[1]] / sum(ud[[i]] * grid[[1]])
})
ud_vals_renorm <- as.data.frame(ud_vals_renorm)
## Add to UD as data slot
ud@data <- ud_vals_renorm
## Coerce object to raster
ud_ade <- raster::raster(ud)
## Return
return(ud_ade)
}