1
#' @include RcppExports.R raptr-internal.R generics.R
2
NULL
3

4
#' DemandPoints: An S4 class to represent demand points
5
#'
6
#' This class is used to store demand point information.
7
#'
8
#' @slot coords [base::matrix()] of coordinates for each demand point.
9
#'
10
#' @slot weights `numeric` weights for each demand point.
11
#'
12
#' @seealso [DemandPoints()].
13
#'
14
#' @name DemandPoints-class
15
#'
16
#' @rdname DemandPoints-class
17
#'
18
#' @exportClass DemandPoints
19
methods::setClass("DemandPoints",
20
  methods::representation(coords = "matrix", weights = "numeric"),
21
  validity = function(object) {
22
    # check coords have variance
23
    if (nrow(object@coords) > 1)
24
      assertthat::assert_that(max(apply(object@coords, 2,
25
                                        function(x) length(unique(x)))) > 1,
26
                              msg = "demand points must not all be identical")
27
    # check coords are not NA
28
    assertthat::assert_that(all(is.finite(c(object@coords))),
29
                            msg = paste0("argument to coords contains NA or ",
30
                                         "non-finite values"))
31
    assertthat::assert_that(nrow(object@coords) > 0,
32
                            msg = paste0("argument to coords must have at ",
33
                                         "least one row"))
34
    # weights
35
    assertthat::assert_that(all(is.finite(object@weights)),
36
                            msg = paste0("argument to weights contains NA or ",
37
                                         "non-finite values"))
38
    assertthat::assert_that(length(object@weights) > 0,
39
                            msg = paste0("argument to weights must have at ",
40
                                         "least one element"))
41
    assertthat::assert_that(all(object@weights > 0),
42
                            msg = paste0("argument to weights must have ",
43
                                         "positive numbers"))
44
    # cross-slot dependencies
45
    assertthat::assert_that(isTRUE(nrow(object@coords) ==
46
                                   length(object@weights)),
47
                            msg = paste0("argument to points must have have ",
48
                                         "the same number of rows as the ",
49
                                         "length of weights"))
50
    return(TRUE)
51
  }
52
)
53

54
#' Create new DemandPoints object
55
#'
56
#' This function creates a new DemandPoints object
57
#'
58
#' @param coords [base::matrix()] of coordinates for each demand
59
#'   point.
60
#' @param weights `numeric` weights for each demand point.
61
#'
62
#' @seealso [DemandPoints-class].
63
#'
64
#' @examples
65
#' # make demand points
66
#' dps <- DemandPoints(
67
#'  matrix(rnorm(100), ncol=2),
68
#'  runif(50))
69
#'
70
#' # print object
71
#' print(dps)
72
#'
73
#' @export
74
DemandPoints <- function(coords, weights) {
75 4
  dp <- methods::new("DemandPoints", coords = coords, weights = weights)
76 4
  methods::validObject(dp, test = FALSE)
77 4
  return(dp)
78
}
79

80
#' Generate demand points for RAP
81
#'
82
#' This function generates demand points to characterize a distribution of
83
#' points.
84
#'
85
#' @param points [base::matrix()] object containing points.
86
#'
87
#' @param n `integer` number of demand points to use for each attribute
88
#'   space for each species. Defaults to `100L`.
89
#'
90
#' @param quantile `numeric` quantile to generate demand points within. If
91
#'   0 then demand points are generated across the full range of values the
92
#'   `points` intersect. Defaults to `0.5`.
93
#'
94
#' @param kernel.method `character` name of kernel method to use to
95
#'   generate demand points. Defaults to `'ks'`.
96
#'
97
#' @param ... arguments passed to kernel density estimating functions
98
#'
99
#' @return [DemandPoints()] object.
100
#'
101
#' @details Broadly speaking, demand points are generated by fitting a kernal
102
#'   to the input `points`. A shape is then fit to the extent of
103
#'   the kernal, and then points are randomly generated inside the shape. The
104
#'   demand points are generated as random points inside the shape. The weights
105
#'   for each demand point are calculated the estimated density of input points
106
#'   at the demand point. By supplying 'ks' as an argument to `method` in
107
#'   `kernel.method`, the shape is defined using a minimum convex polygon
108
#'   [adehabitatHR::mcp()] and [ks::kde()] is used to fit
109
#'   the kernel. Note this can only be used when the data is low-dimensional (d
110
#'   < 3). By supplying `"hypervolume"` as an argument to `method`,
111
#'   the [hypervolume::hypervolume()] function is used to create the
112
#'   demand points. This method can be used for hyper-dimensional data
113
#'   (\eqn{d << 3}).
114
#'
115
#' @seealso [hypervolume::hypervolume()], [ks::kde()],
116
#'   [adehabitatHR::mcp()].
117
#'
118
#' @examples
119
#' # set random number generator seed
120
#' set.seed(500)
121
#'
122
#' # load data
123
#' data(cs_spp, cs_space)
124
#'
125
#' # generate species points
126
#' species.points <- randomPoints(cs_spp[[1]], n = 100, prob = TRUE)
127
#' env.points <- raster::extract(cs_space, species.points)
128
#'
129
#' # generate demand points for a 1d space using ks
130
#' dps1 <- make.DemandPoints(points = env.points[, 1], kernel.method = "ks")
131
#'
132
#' # print object
133
#' print(dps1)
134
#'
135
#' \dontrun{
136
#' # generate demand points for a 2d space using hypervolume
137
#' dps2 <- make.DemandPoints(points = env.points,
138
#'                           kernel.method = "hypervolume",
139
#'                           samples.per.point = 50,
140
#'                           verbose = FALSE)
141
#'
142
#' # print object
143
#' print(dps2)
144
#' }
145
#' @export
146
make.DemandPoints <- function(points, n = 100L, quantile = 0.5,
147
                              kernel.method = c("ks", "hypervolume")[1], ...) {
148
  # check inputs for validity
149 4
  assertthat::assert_that(sum(!is.finite(c(points))) == 0,
150 4
                          msg = paste0("argument to points contains ",
151 4
                                       "non-finite values"))
152 4
  kernel.method <- match.arg(kernel.method, c("ks", "hypervolume"))
153
  # convert to matrix
154 4
  if (!inherits(points, "matrix") && inherits(points, "numeric"))
155 4
      points <- matrix(points, ncol = 1)
156 4
  assertthat::assert_that(!(ncol(points) > 2 && kernel.method != "hypervolume"),
157 4
                          msg = paste0("argument to kernel.method must be ",
158 4
                                       "\"hypervolume\" when points has more ",
159 4
                                       "two columns"))
160
  # generate demand points
161 4
  if (kernel.method == "ks") {
162 4
    if (ncol(points) == 1) {
163 4
      dp <- demand.points.density1d(points, n = n, quantile = quantile, ...)
164
    }
165 4
    if (ncol(points) == 2) {
166 4
      dp <- demand.points.density2d(points, n = n, quantile = quantile, ...)
167
    }
168
  } else {
169 4
    dp <- demand.points.hypervolume(points, n = n, quantile = quantile, ...)
170
  }
171
  # return demand points
172 4
  return(DemandPoints(coords = dp$coords, weights = dp$weights))
173
}

Read our documentation on viewing source code .

Loading