Add layer_sf() constructor. (#3246)

* Add layer_sf() constructor. Closes #3232.

* fix typo

* update news item

Author: clauswilke

NAMESPACE

@@ -379,6 +379,7 @@ export(layer)
 export(layer_data)
 export(layer_grob)
 export(layer_scales)
+export(layer_sf)
 export(lims)
 export(map_data)
 export(margin)

NEWS.md

@@ -42,8 +42,14 @@ core developer team.
   very beginning of the plot building process and which has access to the 
   original input data and the plot object being built. This function allows the 
   creation of custom layers that autogenerate aesthetic mappings based on the 
-  input data or that filter the input data in some form. This is mainly of 
-  interest to extension developers (@clauswilke, #2872).
+  input data or that filter the input data in some form. For the time being, this
+  feature is not exported, but it has enabled the development of a new layer type,
+  `layer_sf()` (see next item). Other special-purpose layer types may be added
+  in the future (@clauswilke, #2872).
+  
+* A new layer type `layer_sf()` can auto-detect and auto-map sf geometry
+  columns in the data. It should be used by extension developers who are writing
+  new sf-based geoms or stats (@clauswilke, #3232).
 
 * `x0` and `y0` are now recognized positional aesthetics so they will get scaled 
   if used in extension geoms and stats (@thomasp85, #3168)

R/geom-sf.R

@@ -170,7 +170,7 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
                     position = "identity", na.rm = FALSE, show.legend = NA,
                     inherit.aes = TRUE, ...) {
   c(
-    layer(
+    layer_sf(
       geom = GeomSf,
       data = data,
       mapping = mapping,
@@ -182,8 +182,7 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
         na.rm = na.rm,
         legend = if (is.character(show.legend)) show.legend else "polygon",
         ...
-      ),
-      layer_class = LayerSf
+      )
     ),
     coord_sf(default = TRUE)
   )
@@ -215,7 +214,7 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
-  layer(
+  layer_sf(
     data = data,
     mapping = mapping,
     stat = stat,
@@ -231,8 +230,7 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 
@@ -260,7 +258,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
-  layer(
+  layer_sf(
     data = data,
     mapping = mapping,
     stat = stat,
@@ -274,8 +272,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL,
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 

R/layer-sf.R

@@ -1,6 +1,25 @@
+#' Create a new sf layer that auto-maps geometry data
+#'
+#' The `layer_sf()` function is a variant of [`layer()`] meant to be used by
+#' extension developers who are writing new sf-based geoms or stats.
+#' The sf layer checks whether the data contains a geometry column, and
+#' if one is found it is automatically mapped to the `geometry` aesthetic.
 #' @include layer.r
-
-# A special sf layer that auto-maps geometry data to the `geometry` aesthetic
+#' @inheritParams layer
+#' @keywords internal
+#' @export
+layer_sf <- function(geom = NULL, stat = NULL,
+                     data = NULL, mapping = NULL,
+                     position = NULL, params = list(),
+                     inherit.aes = TRUE, check.aes = TRUE, check.param = TRUE,
+                     show.legend = NA) {
+  layer(
+    geom = geom, stat = stat, data = data, mapping = mapping,
+    position = position, params = params, inherit.aes = inherit.aes,
+    check.aes = check.aes, check.param = check.param,
+    show.legend = show.legend, layer_class = LayerSf
+  )
+}
 
 LayerSf <- ggproto("LayerSf", Layer,
   setup_layer = function(self, data, plot) {

R/stat-sf-coordinates.R

@@ -62,7 +62,7 @@ stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
                                 show.legend = NA, inherit.aes = TRUE,
                                 fun.geometry = NULL,
                                 ...) {
-  layer(
+  layer_sf(
     stat = StatSfCoordinates,
     data = data,
     mapping = mapping,
@@ -74,8 +74,7 @@ stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 

R/stat-sf.R

@@ -22,7 +22,7 @@ StatSf <- ggproto("StatSf", Stat,
 stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
                     position = "identity", na.rm = FALSE, show.legend = NA,
                     inherit.aes = TRUE, ...) {
-  layer(
+  layer_sf(
     stat = StatSf,
     data = data,
     mapping = mapping,
@@ -34,8 +34,7 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
       na.rm = na.rm,
       legend = if (is.character(show.legend)) show.legend else "polygon",
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }