From 88b6b1224563aa857a9f41016c0eb3a58d02b5aa Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 14:47:34 +0100 Subject: [PATCH 01/10] replace `geom_label(label.size)` with `linewidth` aesthetic --- R/geom-label.R | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/R/geom-label.R b/R/geom-label.R index 6f21478da0..79bb978056 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -11,7 +11,7 @@ geom_label <- function(mapping = NULL, data = NULL, nudge_y = 0, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, + label.size = deprecated(), size.unit = "mm", na.rm = FALSE, show.legend = NA, @@ -27,6 +27,12 @@ geom_label <- function(mapping = NULL, data = NULL, position <- position_nudge(nudge_x, nudge_y) } + extra_args <- list2(...) + if (lifecycle::is_present(label.size)) { + deprecate_warn0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)") + extra_args$linewidth <- extra_args$linewidth %||% label.size + } + layer( data = data, mapping = mapping, @@ -39,10 +45,9 @@ geom_label <- function(mapping = NULL, data = NULL, parse = parse, label.padding = label.padding, label.r = label.r, - label.size = label.size, size.unit = size.unit, na.rm = na.rm, - ... + !!!extra_args ) ) } @@ -61,14 +66,14 @@ GeomLabel <- ggproto("GeomLabel", Geom, size = from_theme(fontsize), angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, fontface = 1, - lineheight = 1.2 + lineheight = 1.2, + linewidth = from_theme(borderwidth) ), draw_panel = function(self, data, panel_params, coord, parse = FALSE, na.rm = FALSE, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, size.unit = "mm") { lab <- data$label if (parse) { @@ -101,9 +106,9 @@ GeomLabel <- ggproto("GeomLabel", Geom, lineheight = row$lineheight ), rect.gp = gg_par( - col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour, + col = if (isTRUE(all.equal(row$linewidth, 0))) NA else row$colour, fill = fill_alpha(row$fill, row$alpha), - lwd = label.size + lwd = row$linewidth ) ) }) From 0bb7c223a142cbf97d2774fac8f7b6a2a73cc0f1 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 14:52:54 +0100 Subject: [PATCH 02/10] add `linetype` aesthetic --- R/geom-label.R | 6 ++++-- ggplot2.Rproj | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/geom-label.R b/R/geom-label.R index 79bb978056..c4cda19b69 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -67,7 +67,8 @@ GeomLabel <- ggproto("GeomLabel", Geom, angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, fontface = 1, lineheight = 1.2, - linewidth = from_theme(borderwidth) + linewidth = from_theme(borderwidth), + linetype = from_theme(bordertype) ), draw_panel = function(self, data, panel_params, coord, parse = FALSE, @@ -108,7 +109,8 @@ GeomLabel <- ggproto("GeomLabel", Geom, rect.gp = gg_par( col = if (isTRUE(all.equal(row$linewidth, 0))) NA else row$colour, fill = fill_alpha(row$fill, row$alpha), - lwd = row$linewidth + lwd = row$linewidth, + lty = row$linetype ) ) }) diff --git a/ggplot2.Rproj b/ggplot2.Rproj index 30db3b4433..5215454023 100644 --- a/ggplot2.Rproj +++ b/ggplot2.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: f500cb87-e0be-413f-b396-3eb022932f55 RestoreWorkspace: Default SaveWorkspace: Default From b42bd8774f69891323538252e4511fa75bede490 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 14:53:08 +0100 Subject: [PATCH 03/10] add border and text colours --- R/geom-label.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/geom-label.R b/R/geom-label.R index c4cda19b69..d6cf36557b 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -12,6 +12,10 @@ geom_label <- function(mapping = NULL, data = NULL, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), label.size = deprecated(), + border.colour = NULL, + border.color = NULL, + text.colour = NULL, + text.color = NULL, size.unit = "mm", na.rm = FALSE, show.legend = NA, @@ -46,6 +50,8 @@ geom_label <- function(mapping = NULL, data = NULL, label.padding = label.padding, label.r = label.r, size.unit = size.unit, + border.colour = border.color %||% border.colour, + text.colour = text.color %||% text.colour, na.rm = na.rm, !!!extra_args ) @@ -75,6 +81,8 @@ GeomLabel <- ggproto("GeomLabel", Geom, na.rm = FALSE, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), + border.colour = NULL, + text.colour = NULL, size.unit = "mm") { lab <- data$label if (parse) { @@ -89,6 +97,8 @@ GeomLabel <- ggproto("GeomLabel", Geom, } size.unit <- resolve_text_unit(size.unit) + data$border.colour <- border.colour %||% data$colour + data$text.colour <- text.colour %||% data$colour grobs <- lapply(seq_len(nrow(data)), function(i) { row <- data[i, , drop = FALSE] @@ -100,14 +110,14 @@ GeomLabel <- ggproto("GeomLabel", Geom, r = label.r, angle = row$angle, text.gp = gg_par( - col = row$colour, + col = row$text.colour, fontsize = row$size * size.unit, fontfamily = row$family, fontface = row$fontface, lineheight = row$lineheight ), rect.gp = gg_par( - col = if (isTRUE(all.equal(row$linewidth, 0))) NA else row$colour, + col = if (isTRUE(all.equal(row$linewidth, 0))) NA else row$border.colour, fill = fill_alpha(row$fill, row$alpha), lwd = row$linewidth, lty = row$linetype From 35e829bff16e47336dcd37648ec55000d1292f01 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 14:56:24 +0100 Subject: [PATCH 04/10] vectorise some operations --- R/geom-label.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/geom-label.R b/R/geom-label.R index d6cf36557b..e7002daa10 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -97,8 +97,12 @@ GeomLabel <- ggproto("GeomLabel", Geom, } size.unit <- resolve_text_unit(size.unit) - data$border.colour <- border.colour %||% data$colour data$text.colour <- text.colour %||% data$colour + data$border.colour <- border.colour %||% data$colour + data$border.colour[data$linewidth == 0] <- NA + data$fill <- fill_alpha(data$fill, data$alpha) + data$size <- data$size * size.unit + grobs <- lapply(seq_len(nrow(data)), function(i) { row <- data[i, , drop = FALSE] @@ -111,14 +115,14 @@ GeomLabel <- ggproto("GeomLabel", Geom, angle = row$angle, text.gp = gg_par( col = row$text.colour, - fontsize = row$size * size.unit, + fontsize = row$size, fontfamily = row$family, fontface = row$fontface, lineheight = row$lineheight ), rect.gp = gg_par( - col = if (isTRUE(all.equal(row$linewidth, 0))) NA else row$border.colour, - fill = fill_alpha(row$fill, row$alpha), + col = row$border.colour, + fill = row$fill, lwd = row$linewidth, lty = row$linetype ) From 28b74be2b2d676731f5cb9bc29a6360673241fa7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:19:12 +0100 Subject: [PATCH 05/10] preserve thinner linewidth --- R/geom-label.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-label.R b/R/geom-label.R index e7002daa10..4afc7add1b 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -73,7 +73,7 @@ GeomLabel <- ggproto("GeomLabel", Geom, angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, fontface = 1, lineheight = 1.2, - linewidth = from_theme(borderwidth), + linewidth = from_theme(borderwidth * 0.5), linetype = from_theme(bordertype) ), From 8273111d406e4c6439c8063559a525fce33cd9fd Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:19:25 +0100 Subject: [PATCH 06/10] apply to `geom_sf_labels()` too --- R/geom-sf.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/geom-sf.R b/R/geom-sf.R index 1d53d67499..178756aedb 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -321,7 +321,11 @@ geom_sf_label <- function(mapping = aes(), data = NULL, nudge_y = 0, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, + label.size = deprecated(), + border.colour = NULL, + border.color = NULL, + text.colour = NULL, + text.color = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, @@ -338,6 +342,12 @@ geom_sf_label <- function(mapping = aes(), data = NULL, position <- position_nudge(nudge_x, nudge_y) } + extra_args <- list2(...) + if (lifecycle::is_present(label.size)) { + deprecate_warn0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)") + extra_args$linewidth <- extra_args$linewidth %||% label.size + } + layer_sf( data = data, mapping = mapping, @@ -350,10 +360,11 @@ geom_sf_label <- function(mapping = aes(), data = NULL, parse = parse, label.padding = label.padding, label.r = label.r, - label.size = label.size, na.rm = na.rm, fun.geometry = fun.geometry, - ... + border.colour = border.color %||% border.colour, + text.colour = text.color %||% text.colour, + !!!extra_args ) ) } From 8ef063be6b8e893ec46a4cc369b5a5411cabf80b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:31:21 +0100 Subject: [PATCH 07/10] adapt legend key --- R/legend-draw.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/legend-draw.R b/R/legend-draw.R index d08c6c6c93..09a9cedc6b 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -332,7 +332,6 @@ draw_key_text <- function(data, params, size) { #' @rdname draw_key draw_key_label <- function(data, params, size) { data <- replace_null(unclass(data), label = "a", angle = 0) - params$label.size <- params$label.size %||% 0.25 hjust <- compute_just(data$hjust %||% 0.5) vjust <- compute_just(data$vjust %||% 0.5) just <- rotate_just(data$angle, hjust, vjust) @@ -342,6 +341,7 @@ draw_key_label <- function(data, params, size) { face = data$fontface %||% 1, size = data$size %||% 3.88 ) + lwd <- data$linewidth %||% 0.25 grob <- labelGrob( data$label, x = unit(just$hjust, "npc"), @@ -351,15 +351,16 @@ draw_key_label <- function(data, params, size) { padding = padding, r = params$label.r %||% unit(0.15, "lines"), text.gp = gg_par( - col = data$colour %||% "black", + col = params$text.colour %||% data$colour %||% "black", fontfamily = data$family %||% "", fontface = data$fontface %||% 1, fontsize = (data$size %||% 3.88) * .pt ), rect.gp = gg_par( - col = if (isTRUE(all.equal(params$label.size, 0))) NA else data$colour, + col = if (isTRUE(all.equal(lwd, 0))) NA else params$border.colour %||% data$colour %||% "black", fill = alpha(data$fill %||% "white", data$alpha), - lwd = params$label.size + lwd = lwd, + lty = data$linetype %||% 1L ) ) angle <- deg2rad(data$angle %||% 0) From 7f3b5fb0a4927d594ab9d99fe2da7897bad5465e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:35:16 +0100 Subject: [PATCH 08/10] document new params --- R/geom-label.R | 9 ++++++++- man/geom_text.Rd | 17 +++++++++++++++-- man/ggsf.Rd | 17 +++++++++++++++-- 3 files changed, 38 insertions(+), 5 deletions(-) diff --git a/R/geom-label.R b/R/geom-label.R index 4afc7add1b..c3ef380d81 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -2,7 +2,14 @@ #' @rdname geom_text #' @param label.padding Amount of padding around label. Defaults to 0.25 lines. #' @param label.r Radius of rounded corners. Defaults to 0.15 lines. -#' @param label.size Size of label border, in mm. +#' @param label.size `r lifecycle::badge("deprecated")` Replaced by the +#' `linewidth` aesthetic. Size of label border, in mm. +#' @param border.colour,border.color Colour of label border. When `NULL` +#' (default), the `colour` aesthetic determines the colour of the label border. +#' `border.color` is an alias for `border.colour`. +#' @param text.colour,text.color Colour of the text. When `NULL` (default), the +#' `colour` aesthetic determines the colour of the text. `text.color` is an +#' alias for `text.colour`. geom_label <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., diff --git a/man/geom_text.Rd b/man/geom_text.Rd index e88e45a0e1..c99c8545df 100644 --- a/man/geom_text.Rd +++ b/man/geom_text.Rd @@ -16,7 +16,11 @@ geom_label( nudge_y = 0, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, + label.size = deprecated(), + border.colour = NULL, + border.color = NULL, + text.colour = NULL, + text.color = NULL, size.unit = "mm", na.rm = FALSE, show.legend = NA, @@ -125,7 +129,16 @@ Cannot be jointly specified with \code{position}.} \item{label.r}{Radius of rounded corners. Defaults to 0.15 lines.} -\item{label.size}{Size of label border, in mm.} +\item{label.size}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Replaced by the +\code{linewidth} aesthetic. Size of label border, in mm.} + +\item{border.colour, border.color}{Colour of label border. When \code{NULL} +(default), the \code{colour} aesthetic determines the colour of the label border. +\code{border.color} is an alias for \code{border.colour}.} + +\item{text.colour, text.color}{Colour of the text. When \code{NULL} (default), the +\code{colour} aesthetic determines the colour of the text. \code{text.color} is an +alias for \code{text.colour}.} \item{size.unit}{How the \code{size} aesthetic is interpreted: as millimetres (\code{"mm"}, default), points (\code{"pt"}), centimetres (\code{"cm"}), inches (\code{"in"}), diff --git a/man/ggsf.Rd b/man/ggsf.Rd index 1fee9f59bb..532553b354 100644 --- a/man/ggsf.Rd +++ b/man/ggsf.Rd @@ -51,7 +51,11 @@ geom_sf_label( nudge_y = 0, label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, + label.size = deprecated(), + border.colour = NULL, + border.color = NULL, + text.colour = NULL, + text.color = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, @@ -285,7 +289,16 @@ Cannot be jointly specified with \code{position}.} \item{label.r}{Radius of rounded corners. Defaults to 0.15 lines.} -\item{label.size}{Size of label border, in mm.} +\item{label.size}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Replaced by the +\code{linewidth} aesthetic. Size of label border, in mm.} + +\item{border.colour, border.color}{Colour of label border. When \code{NULL} +(default), the \code{colour} aesthetic determines the colour of the label border. +\code{border.color} is an alias for \code{border.colour}.} + +\item{text.colour, text.color}{Colour of the text. When \code{NULL} (default), the +\code{colour} aesthetic determines the colour of the text. \code{text.color} is an +alias for \code{text.colour}.} \item{fun.geometry}{A function that takes a \code{sfc} object and returns a \code{sfc_POINT} with the same length as the input. If \code{NULL}, \code{function(x) sf::st_point_on_surface(sf::st_zm(x))} From 6ac9d4651566989b02c646a835b503e1febb6685 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:40:16 +0100 Subject: [PATCH 09/10] add test --- .../geom-label-with-line-parameters.svg | 121 ++++++++++++++++++ tests/testthat/test-geom-label.R | 11 ++ 2 files changed, 132 insertions(+) create mode 100644 tests/testthat/_snaps/geom-label/geom-label-with-line-parameters.svg diff --git a/tests/testthat/_snaps/geom-label/geom-label-with-line-parameters.svg b/tests/testthat/_snaps/geom-label/geom-label-with-line-parameters.svg new file mode 100644 index 0000000000..b7c5c9717f --- /dev/null +++ b/tests/testthat/_snaps/geom-label/geom-label-with-line-parameters.svg @@ -0,0 +1,121 @@ + + + + + + + + + + + + + + + + + + + + + + +foo + +bar + +baz + +foo + +bar + +baz + + + +1.00 +1.25 +1.50 +1.75 +2.00 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + +labels + + +a + +a + + +a + +a + + +a + +a +bar +baz +foo + +x + + +a + +a + + +a + +a + + +a + +a + + +a + +a + + +a + +a +1.0 +1.5 +2.0 +2.5 +3.0 +geom_label with line parameters + + diff --git a/tests/testthat/test-geom-label.R b/tests/testthat/test-geom-label.R index 028c3c4980..812d715073 100644 --- a/tests/testthat/test-geom-label.R +++ b/tests/testthat/test-geom-label.R @@ -22,3 +22,14 @@ test_that("geom_label() rotates labels", { angle_out <- unname(vapply(vps, `[[`, numeric(1), "angle")) expect_equal(angle_in, angle_out) }) + +test_that("geom_label handles line parameters and colours", { + df <- data.frame(x = 1:3, labels = c("foo", "bar", "baz")) + + p <- ggplot(df, aes(x, label = labels, colour = labels, linewidth = x)) + + geom_label(aes(y = 1), border.colour = "black", linetype = 1) + + geom_label(aes(y = 2), text.colour = "black", linetype = 2) + + scale_linewidth(range = c(0.1, 1)) + + expect_doppelganger("geom_label with line parameters", p) +}) From 3730f24a856d7767fdb275a8538eb261d40fff9d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 24 Jan 2025 15:44:18 +0100 Subject: [PATCH 10/10] add news bullet --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/NEWS.md b/NEWS.md index 539dee258c..b88c5f2acb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # ggplot2 (development version) +* New parameters for `geom_label()` (@teunbrand and @steveharoz, #5365): + * The `linewidth` aesthetic is now applied and replaces the `label.size` + argument. + * The `linetype` aesthetic is now applied. + * New `border.colour` argument to set the colour of borders. + * New `text.colour` argument to set the colour of text. * `scale_{x/y}_discrete(continuous.limits)` is a new argument to control the display range of discrete scales (@teunbrand, #4174, #6259). * `geom_ribbon()` now appropriately warns about, and removes, missing values