From 8106e19d6875d7675af53847570e39b5773fb03b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 18 Jan 2024 09:26:58 +0100 Subject: [PATCH 1/5] copy old makeContent method --- NAMESPACE | 1 + R/textContourGrob.R | 29 ++++++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index a4ddbd86..40732283 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ S3method(interleave,default) S3method(interleave,unit) S3method(makeContent,arrow2) S3method(makeContent,contourTextGrob) +S3method(makeContent,metR_labelgrob) S3method(makeContent,vector) S3method(predict,eof) S3method(print,eof) diff --git a/R/textContourGrob.R b/R/textContourGrob.R index ed8433d2..88af7ca1 100644 --- a/R/textContourGrob.R +++ b/R/textContourGrob.R @@ -235,7 +235,34 @@ labelGrob <- function (label, x = grid::unit(0.5, "npc"), y = grid::unit(0.5, "n y <- grid::unit(y, default.units) grid::gTree(label = label, x = x, y = y, just = just, padding = padding, r = r, name = name, text.gp = text.gp, rect.gp = rect.gp, - vp = vp, cl = "labelgrob") + vp = vp, cl = "metR_labelgrob") +} + +#' @export +makeContent.metR_labelgrob <- function(x) { + hj <- grid::resolveHJust(x$just, NULL) + vj <- grid::resolveVJust(x$just, NULL) + + t <- grid::textGrob( + x$label, + x$x + 2 * (0.5 - hj) * x$padding, + x$y + 2 * (0.5 - vj) * x$padding, + just = c(hj, vj), + gp = x$text.gp, + name = "text" + ) + + r <- grid::roundrectGrob( + x$x, x$y, default.units = "native", + width = grid::grobWidth(t) + 2 * x$padding, + height = grid::grobHeight(t) + 2 * x$padding, + just = c(hj, vj), + r = x$r, + gp = x$rect.gp, + name = "box" + ) + + grid::setChildren(x, grid::gList(r, t)) } ggname <- function (prefix, grob) { From d5ef177796daca8d6754a9d1838b3501f6cfe07c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 19 Jan 2024 15:49:25 +0100 Subject: [PATCH 2/5] avoid deprecated `scale_name` --- R/geom_arrow.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/geom_arrow.R b/R/geom_arrow.R index 8772beeb..18d6af76 100644 --- a/R/geom_arrow.R +++ b/R/geom_arrow.R @@ -358,7 +358,8 @@ StatArrow <- ggplot2::ggproto("StatArrow", ggplot2::Stat, warningf("The use of preserve.dir = FALSE with discrete scales is not recommended.", call. = FALSE) } - if (scales$x$scale_name == "date" | scales$x$scale_name == "date") { + trans_name <- scales$x$trans$name + if (trans_name == "date") { warningf("The use of preserve.dir = FALSE with date scales is not recommended.", call. = FALSE) } } From 9dcc1e33ed2b025d26c90075bdf11f3bf1bad248 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 19 Jan 2024 15:49:43 +0100 Subject: [PATCH 3/5] update `guide_vector()` --- R/guide_vector.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/guide_vector.R b/R/guide_vector.R index be3d931e..23985d44 100644 --- a/R/guide_vector.R +++ b/R/guide_vector.R @@ -118,7 +118,7 @@ guide_geom.vector <- function(guide, layers, ...) { return(NextMethod()) } legend <- ggplot2::guide_legend() - legend$get_layer_key(guide, layers) + legend$get_layer_key(guide, layers, rep(list(NULL), length(layers))) } #' @export @@ -127,8 +127,13 @@ guide_gengrob.vector <- function(guide, theme) { if (!inherits(ggplot2::guide_none(), "Guide")) { return(NextMethod()) } + position <- theme$legend.position %||% "right" + direction <- theme$legend.direction %||% switch( + position, top = , bottom = "horizontal", "vertical" + ) + theme$legend.key.width <- guide$keywidth legend <- ggplot2::guide_legend() - legend$draw(theme, guide) + legend$draw(theme, position = position, direction = direction, params = guide) } From 36e21725cee6265110a4d0586f3acbf94be6a613 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 19 Jan 2024 15:53:13 +0100 Subject: [PATCH 4/5] deal with new out-of-bounds behaviour of scales --- R/guide_colorstrip.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/guide_colorstrip.R b/R/guide_colorstrip.R index 4b29830f..037c674d 100644 --- a/R/guide_colorstrip.R +++ b/R/guide_colorstrip.R @@ -138,12 +138,14 @@ guide_train.colorstrip <- function(guide, scale, aesthetic = NULL) { if (guide$inside) { breaks <- scale$get_breaks() - breaks <- breaks[!is.na(breaks)] - guide$nbin <- length(breaks) - .bar <- breaks + keep <- breaks >= .limits[1] & breaks <= .limits[2] & is.finite(breaks) + guide$nbin <- sum(keep) + .bar <- breaks[keep] } else { breaks <- .get_breaks(scale) - .bar <- .inside(breaks[!is.na(breaks)]) + # keep <- breaks >= .limits[1] & breaks <= .limits[2] & is.finite(breaks) + keep <- is.finite(breaks) + .bar <- .inside(breaks[keep]) guide$nbin <- length(.bar) } if (length(breaks) == 0 || all(is.na(breaks))) @@ -160,7 +162,7 @@ guide_train.colorstrip <- function(guide, scale, aesthetic = NULL) { ticks$.value <- breaks ticks$.label <- scale$get_labels(breaks) - guide$key <- ticks + guide$key <- ticks[keep, ,drop = FALSE] if (guide$reverse) { guide$key <- guide$key[nrow(guide$key):1, ] From 22a86e336cea33dde622f19c6ff199de3aaf32f2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 19 Jan 2024 15:54:40 +0100 Subject: [PATCH 5/5] remove spurious comment --- R/guide_colorstrip.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/guide_colorstrip.R b/R/guide_colorstrip.R index 037c674d..d5958426 100644 --- a/R/guide_colorstrip.R +++ b/R/guide_colorstrip.R @@ -143,7 +143,6 @@ guide_train.colorstrip <- function(guide, scale, aesthetic = NULL) { .bar <- breaks[keep] } else { breaks <- .get_breaks(scale) - # keep <- breaks >= .limits[1] & breaks <= .limits[2] & is.finite(breaks) keep <- is.finite(breaks) .bar <- .inside(breaks[keep]) guide$nbin <- length(.bar)