From a7842ee014a655d0096dc4e22d091b72178f3654 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 08:54:29 +0200 Subject: [PATCH 1/3] add arrow params --- R/geom-linerange.R | 11 +++++++++-- R/geom-pointrange.R | 23 ++++++++++++----------- 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 0d67908ec8..72748f272a 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -27,11 +27,18 @@ GeomLinerange <- ggproto( data }, - draw_panel = function(data, panel_params, coord, lineend = "butt", flipped_aes = FALSE, na.rm = FALSE) { + draw_panel = function(data, panel_params, coord, lineend = "butt", + flipped_aes = FALSE, na.rm = FALSE, + arrow = NULL, arrow.fill = NULL) { data <- flip_data(data, flipped_aes) data <- transform(data, xend = x, y = ymin, yend = ymax) data <- flip_data(data, flipped_aes) - ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord, lineend = lineend, na.rm = na.rm)) + grob <- GeomSegment$draw_panel( + data, panel_params, coord, + lineend = lineend, na.rm = na.rm, + arrow = arrow, arrow.fill = arrow.fill + ) + ggname("geom_linerange", grob) }, rename_size = TRUE diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R index 9029805aa4..7d9bcbf6d4 100644 --- a/R/geom-pointrange.R +++ b/R/geom-pointrange.R @@ -31,23 +31,24 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, }, draw_panel = function(data, panel_params, coord, lineend = "butt", fatten = 4, - flipped_aes = FALSE, na.rm = FALSE) { + flipped_aes = FALSE, na.rm = FALSE, + arrow = NULL, arrow.fill = NULL) { line_grob <- GeomLinerange$draw_panel( data, panel_params, coord, lineend = lineend, flipped_aes = flipped_aes, - na.rm = na.rm + na.rm = na.rm, arrow = arrow, arrow.fill = arrow.fill ) - if (is.null(data[[flipped_names(flipped_aes)$y]])) + + skip_point <- is.null(data[[flipped_names(flipped_aes)$y]]) + if (skip_point) { return(line_grob) + } - ggname("geom_pointrange", - gTree(children = gList( - line_grob, - GeomPoint$draw_panel( - transform(data, size = size * fatten), - panel_params, coord, na.rm = na.rm - ) - )) + point_grob <- GeomPoint$draw_panel( + transform(data, size = size * fatten), + panel_params, coord, na.rm = na.rm ) + grob <- gTree(children = gList(line_grob, point_grob)) + ggname("geom_pointrange", grob) } ) From 41111435ba8749b5af2f1e0a8603edc3da0d6ac2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 08:54:41 +0200 Subject: [PATCH 2/3] document --- R/geom-linerange.R | 1 + man/geom_linerange.Rd | 9 +++++++++ 2 files changed, 10 insertions(+) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 72748f272a..0ea5b93334 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -62,6 +62,7 @@ GeomLinerange <- ggproto( #' @export #' @inheritParams layer #' @inheritParams geom_bar +#' @inheritParams geom_segment #' @examples #' # Create a simple example dataset #' df <- data.frame( diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 311748dd98..48d76fc13f 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -53,6 +53,8 @@ geom_linerange( ..., orientation = NA, lineend = "butt", + arrow = NULL, + arrow.fill = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -67,6 +69,8 @@ geom_pointrange( orientation = NA, fatten = deprecated(), lineend = "butt", + arrow = NULL, + arrow.fill = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -179,6 +183,11 @@ that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=annotation_borders]{annotation_borders()}}.} \item{lineend}{Line end style (round, butt, square).} + +\item{arrow}{specification for arrow heads, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} } \description{ Various ways of representing a vertical interval defined by \code{x}, From e28bea436c599d8c2a8906fc499fbe466ac24abc Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 28 May 2025 08:52:05 +0200 Subject: [PATCH 3/3] accept snapshot --- tests/testthat/_snaps/function-args.md | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/tests/testthat/_snaps/function-args.md b/tests/testthat/_snaps/function-args.md index 32101d9cb9..379efb5c2e 100644 --- a/tests/testthat/_snaps/function-args.md +++ b/tests/testthat/_snaps/function-args.md @@ -3,18 +3,20 @@ Code problems Output - [1] "GeomBoxplot : `notch` with `notchwidth`" - [2] "GeomContour : `arrow` with `arrow.fill`" - [3] "GeomCurve : `arrow` with `arrow.fill`" - [4] "GeomDensity2d: `arrow` with `arrow.fill`" - [5] "GeomFunction : `arrow` with `arrow.fill`" - [6] "GeomLine : `arrow` with `arrow.fill`" - [7] "GeomPath : `arrow` with `arrow.fill`" - [8] "GeomQuantile : `arrow` with `arrow.fill`" - [9] "GeomSegment : `arrow` with `arrow.fill`" - [10] "GeomSf : `arrow` with `arrow.fill`" - [11] "GeomSpoke : `arrow` with `arrow.fill`" - [12] "GeomStep : `arrow` with `arrow.fill`" + [1] "GeomBoxplot : `notch` with `notchwidth`" + [2] "GeomContour : `arrow` with `arrow.fill`" + [3] "GeomCurve : `arrow` with `arrow.fill`" + [4] "GeomDensity2d : `arrow` with `arrow.fill`" + [5] "GeomFunction : `arrow` with `arrow.fill`" + [6] "GeomLine : `arrow` with `arrow.fill`" + [7] "GeomLinerange : `arrow` with `arrow.fill`" + [8] "GeomPath : `arrow` with `arrow.fill`" + [9] "GeomPointrange: `arrow` with `arrow.fill`" + [10] "GeomQuantile : `arrow` with `arrow.fill`" + [11] "GeomSegment : `arrow` with `arrow.fill`" + [12] "GeomSf : `arrow` with `arrow.fill`" + [13] "GeomSpoke : `arrow` with `arrow.fill`" + [14] "GeomStep : `arrow` with `arrow.fill`" # StatXxx$parameters() does not contain partial matches