1
2#' Extract vertices
3#'
4#' These functions provide ways to extract individual coordinate values.
5#' Whereas `wk_vertices()` returns a vector of coordinates as in the same
6#' format as the input, `wk_coords()` returns a data frame with coordinates
7#' as columns.
8#'
9#' @inheritParams wk_handle
10#' @param add_details Use `TRUE` to add a "wk_details" attribute, which
11#'   contains columns `feature_id`, `part_id`, and `ring_id`.
12#'
13#' @return
14#'   - `wk_vertices()` extracts vertices and returns the in the same format as
15#'     the handler
16#'   - `wk_coords()` returns a data frame with columns columns `feature_id`
17#'     (the index of the feature from whence it came), `part_id` (an arbitrary
18#'     integer identifying the point, line, or polygon from whence it came),
19#'     `ring_id` (an arbitrary integer identifying individual rings within
20#'     polygons), and one column per coordinate (`x`, `y`, and/or `z` and/or `m`).
21#' @export
22#'
23#' @examples
24#' wk_vertices(wkt("LINESTRING (0 0, 1 1)"))
25#' wk_coords(wkt("LINESTRING (0 0, 1 1)"))
26#'
27wk_vertices <- function(handleable, ...) {
28  # the results of this handler are not necessarily the same length as the input,
29  # so we need to special-case data frames
30  if (is.data.frame(handleable))  {
31    result <- wk_handle(
32      handleable,
33      wk_vertex_filter(wk_writer(handleable), add_details = TRUE),
34      ...
35    )
36    feature_id <- attr(result, "wk_details", exact = TRUE)$feature_id
37    attr(result, "wk_details") <- NULL
38    result <- wk_restore(handleable[feature_id, , drop = FALSE], result, ...)
39  } else {
40    result <- wk_handle(handleable, wk_vertex_filter(wk_writer(handleable, generic = TRUE)), ...)
41    result <- wk_restore(handleable, result, ...)
42  }
43
44  wk_set_crs(result, wk_crs(handleable))
45}
46
47#' @rdname wk_vertices
48#' @export
49wk_coords <- function(handleable, ...) {
50  result <- wk_handle(
51    handleable,
52    wk_vertex_filter(xy_writer(), add_details = TRUE),
53    ...
54  )
55
56  details <- attr(result, "wk_details", exact = TRUE)
57  attr(result, "wk_details") <- NULL
58  new_data_frame(c(details, unclass(result)))
59}
60
61#' @rdname wk_vertices
62#' @export
63wk_vertex_filter <- function(handler, add_details = FALSE) {
64  new_wk_handler(
65    .Call("wk_c_vertex_filter_new", as_wk_handler(handler), as.logical(add_details)[1]),
66    "wk_vertex_filter"
67  )
68}
69