/
sample_existing.R
142 lines (130 loc) · 3.62 KB
/
sample_existing.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
#' Sample existing
#'
#' @description Sub-sample an existing sample. Four sampling methods are available:
#' \code{clhs}, \code{balanced}, \code{srs} and \code{strat}.
#'
#' @family sample functions
#'
#' @inheritParams sample_systematic
#' @inheritParams extract_strata
#' @inheritParams sample_clhs
#'
#' @param raster SpatRaster. Raster to guide the location of the samples. If \code{type = "clhs"} this raster can also
#' be used to define the population distributions to be used for sampling.
#' @param type Character. A string indicating the type of sampling method to use.
#' Possible values are \code{"clhs"}, \code{"balanced"}, \code{"srs"} and \code{"strat"}.
#' @param ... Additional arguments for the sampling method selected.
#'
#' @return An sf object of samples or a list object if \code{details = TRUE}
#'
#' @note When \code{type = "clhs"} or \code{type = "balanced"} all attributes in \code{existing} will be used for sampling.
#' Remove attributes not indented for sampling' prior to using this algorithm.
#'
#' @examples
#--- Load raster ---#
#' r <- system.file("extdata", "mraster.tif", package = "sgsR")
#' mr <- terra::rast(r)
#'
#' #--- generate an existing sample adn extract metrics ---#
#' e <- sample_systematic(raster = mr, cellsize = 200)
#' e <- extract_metrics(existing = e, mraster = mr)
#'
#' #--- perform clhs (default) sub-sampling ---#
#' sample_existing(
#' existing = e,
#' nSamp = 50
#' )
#'
#' #--- perform balanced sub-sampling ---#
#' sample_existing(
#' existing = e,
#' nSamp = 50,
#' type = "balanced"
#' )
#'
#' #--- perform simple random sub-sampling ---#
#' sample_existing(
#' existing = e,
#' nSamp = 50,
#' type = "srs"
#' )
#'
#' @author Tristan R.H. Goodbody
#'
#' @export
sample_existing <- function(existing,
nSamp,
raster = NULL,
type = "clhs",
access = NULL,
buff_inner = NULL,
buff_outer = NULL,
details = FALSE,
filename = NULL,
overwrite = FALSE,
...) {
#--- error handling ---#
if (!type %in% c("clhs", "balanced", "srs", "strat")) {
stop("'type' must be one of 'clhs','balanced', 'srs', 'strat'.", call. = FALSE)
}
check_existing(
existing = existing,
raster = raster,
nSamp = nSamp,
plot = FALSE,
details = details
)
existing <- prepare_existing(
existing = existing,
raster = raster,
access = access,
buff_inner = buff_inner,
buff_outer = buff_outer
)
#--- sampling ---#
if (type == "clhs") {
samples <- sample_existing_clhs(
existing = existing,
nSamp = nSamp,
filename = filename,
details = details,
overwrite = overwrite,
raster = raster,
...
)
}
if (type == "balanced") {
samples <- sample_existing_balanced(
existing = existing,
nSamp = nSamp,
filename = filename,
overwrite = overwrite,
...
)
}
if (type == "srs") {
samples <- sample_existing_srs(
existing = existing,
nSamp = nSamp,
filename = filename,
overwrite = overwrite
)
}
if (type == "strat") {
toSample <- calculate_allocation_existing(
existing = existing,
nSamp = nSamp,
...
)
samples <- sample_existing_strat(
existing = existing,
toSample = toSample,
filename = filename,
overwrite = overwrite
)
if (isTRUE(details)) {
samples <- list(samples = samples, details = toSample)
}
}
return(samples)
}