Skip to content

Commit 744e021

Browse files
authored
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()`
1 parent 096b966 commit 744e021

File tree

2 files changed

+59
-53
lines changed

2 files changed

+59
-53
lines changed

R/geom-sf.R

Lines changed: 58 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -201,10 +201,36 @@ GeomSf <- ggproto("GeomSf", Geom,
201201
cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.")
202202
}
203203

204-
# Need to refactor this to generate one grob per geometry type
205-
coord <- coord$transform(data, panel_params)
206-
sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre,
207-
arrow = arrow, arrow.fill = arrow.fill, na.rm = na.rm)
204+
data <- coord$transform(data, panel_params)
205+
206+
type <- sf_types[sf::st_geometry_type(data$geometry)]
207+
is_point <- type == "point"
208+
is_line <- type == "line"
209+
is_collection <- type == "collection"
210+
211+
fill <- fill_alpha(data$fill %||% rep(NA, nrow(data)), data$alpha)
212+
fill[is_line] <- arrow.fill %||% fill[is_line]
213+
214+
colour <- data$colour
215+
colour[is_point | is_line] <-
216+
alpha(colour[is_point | is_line], data$alpha[is_point | is_line])
217+
218+
point_size <- data$size
219+
point_size[!(is_point | is_collection)] <-
220+
data$linewidth[!(is_point | is_collection)]
221+
222+
stroke <- data$stroke * .stroke / 2
223+
font_size <- point_size * .pt + stroke
224+
225+
linewidth <- data$linewidth * .pt
226+
linewidth[is_point] <- stroke[is_point]
227+
228+
gp <- gpar(
229+
col = colour, fill = fill, fontsize = font_size, lwd = linewidth,
230+
lineend = lineend, linejoin = linejoin, linemitre = linemitre
231+
)
232+
233+
sf::st_as_grob(data$geometry, pch = data$shape, gp = gp, arrow = arrow)
208234
},
209235

210236
draw_key = function(data, params, size) {
@@ -214,57 +240,37 @@ GeomSf <- ggproto("GeomSf", Geom,
214240
line = draw_key_path(data, params, size),
215241
draw_key_polygon(data, params, size)
216242
)
217-
}
218-
)
243+
},
219244

220-
sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10,
221-
arrow = NULL, arrow.fill = NULL, na.rm = TRUE) {
222-
type <- sf_types[sf::st_geometry_type(x$geometry)]
223-
is_point <- type == "point"
224-
is_line <- type == "line"
225-
is_other <- type == "other"
226-
is_collection <- type == "collection"
227-
type_ind <- match(type, c("point", "line", "other", "collection"))
228-
remove <- rep_len(FALSE, nrow(x))
229-
remove[is_point] <- detect_missing(x, c(GeomPoint$required_aes, GeomPoint$non_missing_aes))[is_point]
230-
remove[is_line] <- detect_missing(x, c(GeomPath$required_aes, GeomPath$non_missing_aes))[is_line]
231-
remove[is_other] <- detect_missing(x, c(GeomPolygon$required_aes, GeomPolygon$non_missing_aes))[is_other]
232-
if (any(remove)) {
233-
if (!na.rm) {
234-
cli::cli_warn(paste0(
235-
"Removed {sum(remove)} row{?s} containing missing values or values ",
236-
"outside the scale range ({.fn geom_sf})."
237-
))
245+
handle_na = function(self, data, params) {
246+
remove <- rep(FALSE, nrow(data))
247+
248+
types <- sf_types[sf::st_geometry_type(data$geometry)]
249+
types <- split(seq_along(remove), types)
250+
251+
get_missing <- function(geom) {
252+
detect_missing(data, c(geom$required_aes, geom$non_missing_aes))
238253
}
239-
x <- x[!remove, , drop = FALSE]
240-
type_ind <- type_ind[!remove]
241-
is_collection <- is_collection[!remove]
242-
}
243254

244-
alpha <- x$alpha %||% NA
245-
fill <- fill_alpha(x$fill %||% NA, alpha)
246-
fill[is_line] <- arrow.fill %||% fill[is_line]
247-
col <- x$colour %||% NA
248-
col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line])
249-
250-
size <- x$size %||% 0.5
251-
linewidth <- x$linewidth %||% 0.5
252-
point_size <- ifelse(
253-
is_collection,
254-
x$size,
255-
ifelse(is_point, size, linewidth)
256-
)
257-
stroke <- (x$stroke %||% 0) * .stroke / 2
258-
fontsize <- point_size * .pt + stroke
259-
lwd <- ifelse(is_point, stroke, linewidth * .pt)
260-
pch <- x$shape
261-
lty <- x$linetype
262-
gp <- gpar(
263-
col = col, fill = fill, fontsize = fontsize, lwd = lwd, lty = lty,
264-
lineend = lineend, linejoin = linejoin, linemitre = linemitre
265-
)
266-
sf::st_as_grob(x$geometry, pch = pch, gp = gp, arrow = arrow)
267-
}
255+
remove[types$point] <- get_missing(GeomPoint)[types$point]
256+
remove[types$line] <- get_missing(GeomPath)[types$line]
257+
remove[types$other] <- get_missing(GeomPolygon)[types$other]
258+
259+
remove <- remove | get_missing(self)
260+
261+
if (any(remove)) {
262+
data <- vec_slice(data, !remove)
263+
if (!isTRUE(params$na.rm)) {
264+
cli::cli_warn(
265+
"Removed {sum(remove)} row{?s} containing missing values or values \\
266+
outside the scale range ({.fn {snake_class(self)}})."
267+
)
268+
}
269+
}
270+
271+
data
272+
}
273+
)
268274

269275
#' @export
270276
#' @rdname ggsf

tests/testthat/test-geom-sf.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -151,7 +151,7 @@ test_that("errors are correctly triggered", {
151151
),
152152
linewidth = c(1, NA)
153153
)
154-
expect_snapshot_warning(sf_grob(pts, na.rm = FALSE))
154+
expect_snapshot_warning(GeomSf$handle_na(pts, list(na.rm = FALSE)))
155155
})
156156

157157
# Visual tests ------------------------------------------------------------

0 commit comments

Comments
 (0)