Encapsulate sf_grob() in GeomSf$draw_panel() (#5904)

* migrate removing missing values to `GeomSf$handle_na`

* handle grob wrapping in `GeomSf$draw_panel()`

* remove `sf_grob()`

Author: teunbrand

R/geom-sf.R

@@ -201,10 +201,36 @@ GeomSf <- ggproto("GeomSf", Geom,
       cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.")
     }
 
-    # Need to refactor this to generate one grob per geometry type
-    coord <- coord$transform(data, panel_params)
-    sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre,
-            arrow = arrow, arrow.fill = arrow.fill, na.rm = na.rm)
+    data <- coord$transform(data, panel_params)
+
+    type <- sf_types[sf::st_geometry_type(data$geometry)]
+    is_point <- type == "point"
+    is_line  <- type == "line"
+    is_collection <- type == "collection"
+
+    fill <- fill_alpha(data$fill %||% rep(NA, nrow(data)), data$alpha)
+    fill[is_line] <- arrow.fill %||% fill[is_line]
+
+    colour <- data$colour
+    colour[is_point | is_line] <-
+      alpha(colour[is_point | is_line], data$alpha[is_point | is_line])
+
+    point_size <- data$size
+    point_size[!(is_point | is_collection)] <-
+      data$linewidth[!(is_point | is_collection)]
+
+    stroke <- data$stroke * .stroke / 2
+    font_size <- point_size * .pt + stroke
+
+    linewidth <- data$linewidth * .pt
+    linewidth[is_point] <- stroke[is_point]
+
+    gp <- gpar(
+      col = colour, fill = fill, fontsize = font_size, lwd = linewidth,
+      lineend = lineend, linejoin = linejoin, linemitre = linemitre
+    )
+
+    sf::st_as_grob(data$geometry, pch = data$shape, gp = gp, arrow = arrow)
   },
 
   draw_key = function(data, params, size) {
@@ -214,57 +240,37 @@ GeomSf <- ggproto("GeomSf", Geom,
       line  = draw_key_path(data, params, size),
       draw_key_polygon(data, params, size)
     )
-  }
-)
+  },
 
-sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10,
-                    arrow = NULL, arrow.fill = NULL, na.rm = TRUE) {
-  type <- sf_types[sf::st_geometry_type(x$geometry)]
-  is_point <- type == "point"
-  is_line <- type == "line"
-  is_other <- type == "other"
-  is_collection <- type == "collection"
-  type_ind <- match(type, c("point", "line", "other", "collection"))
-  remove <- rep_len(FALSE, nrow(x))
-  remove[is_point] <- detect_missing(x, c(GeomPoint$required_aes, GeomPoint$non_missing_aes))[is_point]
-  remove[is_line] <- detect_missing(x, c(GeomPath$required_aes, GeomPath$non_missing_aes))[is_line]
-  remove[is_other] <- detect_missing(x, c(GeomPolygon$required_aes, GeomPolygon$non_missing_aes))[is_other]
-  if (any(remove)) {
-    if (!na.rm) {
-      cli::cli_warn(paste0(
-        "Removed {sum(remove)} row{?s} containing missing values or values ",
-        "outside the scale range ({.fn geom_sf})."
-      ))
+  handle_na = function(self, data, params) {
+    remove <- rep(FALSE, nrow(data))
+
+    types <- sf_types[sf::st_geometry_type(data$geometry)]
+    types <- split(seq_along(remove), types)
+
+    get_missing <- function(geom) {
+      detect_missing(data, c(geom$required_aes, geom$non_missing_aes))
     }
-    x <- x[!remove, , drop = FALSE]
-    type_ind <- type_ind[!remove]
-    is_collection <- is_collection[!remove]
-  }
 
-  alpha <- x$alpha %||% NA
-  fill <- fill_alpha(x$fill %||% NA, alpha)
-  fill[is_line] <- arrow.fill %||% fill[is_line]
-  col <- x$colour %||% NA
-  col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line])
-
-  size <- x$size %||% 0.5
-  linewidth <- x$linewidth %||% 0.5
-  point_size <- ifelse(
-    is_collection,
-    x$size,
-    ifelse(is_point, size, linewidth)
-  )
-  stroke <- (x$stroke %||% 0) * .stroke / 2
-  fontsize <- point_size * .pt + stroke
-  lwd <- ifelse(is_point, stroke, linewidth * .pt)
-  pch <- x$shape
-  lty <- x$linetype
-  gp <- gpar(
-    col = col, fill = fill, fontsize = fontsize, lwd = lwd, lty = lty,
-    lineend = lineend, linejoin = linejoin, linemitre = linemitre
-  )
-  sf::st_as_grob(x$geometry, pch = pch, gp = gp, arrow = arrow)
-}
+    remove[types$point] <- get_missing(GeomPoint)[types$point]
+    remove[types$line]  <- get_missing(GeomPath)[types$line]
+    remove[types$other] <- get_missing(GeomPolygon)[types$other]
+
+    remove <- remove | get_missing(self)
+
+    if (any(remove)) {
+      data <- vec_slice(data, !remove)
+      if (!isTRUE(params$na.rm)) {
+        cli::cli_warn(
+          "Removed {sum(remove)} row{?s} containing missing values or values \\
+          outside the scale range ({.fn {snake_class(self)}})."
+        )
+      }
+    }
+
+    data
+  }
+)
 
 #' @export
 #' @rdname ggsf

tests/testthat/test-geom-sf.R

@@ -151,7 +151,7 @@ test_that("errors are correctly triggered", {
     ),
     linewidth = c(1, NA)
   )
-  expect_snapshot_warning(sf_grob(pts, na.rm = FALSE))
+  expect_snapshot_warning(GeomSf$handle_na(pts, list(na.rm = FALSE)))
 })
 
 # Visual tests ------------------------------------------------------------