@@ -201,10 +201,36 @@ GeomSf <- ggproto("GeomSf", Geom,
201
201
cli :: cli_abort(" {.fn {snake_class(self)}} can only be used with {.fn coord_sf}." )
202
202
}
203
203
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 )
208
234
},
209
235
210
236
draw_key = function (data , params , size ) {
@@ -214,57 +240,37 @@ GeomSf <- ggproto("GeomSf", Geom,
214
240
line = draw_key_path(data , params , size ),
215
241
draw_key_polygon(data , params , size )
216
242
)
217
- }
218
- )
243
+ },
219
244
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 ))
238
253
}
239
- x <- x [! remove , , drop = FALSE ]
240
- type_ind <- type_ind [! remove ]
241
- is_collection <- is_collection [! remove ]
242
- }
243
254
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
+ )
268
274
269
275
# ' @export
270
276
# ' @rdname ggsf
0 commit comments