From d5d48cd0797745828943f9cc2143f64c83fc6124 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Sat, 16 Dec 2023 00:14:44 +0100 Subject: [PATCH 1/5] Add `draw_key_richtext()` function --- NAMESPACE | 1 + R/draw-keys.R | 89 ++++++++++++++++++++++++++++++++++++++++ man/draw_key_richtext.Rd | 29 +++++++++++++ 3 files changed, 119 insertions(+) create mode 100644 R/draw-keys.R create mode 100644 man/draw_key_richtext.Rd diff --git a/NAMESPACE b/NAMESPACE index dec4757..d4a710a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ S3method(element_grob,element_textbox) export(GeomRichText) export(GeomRichtext) export(GeomTextBox) +export(draw_key_richtext) export(element_markdown) export(element_textbox) export(element_textbox_simple) diff --git a/R/draw-keys.R b/R/draw-keys.R new file mode 100644 index 0000000..de6257a --- /dev/null +++ b/R/draw-keys.R @@ -0,0 +1,89 @@ +#' Key glyph for rich text +#' +#' This is a function for rendering the key in the rich text style when a geom +#' needs to be displayed in a legend. It is designed to be provided to a layer's +#' `key_glyph` argument, either as a function or as `key_glyph = "richtext"`. +#' +#' @inheritParams ggplot2::draw_key +#' +#' @return A [`richtext_grob`][gridtext::richtext_grob] that represents +#' formatted text. +#' @export +#' +#' @examples +#' ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + +#' geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") +draw_key_richtext <- function(data, params, size) { + + # Set text justification + data$hjust <- data$hjust %||% 0.5 + data$vjust <- data$vjust %||% 0.5 + data$angle <- data$angle %||% 0 + just <- rotate_just(data$angle, data$hjust, data$vjust) + + # Populate graphical parameters for text + text_gp <- gpar( + fontsize = (data$size %||% 3.88) * .pt, + fontfamily = data$family %||% "", + fontface = data$face %||% 1, + col = scales::alpha( + data$text.colour %||% data$colour %||% "black", + data$alpha %||% NA + ), + lineheight = data$lineheight %||% 1.2 + ) + + # Populate graphical parameters for text box + box_gp <- gpar( + col = scales::alpha( + data$label.colour %||% data$colour %||% "black", + data$alpha %||% NA + ), + fill = scales::alpha(data$fill %||% "white", data$alpha %||% NA), + lwd = (data$label.size %||% 0.25) * .pt + ) + + grob <- richtext_grob( + text = data[["label"]] %||% "a", # prevent partial matching + x = unit(just$hjust, "npc"), + y = unit(just$vjust, "npc"), + rot = data$angle, + hjust = just$hjust, + vjust = just$vjust, + gp = text_gp, + box_gp = box_gp, + # Defaults for unit input are the same as `geom_richtext()` formals + r = params$label.r %||% unit(0.15, "lines"), + padding = params$label.padding %||% + unit(c(0.25, 0.25, 0.25, 0.25), "lines"), + margin = params$label.margin %||% + unit(c(0, 0, 0, 0), "lines"), + ) + + # Key drawing functions deal with 1 key at a time, so we can extract the + # box's (relative) coordinates from the first child-grob. + # The units are given in points + x <- range(grob$children[[1]]$xext) + y <- range(grob$children[[1]]$yext) + + # Calculate offsets that account for textbox size + xoffset <- x[1] * (1 - just$hjust) + x[2] * just$hjust + yoffset <- y[1] * (1 - just$vjust) + y[2] * just$vjust + + # We apply offsets to the grob's viewport so that textbox is remains within + # the bounds of the key area + grob <- editGrob( + grob, + vp = viewport( + x = unit(0.5, "npc") - unit(xoffset, "pt"), + y = unit(0.5, "npc") - unit(yoffset, "pt") + ) + ) + + # Calculate size in cm. + # 'x * .pt' converts mm to pt, so 'x / .pt' converts pt to mm + # This circumvents `convertWidth(grobWidth(grob), "cm", valueOnly = TRUE)` + attr(grob, "width") <- diff(x) / (10 * .pt) + attr(grob, "height") <- diff(y) / (10 * .pt) + grob +} \ No newline at end of file diff --git a/man/draw_key_richtext.Rd b/man/draw_key_richtext.Rd new file mode 100644 index 0000000..d69ac64 --- /dev/null +++ b/man/draw_key_richtext.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/draw-keys.R +\name{draw_key_richtext} +\alias{draw_key_richtext} +\title{Key glyph for rich text} +\usage{ +draw_key_richtext(data, params, size) +} +\arguments{ +\item{data}{A single row data frame containing the scaled aesthetics to +display in this key} + +\item{params}{A list of additional parameters supplied to the geom.} + +\item{size}{Width and height of key in mm.} +} +\value{ +A \code{\link[gridtext:richtext_grob]{richtext_grob}} that represents +formatted text. +} +\description{ +This is a function for rendering the key in the rich text style when a geom +needs to be displayed in a legend. It is designed to be provided to a layer's +\code{key_glyph} argument, either as a function or as \code{key_glyph = "richtext"}. +} +\examples{ +ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + + geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") +} From 85e33ebc916c8f5d522fb7a15c4286897ca23153 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Sat, 16 Dec 2023 00:22:52 +0100 Subject: [PATCH 2/5] Account for linewidth in grob size --- R/draw-keys.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/draw-keys.R b/R/draw-keys.R index de6257a..3731a96 100644 --- a/R/draw-keys.R +++ b/R/draw-keys.R @@ -34,13 +34,14 @@ draw_key_richtext <- function(data, params, size) { ) # Populate graphical parameters for text box + lwd <- (data$label.size %||% 0.25) * .pt box_gp <- gpar( col = scales::alpha( data$label.colour %||% data$colour %||% "black", data$alpha %||% NA ), fill = scales::alpha(data$fill %||% "white", data$alpha %||% NA), - lwd = (data$label.size %||% 0.25) * .pt + lwd = lwd ) grob <- richtext_grob( @@ -63,8 +64,8 @@ draw_key_richtext <- function(data, params, size) { # Key drawing functions deal with 1 key at a time, so we can extract the # box's (relative) coordinates from the first child-grob. # The units are given in points - x <- range(grob$children[[1]]$xext) - y <- range(grob$children[[1]]$yext) + x <- range(grob$children[[1]]$xext) + c(-0.5, 0.5) * lwd + y <- range(grob$children[[1]]$yext) + c(-0.5, 0.5) * lwd # Calculate offsets that account for textbox size xoffset <- x[1] * (1 - just$hjust) + x[2] * just$hjust From 2d8a5128d7e27f7883ebc87c8f7909b950598fc6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Sat, 16 Dec 2023 00:35:08 +0100 Subject: [PATCH 3/5] Fix misalignment bug --- R/draw-keys.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/draw-keys.R b/R/draw-keys.R index 3731a96..10b49b6 100644 --- a/R/draw-keys.R +++ b/R/draw-keys.R @@ -49,8 +49,8 @@ draw_key_richtext <- function(data, params, size) { x = unit(just$hjust, "npc"), y = unit(just$vjust, "npc"), rot = data$angle, - hjust = just$hjust, - vjust = just$vjust, + hjust = data$hjust, + vjust = data$vjust, gp = text_gp, box_gp = box_gp, # Defaults for unit input are the same as `geom_richtext()` formals From f27ef9cc6005a1801b6aede7940b3143b7f2d8ae Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Sat, 16 Dec 2023 00:37:02 +0100 Subject: [PATCH 4/5] Add visual test --- .../draw-keys/rotated-rich-text-keys.svg | 221 ++++++++++++++++++ tests/testthat/test-draw-keys.R | 18 ++ 2 files changed, 239 insertions(+) create mode 100644 tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg create mode 100644 tests/testthat/test-draw-keys.R diff --git a/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg b/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg new file mode 100644 index 0000000..ef93642 --- /dev/null +++ b/tests/testthat/_snaps/draw-keys/rotated-rich-text-keys.svg @@ -0,0 +1,221 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 + + + + + + + + + + +2.0 +2.5 +3.0 +3.5 +4.0 +4.5 +Sepal.Width +Sepal.Length + +Species + + +Iris +setosa + + +Iris +versicolor + + +Iris +virginica +Rotated rich text keys + + diff --git a/tests/testthat/test-draw-keys.R b/tests/testthat/test-draw-keys.R new file mode 100644 index 0000000..1366b6d --- /dev/null +++ b/tests/testthat/test-draw-keys.R @@ -0,0 +1,18 @@ +test_that("visual test", { + skip_if_not(packageVersion("ggplot2") >= "3.5.0") + + p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, colour = Species)) + + geom_point(key_glyph = "richtext") + + scale_colour_discrete( + labels = NULL, + guide = guide_legend(override.aes = list( + label = paste0( + "Iris", + c("
setosa", " versicolor", "
virginica"), "" + ), + size = 11 / .pt, hjust = c(1, 0.5, 0), angle = c(-45, 0, 45), + label.colour = "blue" + )) + ) + expect_doppelganger("Rotated rich text keys", p) +}) From 694619935aa9ecb41b1c287b59a426a3af2a312f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 19 Dec 2023 20:48:17 +0100 Subject: [PATCH 5/5] add library call to example --- R/draw-keys.R | 28 +++++++++++++++------------- man/draw_key_richtext.Rd | 2 ++ 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/R/draw-keys.R b/R/draw-keys.R index 10b49b6..2d6bd31 100644 --- a/R/draw-keys.R +++ b/R/draw-keys.R @@ -11,6 +11,8 @@ #' @export #' #' @examples +#' library(ggplot2) +#' #' ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + #' geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") draw_key_richtext <- function(data, params, size) { @@ -67,19 +69,19 @@ draw_key_richtext <- function(data, params, size) { x <- range(grob$children[[1]]$xext) + c(-0.5, 0.5) * lwd y <- range(grob$children[[1]]$yext) + c(-0.5, 0.5) * lwd - # Calculate offsets that account for textbox size - xoffset <- x[1] * (1 - just$hjust) + x[2] * just$hjust - yoffset <- y[1] * (1 - just$vjust) + y[2] * just$vjust - - # We apply offsets to the grob's viewport so that textbox is remains within - # the bounds of the key area - grob <- editGrob( - grob, - vp = viewport( - x = unit(0.5, "npc") - unit(xoffset, "pt"), - y = unit(0.5, "npc") - unit(yoffset, "pt") - ) - ) + # # Calculate offsets that account for textbox size + # xoffset <- x[1] * (1 - just$hjust) + x[2] * just$hjust + # yoffset <- y[1] * (1 - just$vjust) + y[2] * just$vjust + # + # # We apply offsets to the grob's viewport so that textbox is remains within + # # the bounds of the key area + # grob <- editGrob( + # grob, + # vp = viewport( + # x = unit(0.5, "npc") - unit(xoffset, "pt"), + # y = unit(0.5, "npc") - unit(yoffset, "pt") + # ) + # ) # Calculate size in cm. # 'x * .pt' converts mm to pt, so 'x / .pt' converts pt to mm diff --git a/man/draw_key_richtext.Rd b/man/draw_key_richtext.Rd index d69ac64..e3f728b 100644 --- a/man/draw_key_richtext.Rd +++ b/man/draw_key_richtext.Rd @@ -24,6 +24,8 @@ needs to be displayed in a legend. It is designed to be provided to a layer's \code{key_glyph} argument, either as a function or as \code{key_glyph = "richtext"}. } \examples{ +library(ggplot2) + ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) + geom_richtext(aes(colour = factor(cyl)), key_glyph = "richtext") }