Skip to content

Commit 341e8fc

Browse files
teunbrandteunbrand
authored
Additional arrow.fill parameters for line-based functions. (#5768)
* add `arrow.fill` to `element_line()` * add `arrow.fill` to other line geoms * propagate `arrow.fill` in `geom_sf()` * Add news bullet * include `geom_step()`
1 parent c9a2d6a commit 341e8fc

File tree

7 files changed

+50
-20
lines changed

7 files changed

+50
-20
lines changed

‎NEWS.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
# ggplot2 (development version)
22

3+
* The `arrow.fill` parameter is now applied to more line-based functions:
4+
`geom_path()`, `geom_line()`, `geom_step()` `geom_function()`, line
5+
geometries in `geom_sf()` and `element_line()`.
36
* Fixed bug where binned guides would keep out-of-bounds breaks
47
(@teunbrand, #5870).
58
* The size of the `draw_key_polygon()` glyph now reflects the `linewidth`

‎R/geom-function.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ geom_function <- function(mapping = NULL, data = NULL, stat = "function",
9090
#' @export
9191
#' @include geom-path.R
9292
GeomFunction <- ggproto("GeomFunction", GeomPath,
93-
draw_panel = function(self, data, panel_params, coord, arrow = NULL,
93+
draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
9494
lineend = "butt", linejoin = "round", linemitre = 10,
9595
na.rm = FALSE) {
9696
groups <- unique0(data$group)
@@ -102,7 +102,7 @@ GeomFunction <- ggproto("GeomFunction", GeomPath,
102102
}
103103

104104
ggproto_parent(GeomPath, self)$draw_panel(
105-
data, panel_params, coord, arrow, lineend, linejoin, linemitre, na.rm
105+
data, panel_params, coord, arrow, arrow.fill, lineend, linejoin, linemitre, na.rm
106106
)
107107
}
108108
)

‎R/geom-path.R

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,8 @@
1818
#' @param linejoin Line join style (round, mitre, bevel).
1919
#' @param linemitre Line mitre limit (number greater than 1).
2020
#' @param arrow Arrow specification, as created by [grid::arrow()].
21+
#' @param arrow.fill fill colour to use for the arrow head (if closed). `NULL`
22+
#' means use `colour` aesthetic.
2123
#' @seealso
2224
#' [geom_polygon()]: Filled paths (polygons);
2325
#' [geom_segment()]: Line segments
@@ -101,6 +103,7 @@ geom_path <- function(mapping = NULL, data = NULL,
101103
linejoin = "round",
102104
linemitre = 10,
103105
arrow = NULL,
106+
arrow.fill = NULL,
104107
na.rm = FALSE,
105108
show.legend = NA,
106109
inherit.aes = TRUE) {
@@ -117,6 +120,7 @@ geom_path <- function(mapping = NULL, data = NULL,
117120
linejoin = linejoin,
118121
linemitre = linemitre,
119122
arrow = arrow,
123+
arrow.fill = arrow.fill,
120124
na.rm = na.rm,
121125
...
122126
)
@@ -152,7 +156,7 @@ GeomPath <- ggproto("GeomPath", Geom,
152156
data
153157
},
154158

155-
draw_panel = function(self, data, panel_params, coord, arrow = NULL,
159+
draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
156160
lineend = "butt", linejoin = "round", linemitre = 10,
157161
na.rm = FALSE) {
158162
data <- check_linewidth(data, snake_class(self))
@@ -193,6 +197,8 @@ GeomPath <- ggproto("GeomPath", Geom,
193197
start <- c(TRUE, group_diff)
194198
end <- c(group_diff, TRUE)
195199

200+
munched$fill <- arrow.fill %||% munched$colour
201+
196202
if (!constant) {
197203

198204
arrow <- repair_segment_arrow(arrow, munched$group)
@@ -202,7 +208,7 @@ GeomPath <- ggproto("GeomPath", Geom,
202208
default.units = "native", arrow = arrow,
203209
gp = ggpar(
204210
col = alpha(munched$colour, munched$alpha)[!end],
205-
fill = alpha(munched$colour, munched$alpha)[!end],
211+
fill = alpha(munched$fill, munched$alpha)[!end],
206212
lwd = munched$linewidth[!end],
207213
lty = munched$linetype[!end],
208214
lineend = lineend,
@@ -217,7 +223,7 @@ GeomPath <- ggproto("GeomPath", Geom,
217223
default.units = "native", arrow = arrow,
218224
gp = ggpar(
219225
col = alpha(munched$colour, munched$alpha)[start],
220-
fill = alpha(munched$colour, munched$alpha)[start],
226+
fill = alpha(munched$fill, munched$alpha)[start],
221227
lwd = munched$linewidth[start],
222228
lty = munched$linetype[start],
223229
lineend = lineend,
@@ -324,11 +330,13 @@ geom_step <- function(mapping = NULL, data = NULL, stat = "identity",
324330
GeomStep <- ggproto("GeomStep", GeomPath,
325331
draw_panel = function(data, panel_params, coord,
326332
lineend = "butt", linejoin = "round", linemitre = 10,
333+
arrow = NULL, arrow.fill = NULL,
327334
direction = "hv") {
328335
data <- dapply(data, "group", stairstep, direction = direction)
329336
GeomPath$draw_panel(
330337
data, panel_params, coord,
331-
lineend = lineend, linejoin = linejoin, linemitre = linemitre
338+
lineend = lineend, linejoin = linejoin, linemitre = linemitre,
339+
arrow = arrow, arrow.fill = arrow.fill
332340
)
333341
}
334342
)

‎R/geom-sf.R

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -190,15 +190,15 @@ GeomSf <- ggproto("GeomSf", Geom,
190190

191191
draw_panel = function(self, data, panel_params, coord, legend = NULL,
192192
lineend = "butt", linejoin = "round", linemitre = 10,
193-
arrow = NULL, na.rm = TRUE) {
193+
arrow = NULL, arrow.fill = NULL, na.rm = TRUE) {
194194
if (!inherits(coord, "CoordSf")) {
195195
cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.")
196196
}
197197

198198
# Need to refactor this to generate one grob per geometry type
199199
coord <- coord$transform(data, panel_params)
200200
sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre,
201-
arrow = arrow, na.rm = na.rm)
201+
arrow = arrow, arrow.fill = arrow.fill, na.rm = na.rm)
202202
},
203203

204204
draw_key = function(data, params, size) {
@@ -224,7 +224,7 @@ default_aesthetics <- function(type) {
224224
}
225225

226226
sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10,
227-
arrow = NULL, na.rm = TRUE) {
227+
arrow = NULL, arrow.fill = NULL, na.rm = TRUE) {
228228
type <- sf_types[sf::st_geometry_type(x$geometry)]
229229
is_point <- type == "point"
230230
is_line <- type == "line"
@@ -249,6 +249,7 @@ sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10,
249249

250250
alpha <- x$alpha %||% NA
251251
fill <- fill_alpha(x$fill %||% NA, alpha)
252+
fill[is_line] <- arrow.fill %||% fill[is_line]
252253
col <- x$colour %||% NA
253254
col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line])
254255

‎R/theme-elements.R

Lines changed: 22 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
#' @param colour,color Line/border colour. Color is an alias for colour.
1717
#' @param linewidth Line/border size in mm.
1818
#' @param size text size in pts.
19+
#' @param arrow.fill Fill colour for arrows.
1920
#' @param inherit.blank Should this element inherit the existence of an
2021
#' `element_blank` among its parents? If `TRUE` the existence of
2122
#' a blank element among its parents will cause this element to be blank as
@@ -87,18 +88,21 @@ element_rect <- function(fill = NULL, colour = NULL, linewidth = NULL,
8788
#' @param lineend Line end Line end style (round, butt, square)
8889
#' @param arrow Arrow specification, as created by [grid::arrow()]
8990
element_line <- function(colour = NULL, linewidth = NULL, linetype = NULL,
90-
lineend = NULL, color = NULL, arrow = NULL, inherit.blank = FALSE, size = deprecated()) {
91+
lineend = NULL, color = NULL, arrow = NULL, arrow.fill = NULL,
92+
inherit.blank = FALSE, size = deprecated()) {
9193

9294
if (lifecycle::is_present(size)) {
9395
deprecate_soft0("3.4.0", "element_line(size)", "element_line(linewidth)")
9496
linewidth <- size
9597
}
9698

97-
if (!is.null(color)) colour <- color
98-
if (is.null(arrow)) arrow <- FALSE
99+
colour <- color %||% colour
100+
arrow.fill <- arrow.fill %||% colour
101+
arrow <- arrow %||% FALSE
102+
99103
structure(
100104
list(colour = colour, linewidth = linewidth, linetype = linetype, lineend = lineend,
101-
arrow = arrow, inherit.blank = inherit.blank),
105+
arrow = arrow, arrow.fill = arrow.fill, inherit.blank = inherit.blank),
102106
class = c("element_line", "element")
103107
)
104108
}
@@ -253,28 +257,35 @@ element_grob.element_text <- function(element, label = "", x = NULL, y = NULL,
253257
#' @export
254258
element_grob.element_line <- function(element, x = 0:1, y = 0:1,
255259
colour = NULL, linewidth = NULL, linetype = NULL, lineend = NULL,
260+
arrow.fill = NULL,
256261
default.units = "npc", id.lengths = NULL, ..., size = deprecated()) {
257262

258263
if (lifecycle::is_present(size)) {
259264
deprecate_soft0("3.4.0", "element_grob.element_line(size)", "element_grob.element_line(linewidth)")
260265
linewidth <- size
261266
}
262267

268+
arrow <- if (is.logical(element$arrow) && !element$arrow) {
269+
NULL
270+
} else {
271+
element$arrow
272+
}
273+
if (is.null(arrow)) {
274+
arrow.fill <- colour
275+
element$arrow.fill <- element$colour
276+
}
277+
263278
# The gp settings can override element_gp
264279
gp <- ggpar(
265-
col = colour, fill = colour,
280+
col = colour, fill = arrow.fill %||% colour,
266281
lwd = linewidth, lty = linetype, lineend = lineend
267282
)
268283
element_gp <- ggpar(
269-
col = element$colour, fill = element$colour,
284+
col = element$colour, fill = element$arrow.fill %||% element$colour,
270285
lwd = element$linewidth, lty = element$linetype,
271286
lineend = element$lineend
272287
)
273-
arrow <- if (is.logical(element$arrow) && !element$arrow) {
274-
NULL
275-
} else {
276-
element$arrow
277-
}
288+
278289
polylineGrob(
279290
x, y, default.units = default.units,
280291
gp = modify_list(element_gp, gp),

‎man/element.Rd

Lines changed: 3 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/geom_path.Rd

Lines changed: 4 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)