1
2#' Matrix Functions
3#'
4#' These functions are similar to accessors and predicates, but instead of
5#' recycling `x` and `y` to a common length and returning a vector of that
6#' length, these functions return a vector of length `x` with each element
7#' `i` containing information about how the entire vector `y` relates to
8#' the feature at `x[i]`.
9#'
10#' @inheritParams s2_is_collection
11#' @inheritParams s2_contains
12#' @param x,y Geography vectors, coerced using [as_s2_geography()].
13#'   `x` is considered the source, where as `y` is considered the target.
14#' @param k The number of closest edges to consider when searching. Note
15#'   that in S2 a point is also considered an edge.
16#' @param min_distance The minimum distance to consider when searching for
17#'   edges. This filter is applied after the search is complete (i.e.,
18#'   may cause fewer than `k` values to be returned).
19#' @param max_edges_per_cell For [s2_may_intersect_matrix()],
20#'   this values controls the nature of the index on `y`, with higher values
21#'   leading to coarser index. Values should be between 10 and 50; the default
22#'   of 50 is adequate for most use cases, but for specialized operations users
23#'   may wish to use a lower value to increase performance.
24#' @param max_feature_cells For [s2_may_intersect_matrix()], this value
25#'   controls the approximation of `x` used to identify potential intersections
26#'   on `y`. The default value of 4 gives the best performance for most operations,
27#'   but for specialized operations users may wish to use a higher value to increase
28#'   performance.
29#'
30#' @return A vector of length `x`.
31#' @export
32#'
33#' @seealso
34#' See pairwise predicate functions (e.g., [s2_intersects()]).
35#'
36#' @examples
37#' city_names <- c("Vatican City", "San Marino", "Luxembourg")
38#' cities <- s2_data_cities(city_names)
39#' country_names <- s2_data_tbl_countries$name
40#' countries <- s2_data_countries()
41#'
42#' # closest feature returns y indices of the closest feature
43#' # for each feature in x
44#' country_names[s2_closest_feature(cities, countries)]
45#'
46#' # farthest feature returns y indices of the farthest feature
47#' # for each feature in x
48#' country_names[s2_farthest_feature(cities, countries)]
49#'
50#' # use s2_closest_edges() to find the k-nearest neighbours
51#' nearest <- s2_closest_edges(cities, cities, k = 2, min_distance = 0)
52#' city_names
53#' city_names[unlist(nearest)]
54#'
55#' # predicate matrices
56#' country_names[s2_intersects_matrix(cities, countries)[[1]]]
57#'
58#' # distance matrices
59#' s2_distance_matrix(cities, cities)
60#' s2_max_distance_matrix(cities, countries[1:4])
61#'
62s2_closest_feature <- function(x, y) {
63  cpp_s2_closest_feature(as_s2_geography(x), as_s2_geography(y))
64}
65
66#' @rdname s2_closest_feature
67#' @export
68s2_closest_edges <- function(x, y, k, min_distance = -1, radius = s2_earth_radius_meters()) {
69  stopifnot(k >= 1)
70  cpp_s2_closest_edges(as_s2_geography(x), as_s2_geography(y), k, min_distance / radius)
71}
72
73#' @rdname s2_closest_feature
74#' @export
75s2_farthest_feature <- function(x, y) {
76  cpp_s2_farthest_feature(as_s2_geography(x), as_s2_geography(y))
77}
78
79#' @rdname s2_closest_feature
80#' @export
81s2_distance_matrix <- function(x, y, radius = s2_earth_radius_meters()) {
82  cpp_s2_distance_matrix(as_s2_geography(x), as_s2_geography(y)) * radius
83}
84
85#' @rdname s2_closest_feature
86#' @export
87s2_max_distance_matrix <- function(x, y, radius = s2_earth_radius_meters()) {
88  cpp_s2_max_distance_matrix(as_s2_geography(x), as_s2_geography(y)) * radius
89}
90
91#' @rdname s2_closest_feature
92#' @export
93s2_contains_matrix <- function(x, y, options = s2_options(model = "open")) {
94  cpp_s2_contains_matrix(as_s2_geography(x), as_s2_geography(y), options)
95}
96
97#' @rdname s2_closest_feature
98#' @export
99s2_within_matrix <- function(x, y, options = s2_options(model = "open")) {
100  cpp_s2_within_matrix(as_s2_geography(x), as_s2_geography(y), options)
101}
102
103#' @rdname s2_closest_feature
104#' @export
105s2_covers_matrix <- function(x, y, options = s2_options(model = "closed")) {
106  cpp_s2_contains_matrix(as_s2_geography(x), as_s2_geography(y), options)
107}
108
109#' @rdname s2_closest_feature
110#' @export
111s2_covered_by_matrix <- function(x, y, options = s2_options(model = "closed")) {
112  cpp_s2_within_matrix(as_s2_geography(x), as_s2_geography(y), options)
113}
114
115#' @rdname s2_closest_feature
116#' @export
117s2_intersects_matrix <- function(x, y, options = s2_options()) {
118  cpp_s2_intersects_matrix(as_s2_geography(x), as_s2_geography(y), options)
119}
120
121#' @rdname s2_closest_feature
122#' @export
123s2_disjoint_matrix <- function(x, y, options = s2_options()) {
124  # disjoint is the odd one out, in that it requires a negation of intersects
125  # this is inconvenient to do on the C++ level, and is easier to maintain
126  # with setdiff() here (unless somebody complains that this is slow)
127  intersection <- cpp_s2_intersects_matrix(as_s2_geography(x), as_s2_geography(y), options)
128  Map(setdiff, list(seq_along(y)), intersection)
129}
130
131#' @rdname s2_closest_feature
132#' @export
133s2_equals_matrix <- function(x, y, options = s2_options()) {
134  cpp_s2_equals_matrix(as_s2_geography(x), as_s2_geography(y), options)
135}
136
137#' @rdname s2_closest_feature
138#' @export
139s2_touches_matrix <- function(x, y, options = s2_options()) {
140  cpp_s2_touches_matrix(as_s2_geography(x), as_s2_geography(y), options)
141}
142
143#' @rdname s2_closest_feature
144#' @export
145s2_dwithin_matrix <- function(x, y, distance, radius = s2_earth_radius_meters()) {
146  cpp_s2_dwithin_matrix(as_s2_geography(x), as_s2_geography(y), distance / radius)
147}
148
149#' @rdname s2_closest_feature
150#' @export
151s2_may_intersect_matrix <- function(x, y, max_edges_per_cell = 50, max_feature_cells = 4) {
152  cpp_s2_may_intersect_matrix(
153    as_s2_geography(x), as_s2_geography(y),
154    max_edges_per_cell, max_feature_cells,
155    s2_options()
156  )
157}
158
159# ------- for testing, non-indexed versions of matrix operators -------
160
161s2_contains_matrix_brute_force <- function(x, y, options = s2_options()) {
162  cpp_s2_contains_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
163}
164
165s2_within_matrix_brute_force <- function(x, y, options = s2_options()) {
166  cpp_s2_within_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
167}
168
169s2_covers_matrix_brute_force <- function(x, y, options = s2_options(model = "closed")) {
170  cpp_s2_contains_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
171}
172
173s2_covered_by_matrix_brute_force <- function(x, y, options = s2_options(model = "closed")) {
174  cpp_s2_within_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
175}
176
177s2_intersects_matrix_brute_force <- function(x, y, options = s2_options()) {
178  cpp_s2_intersects_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
179}
180
181s2_disjoint_matrix_brute_force <- function(x, y, options = s2_options()) {
182  cpp_s2_disjoint_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
183}
184
185s2_equals_matrix_brute_force <- function(x, y, options = s2_options()) {
186  cpp_s2_equals_matrix_brute_force(as_s2_geography(x), as_s2_geography(y), options)
187}
188