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
|
#' Matrix Functions
#'
#' These functions are similar to accessors and predicates, but instead of
#' recycling `x` and `y` to a common length and returning a vector of that
#' length, these functions return a vector of length `x` with each element
#' `i` containing information about how the entire vector `y` relates to
#' the feature at `x[i]`.
#'
#' @inheritParams s2_is_collection
#' @inheritParams s2_contains
#' @param x,y Geography vectors, coerced using [as_s2_geography()].
#' `x` is considered the source, where as `y` is considered the target.
#' @param k The number of closest edges to consider when searching. Note
#' that in S2 a point is also considered an edge.
#' @param min_distance The minimum distance to consider when searching for
#' edges. This filter is applied after the search is complete (i.e.,
#' may cause fewer than `k` values to be returned).
#' @param max_distance The maximum distance to consider when searching for
#' edges. This filter is applied before the search.
#' @param max_edges_per_cell For [s2_may_intersect_matrix()],
#' this values controls the nature of the index on `y`, with higher values
#' leading to coarser index. Values should be between 10 and 50; the default
#' of 50 is adequate for most use cases, but for specialized operations users
#' may wish to use a lower value to increase performance.
#' @param max_feature_cells For [s2_may_intersect_matrix()], this value
#' controls the approximation of `x` used to identify potential intersections
#' on `y`. The default value of 4 gives the best performance for most operations,
#' but for specialized operations users may wish to use a higher value to increase
#' performance.
#'
#' @return A vector of length `x`.
#' @export
#'
#' @seealso
#' See pairwise predicate functions (e.g., [s2_intersects()]).
#'
#' @examples
#' city_names <- c("Vatican City", "San Marino", "Luxembourg")
#' cities <- s2_data_cities(city_names)
#' country_names <- s2_data_tbl_countries$name
#' countries <- s2_data_countries()
#'
#' # closest feature returns y indices of the closest feature
#' # for each feature in x
#' country_names[s2_closest_feature(cities, countries)]
#'
#' # farthest feature returns y indices of the farthest feature
#' # for each feature in x
#' country_names[s2_farthest_feature(cities, countries)]
#'
#' # use s2_closest_edges() to find the k-nearest neighbours
#' nearest <- s2_closest_edges(cities, cities, k = 2, min_distance = 0)
#' city_names
#' city_names[unlist(nearest)]
#'
#' # predicate matrices
#' country_names[s2_intersects_matrix(cities, countries)[[1]]]
#'
#' # distance matrices
#' s2_distance_matrix(cities, cities)
#' s2_max_distance_matrix(cities, countries[1:4])
#'
s2_closest_feature <- function(x, y) {
cpp_s2_closest_feature(as_s2_geography(x), as_s2_geography(y))
}
#' @rdname s2_closest_feature
#' @export
s2_closest_edges <- function(x, y, k, min_distance = -1, max_distance = Inf,
radius = s2_earth_radius_meters()) {
stopifnot(k >= 1)
cpp_s2_closest_edges(
as_s2_geography(x),
as_s2_geography(y),
k,
min_distance / radius,
max_distance / radius
)
}
#' @rdname s2_closest_feature
#' @export
s2_farthest_feature <- function(x, y) {
cpp_s2_farthest_feature(as_s2_geography(x), as_s2_geography(y))
}
#' @rdname s2_closest_feature
#' @export
s2_distance_matrix <- function(x, y, radius = s2_earth_radius_meters()) {
cpp_s2_distance_matrix(as_s2_geography(x), as_s2_geography(y)) * radius
}
#' @rdname s2_closest_feature
#' @export
s2_max_distance_matrix <- function(x, y, radius = s2_earth_radius_meters()) {
cpp_s2_max_distance_matrix(as_s2_geography(x), as_s2_geography(y)) * radius
}
#' @rdname s2_closest_feature
#' @export
s2_contains_matrix <- function(x, y, options = s2_options(model = "open")) {
cpp_s2_contains_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_within_matrix <- function(x, y, options = s2_options(model = "open")) {
cpp_s2_within_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_covers_matrix <- function(x, y, options = s2_options(model = "closed")) {
cpp_s2_contains_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_covered_by_matrix <- function(x, y, options = s2_options(model = "closed")) {
cpp_s2_within_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_intersects_matrix <- function(x, y, options = s2_options()) {
cpp_s2_intersects_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_disjoint_matrix <- function(x, y, options = s2_options()) {
# disjoint is the odd one out, in that it requires a negation of intersects
# this is inconvenient to do on the C++ level, and is easier to maintain
# with setdiff() here (unless somebody complains that this is slow)
intersection <- cpp_s2_intersects_matrix(as_s2_geography(x), as_s2_geography(y), options)
Map(setdiff, list(seq_along(y)), intersection)
}
#' @rdname s2_closest_feature
#' @export
s2_equals_matrix <- function(x, y, options = s2_options()) {
cpp_s2_equals_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_touches_matrix <- function(x, y, options = s2_options()) {
cpp_s2_touches_matrix(as_s2_geography(x), as_s2_geography(y), options)
}
#' @rdname s2_closest_feature
#' @export
s2_dwithin_matrix <- function(x, y, distance, radius = s2_earth_radius_meters()) {
cpp_s2_dwithin_matrix(as_s2_geography(x), as_s2_geography(y), distance / radius)
}
#' @rdname s2_closest_feature
#' @export
s2_may_intersect_matrix <- function(x, y, max_edges_per_cell = 50, max_feature_cells = 4) {
cpp_s2_may_intersect_matrix(
as_s2_geography(x), as_s2_geography(y),
max_edges_per_cell, max_feature_cells,
s2_options()
)
}
# ------- for testing, non-indexed versions of matrix operators -------
s2_contains_matrix_brute_force <- function(x, y, options = s2_options()) {
cpp_s2_contains_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_within_matrix_brute_force <- function(x, y, options = s2_options()) {
cpp_s2_within_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_covers_matrix_brute_force <- function(x, y, options = s2_options(model = "closed")) {
cpp_s2_contains_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_covered_by_matrix_brute_force <- function(x, y, options = s2_options(model = "closed")) {
cpp_s2_within_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_intersects_matrix_brute_force <- function(x, y, options = s2_options()) {
cpp_s2_intersects_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_disjoint_matrix_brute_force <- function(x, y, options = s2_options()) {
cpp_s2_disjoint_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_equals_matrix_brute_force <- function(x, y, options = s2_options()) {
cpp_s2_equals_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
}
s2_dwithin_matrix_brute_force <- function(x, y, distance,
radius = s2_earth_radius_meters()) {
cpp_s2_dwithin_matrix_brute_force(
as_s2_geography(x),
as_s2_geography(y),
distance / radius
)
}
|