revert 4dd78b5 for layer_sf() stats

Author: teunbrand

R/stat-sf-coordinates.R

@@ -1,50 +1,3 @@
-#' @rdname stat_sf_coordinates
-#' @usage NULL
-#' @format NULL
-#' @export
-StatSfCoordinates <- ggproto(
-  "StatSfCoordinates", Stat,
-
-  compute_layer = function(self, data, params, layout) {
-    # add coord to the params, so it can be forwarded to compute_group()
-    params$coord <- layout$coord
-    ggproto_parent(Stat, self)$compute_layer(data, params, layout)
-  },
-
-  compute_group = function(self, data, scales, coord, fun.geometry = NULL) {
-    if (is.null(fun.geometry)) {
-      fun.geometry <- function(x) sf::st_point_on_surface(sf::st_zm(x))
-    }
-
-    points_sfc <- fun.geometry(data$geometry)
-
-    if (inherits(coord, "CoordSf")) {
-      # register bounding box if the coord derives from CoordSf
-      bbox <- sf::st_bbox(points_sfc)
-
-      coord$record_bbox(
-        xmin = bbox[["xmin"]], xmax = bbox[["xmax"]],
-        ymin = bbox[["ymin"]], ymax = bbox[["ymax"]]
-      )
-
-      # transform to the coord's default crs if possible
-      default_crs <- coord$get_default_crs()
-      if (!(is.null(default_crs) || is.na(default_crs) ||
-            is.na(sf::st_crs(points_sfc)))) {
-        points_sfc <- sf::st_transform(points_sfc, default_crs)
-      }
-    }
-    coordinates <- sf::st_coordinates(points_sfc)
-    data$x <- coordinates[, "X"]
-    data$y <- coordinates[, "Y"]
-
-    data
-  },
-
-  default_aes = aes(x = after_stat(x), y = after_stat(y)),
-  required_aes = c("geometry")
-)
-
 #' Extract coordinates from 'sf' objects
 #'
 #' `stat_sf_coordinates()` extracts the coordinates from 'sf' objects and
@@ -103,4 +56,70 @@ StatSfCoordinates <- ggproto(
 #'   will be used. Note that the function may warn about the incorrectness of
 #'   the result if the data is not projected, but you can ignore this except
 #'   when you really care about the exact locations.
-stat_sf_coordinates <- make_constructor(StatSfCoordinates, geom = "point")
+stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
+                                position = "identity", na.rm = FALSE,
+                                show.legend = NA, inherit.aes = TRUE,
+                                fun.geometry = NULL,
+                                ...) {
+  layer_sf(
+    stat = StatSfCoordinates,
+    data = data,
+    mapping = mapping,
+    geom = geom,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list2(
+      na.rm = na.rm,
+      fun.geometry = fun.geometry,
+      ...
+    )
+  )
+}
+
+#' @rdname stat_sf_coordinates
+#' @usage NULL
+#' @format NULL
+#' @export
+StatSfCoordinates <- ggproto(
+  "StatSfCoordinates", Stat,
+
+  compute_layer = function(self, data, params, layout) {
+    # add coord to the params, so it can be forwarded to compute_group()
+    params$coord <- layout$coord
+    ggproto_parent(Stat, self)$compute_layer(data, params, layout)
+  },
+
+  compute_group = function(self, data, scales, coord, fun.geometry = NULL) {
+    if (is.null(fun.geometry)) {
+      fun.geometry <- function(x) sf::st_point_on_surface(sf::st_zm(x))
+    }
+
+    points_sfc <- fun.geometry(data$geometry)
+
+    if (inherits(coord, "CoordSf")) {
+      # register bounding box if the coord derives from CoordSf
+      bbox <- sf::st_bbox(points_sfc)
+
+      coord$record_bbox(
+        xmin = bbox[["xmin"]], xmax = bbox[["xmax"]],
+        ymin = bbox[["ymin"]], ymax = bbox[["ymax"]]
+      )
+
+      # transform to the coord's default crs if possible
+      default_crs <- coord$get_default_crs()
+      if (!(is.null(default_crs) || is.na(default_crs) ||
+            is.na(sf::st_crs(points_sfc)))) {
+        points_sfc <- sf::st_transform(points_sfc, default_crs)
+      }
+    }
+    coordinates <- sf::st_coordinates(points_sfc)
+    data$x <- coordinates[, "X"]
+    data$y <- coordinates[, "Y"]
+
+    data
+  },
+
+  default_aes = aes(x = after_stat(x), y = after_stat(y)),
+  required_aes = c("geometry")
+)

R/stat-sf.R

@@ -59,5 +59,21 @@ StatSf <- ggproto("StatSf", Stat,
 #' @export
 #' @rdname ggsf
 #' @inheritParams stat_identity
-stat_sf <- make_constructor(StatSf, geom = "rect")
+stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
+                    position = "identity", na.rm = FALSE, show.legend = NA,
+                    inherit.aes = TRUE, ...) {
+  layer_sf(
+    stat = StatSf,
+    data = data,
+    mapping = mapping,
+    geom = geom,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list2(
+      na.rm = na.rm,
+      ...
+    )
+  )
+}