From ebfe9f4ca4485e3ce6cd708715516152baa7afc6 Mon Sep 17 00:00:00 2001 From: William Gearty Date: Wed, 7 Aug 2024 16:09:49 -0700 Subject: [PATCH] Add option to abbreviate interval labels based on only those that are actually shown (fixes #64) --- R/coord_geo.R | 56 +++++++++++++------ R/get_scale_data.R | 2 +- man/coord_geo.Rd | 15 +++-- .../_snaps/coord_geo/geom-fit-text-new.svg | 11 ---- .../coord_geo/scale-on-all-facets-new.svg | 33 ----------- .../coord_geo/scale-on-fossil-ggtree-new.svg | 38 ------------- .../_snaps/coord_geo/scale-on-ggtree-new.svg | 4 -- .../coord_geo/scale-on-only-one-facet-new.svg | 11 ---- .../scales-on-different-sides1-new.svg | 51 ----------------- .../scales-on-different-sides2-new.svg | 42 -------------- .../_snaps/coord_geo/stacked-scales-new.svg | 14 ----- .../ggarrange2/double-ggarrange2-new.svg | 11 ---- .../_snaps/scales/scale-color-geo-new.svg | 7 --- .../_snaps/scales/scale-discrete-geo-new.svg | 7 --- 14 files changed, 52 insertions(+), 250 deletions(-) diff --git a/R/coord_geo.R b/R/coord_geo.R index e033caf..e9e340a 100644 --- a/R/coord_geo.R +++ b/R/coord_geo.R @@ -72,8 +72,15 @@ utils::globalVariables(c("min_age", "max_age", "mid_age", "label", #' `lab_color` column) and will be recycled if/as necessary. #' @param rot The amount of counter-clockwise rotation to add to the labels #' (in degrees). -#' @param abbrv If including labels, whether to use abbreviations instead of -#' full interval names. +#' @param abbrv If including labels, should the labels be abbreviated? If +#' `TRUE`, the `abbrev` column will be used for the labels. If `FALSE`, the +#' `name` column will be used for the labels. If `"auto"`, the [abbreviate()] +#' function will be used to abbreviate the values in the `name` column. Note +#' that the built-in data and data retrieved via [get_scale_data()] already +#' have built-in abbreviations. However, using the `"auto"` option here will +#' create new unique abbreviations based on only the intervals that are being +#' plotted. In many cases, this may result in abbreviations that are shorter +#' in length because there are fewer similar interval names to abbreviate. #' @param skip A vector of interval names indicating which intervals should not #' be labeled. If `abbrv` is `TRUE`, this can also include interval #' abbreviations. @@ -85,7 +92,7 @@ utils::globalVariables(c("min_age", "max_age", "mid_age", "label", #' @param fontface The font face to use for the labels. The standard options are #' "plain" (default), "bold", "italic", and "bold.italic". #' @param lwd Line width. -#' @param neg Set this to true if your x-axis is using negative values. +#' @param neg Set this to `TRUE` if your x-axis is using negative values. #' @param bord A vector specifying on which sides of the scale to add borders #' (same options as `pos`). #' @param center_end_labels Should labels be centered within the visible range @@ -318,7 +325,9 @@ make_geo_scale <- function(self, dat, fill, color, alpha, pos, check_number_decimal(alpha, min = 0, max = 1) check_bool(lab) check_number_decimal(rot) - check_bool(abbrv) + if (!is.logical(abbrv) && abbrv != "auto") { + cli::cli_abort('`abbrv` must be either a boolean or "auto".') + } check_string(family) check_string(fontface) check_character(skip, allow_null = TRUE) @@ -359,18 +368,6 @@ make_geo_scale <- function(self, dat, fill, color, alpha, pos, } else if (!("color" %in% colnames(dat))) { dat$color <- rep(c("grey60", "grey80"), length.out = nrow(dat)) } - if (!is.null(lab_color)) { - dat$lab_color <- rep(lab_color, length.out = nrow(dat)) - } else if (!("lab_color" %in% colnames(dat))) { - dat$lab_color <- "black" - } - if (abbrv && "abbr" %in% colnames(dat)) { - dat$label <- dat$abbr - dat$label[dat$abbr %in% skip] <- "" - } else { - dat$label <- dat$name - } - dat$label[dat$name %in% skip] <- "" # do this so ggsave gets the whole plot old_plot <- last_plot() @@ -420,8 +417,23 @@ make_geo_scale <- function(self, dat, fill, color, alpha, pos, expand = FALSE, clip = self$clip) } + # Filter data to only those that are within the plot limits + if (neg) { + dat <- subset(dat, min_age < max(lims) & min_age > min(lims) | + max_age < max(lims) & max_age > min(lims)) + } else { + dat <- subset(dat, min_age > min(lims) & min_age < max(lims) | + max_age > min(lims) & max_age < max(lims)) + } + # Add labels if (lab) { + if (!is.null(lab_color)) { + dat$lab_color <- rep(lab_color, length.out = nrow(dat)) + } else if (!("lab_color" %in% colnames(dat))) { + dat$lab_color <- "black" + } + if (center_end_labels) { # center the labels for the time periods at the ends of the axis # find which intervals overlap with the ends of the axis @@ -437,6 +449,18 @@ make_geo_scale <- function(self, dat, fill, color, alpha, pos, # recalculate the mid ages dat$mid_age <- (dat$max_age + dat$min_age) / 2 } + if (abbrv == "auto") { + dat$label <- abbreviate(dat$name, minlength = 1, + use.classes = TRUE, named = FALSE) + } else if (abbrv && "abbr" %in% colnames(dat)) { + dat$label <- dat$abbr + dat$label[dat$abbr %in% skip] <- "" + } else { + dat$label <- dat$name + } + + dat$label[dat$name %in% skip] <- "" + if (size == "auto") { gg_scale <- gg_scale + exec(geom_fit_text, diff --git a/R/get_scale_data.R b/R/get_scale_data.R index e27405a..9cf0247 100644 --- a/R/get_scale_data.R +++ b/R/get_scale_data.R @@ -78,7 +78,7 @@ get_scale_data <- function(name, true_colors = TRUE) { no_abbr <- (is.na(clean_dat$abbr) | clean_dat$abbr == "") clean_dat$abbr[no_abbr] <- abbreviate(clean_dat$name, minlength = 1, - use.classes = FALSE, named = FALSE)[no_abbr] + use.classes = TRUE, named = FALSE)[no_abbr] dat <- clean_dat } dat diff --git a/man/coord_geo.Rd b/man/coord_geo.Rd index 86900b8..6621800 100644 --- a/man/coord_geo.Rd +++ b/man/coord_geo.Rd @@ -106,10 +106,17 @@ fonts that are guaranteed to work everywhere: “sans” (the default), be labeled. If \code{abbrv} is \code{TRUE}, this can also include interval abbreviations.} -\item{abbrv}{If including labels, whether to use abbreviations instead of -full interval names.} - -\item{neg}{Set this to true if your x-axis is using negative values.} +\item{abbrv}{If including labels, should the labels be abbreviated? If +\code{TRUE}, the \code{abbrev} column will be used for the labels. If \code{FALSE}, the +\code{name} column will be used for the labels. If \code{"auto"}, the \code{\link[=abbreviate]{abbreviate()}} +function will be used to abbreviate the values in the \code{name} column. Note +that the built-in data and data retrieved via \code{\link[=get_scale_data]{get_scale_data()}} already +have built-in abbreviations. However, using the \code{"auto"} option here will +create new unique abbreviations based on only the intervals that are being +plotted. In many cases, this may result in abbreviations that are shorter +in length because there are fewer similar interval names to abbreviate.} + +\item{neg}{Set this to \code{TRUE} if your x-axis is using negative values.} \item{center_end_labels}{Should labels be centered within the visible range of intervals at the ends of the axis?} diff --git a/tests/testthat/_snaps/coord_geo/geom-fit-text-new.svg b/tests/testthat/_snaps/coord_geo/geom-fit-text-new.svg index 9c8b46c..ca07915 100644 --- a/tests/testthat/_snaps/coord_geo/geom-fit-text-new.svg +++ b/tests/testthat/_snaps/coord_geo/geom-fit-text-new.svg @@ -103,17 +103,6 @@ Cretaceous Jurassic Triassic -Permian -Carboniferous -Devonian -Silurian -Ordovician -Cambrian -Ediacaran -Cryogenian -Tonian -Stenian -Ectasian diff --git a/tests/testthat/_snaps/coord_geo/scale-on-all-facets-new.svg b/tests/testthat/_snaps/coord_geo/scale-on-all-facets-new.svg index c88275f..2b825c3 100644 --- a/tests/testthat/_snaps/coord_geo/scale-on-all-facets-new.svg +++ b/tests/testthat/_snaps/coord_geo/scale-on-all-facets-new.svg @@ -147,17 +147,6 @@ K J Tr -P -C -D -S -O -Cm -E -Cr -T -St -Ec @@ -239,17 +228,6 @@ K J Tr -P -C -D -S -O -Cm -E -Cr -T -St -Ec @@ -331,17 +309,6 @@ K J Tr -P -C -D -S -O -Cm -E -Cr -T -St -Ec diff --git a/tests/testthat/_snaps/coord_geo/scale-on-fossil-ggtree-new.svg b/tests/testthat/_snaps/coord_geo/scale-on-fossil-ggtree-new.svg index a0467d8..7387d9e 100644 --- a/tests/testthat/_snaps/coord_geo/scale-on-fossil-ggtree-new.svg +++ b/tests/testthat/_snaps/coord_geo/scale-on-fossil-ggtree-new.svg @@ -284,38 +284,10 @@ -Holocene -Pleistocene -Pliocene -Miocene -Oligocene Eocene Late Cretaceous Early Cretaceous Late Jurassic -Early Jurassic -Late Triassic -Middle Triassic -Early Triassic -Lopingian -Guadalupian -Cisuralian -Pennsylvanian -Mississippian -Late Devonian -Middle Devonian -Early Devonian -Pridoli -Ludlow -Wenlock -Llandovery -Late Ordovician -Middle Ordovician -Early Ordovician -Furongian -Miaolingian -Series 2 -Terreneuvian @@ -370,19 +342,9 @@ -Quaternary -Neogene Paleogene Cretaceous Jurassic -Triassic -Permian -Carboniferous -Devonian -Silurian -Ordovician -Cambrian -Ediacaran diff --git a/tests/testthat/_snaps/coord_geo/scale-on-ggtree-new.svg b/tests/testthat/_snaps/coord_geo/scale-on-ggtree-new.svg index a37ac01..ff2ea5c 100644 --- a/tests/testthat/_snaps/coord_geo/scale-on-ggtree-new.svg +++ b/tests/testthat/_snaps/coord_geo/scale-on-ggtree-new.svg @@ -259,10 +259,6 @@ Neogene Paleogene Cretaceous -Jurassic -Triassic -Permian -Carboniferous diff --git a/tests/testthat/_snaps/coord_geo/scale-on-only-one-facet-new.svg b/tests/testthat/_snaps/coord_geo/scale-on-only-one-facet-new.svg index 054c20c..cb9ab13 100644 --- a/tests/testthat/_snaps/coord_geo/scale-on-only-one-facet-new.svg +++ b/tests/testthat/_snaps/coord_geo/scale-on-only-one-facet-new.svg @@ -147,17 +147,6 @@ K J Tr -P -C -D -S -O -Cm -E -Cr -T -St -Ec diff --git a/tests/testthat/_snaps/coord_geo/scales-on-different-sides1-new.svg b/tests/testthat/_snaps/coord_geo/scales-on-different-sides1-new.svg index 32bbf79..90b9cff 100644 --- a/tests/testthat/_snaps/coord_geo/scales-on-different-sides1-new.svg +++ b/tests/testthat/_snaps/coord_geo/scales-on-different-sides1-new.svg @@ -152,34 +152,6 @@ C2 C2A C3 -C3A -C3B -C4 -C4A -C5 -C5A -C5AA -C5AB -C5AC -C5AD -C5B -C5C -C5D -C5E -C6 -C6A -C6AA -C6B -C6C -C7 -C7A -C8 -C9 -C10 -C11 -C12 -C13 -C15 @@ -291,29 +263,6 @@ PL3 PL2 PL1 -M14 -M13 -M12 -M11 -M10 -M9 -M8 -M7 -M6 -M5 -M4 -M3 -M2 -M1 -O7 -O6 -O5 -O4 -O3 -O2 -O1 -E16 -E15 diff --git a/tests/testthat/_snaps/coord_geo/scales-on-different-sides2-new.svg b/tests/testthat/_snaps/coord_geo/scales-on-different-sides2-new.svg index ea89b73..0e04073 100644 --- a/tests/testthat/_snaps/coord_geo/scales-on-different-sides2-new.svg +++ b/tests/testthat/_snaps/coord_geo/scales-on-different-sides2-new.svg @@ -137,30 +137,6 @@ C2 C2A C3 -C3A -C3B -C4 -C4A -C5 -C5A -C5AA -C5AB -C5AC -C5AD -C5B -C5C -C5D -C5E -C6 -C6A -C6AA -C6B -C6C -C7 -C7A -C8 -C9 -C10 @@ -265,24 +241,6 @@ PL3 PL2 PL1 -M14 -M13 -M12 -M11 -M10 -M9 -M8 -M7 -M6 -M5 -M4 -M3 -M2 -M1 -O7 -O6 -O5 -O4 diff --git a/tests/testthat/_snaps/coord_geo/stacked-scales-new.svg b/tests/testthat/_snaps/coord_geo/stacked-scales-new.svg index 206f6d8..10ef0a3 100644 --- a/tests/testthat/_snaps/coord_geo/stacked-scales-new.svg +++ b/tests/testthat/_snaps/coord_geo/stacked-scales-new.svg @@ -103,17 +103,6 @@ K J Tr -P -C -D -S -O -Cm -E -Cr -T -St -Ec @@ -143,9 +132,6 @@ Cenozoic Mesozoic -Paleozoic -Neoproterozoic -Mesoproterozoic diff --git a/tests/testthat/_snaps/ggarrange2/double-ggarrange2-new.svg b/tests/testthat/_snaps/ggarrange2/double-ggarrange2-new.svg index 88e7384..5bfb4f1 100644 --- a/tests/testthat/_snaps/ggarrange2/double-ggarrange2-new.svg +++ b/tests/testthat/_snaps/ggarrange2/double-ggarrange2-new.svg @@ -2359,23 +2359,12 @@ -Neogene -Paleogene Cretaceous Jurassic Triassic Permian Carboniferous Devonian -Silurian -Ordovician -Cambrian -Ediacaran -Cryogenian -Tonian -Stenian -Ectasian -Calymmian diff --git a/tests/testthat/_snaps/scales/scale-color-geo-new.svg b/tests/testthat/_snaps/scales/scale-color-geo-new.svg index a0cb4c1..2ee5934 100644 --- a/tests/testthat/_snaps/scales/scale-color-geo-new.svg +++ b/tests/testthat/_snaps/scales/scale-color-geo-new.svg @@ -1127,13 +1127,6 @@ E Cr T -St -Ec -Ca -St -Or -R -Sd diff --git a/tests/testthat/_snaps/scales/scale-discrete-geo-new.svg b/tests/testthat/_snaps/scales/scale-discrete-geo-new.svg index 4504674..440e99b 100644 --- a/tests/testthat/_snaps/scales/scale-discrete-geo-new.svg +++ b/tests/testthat/_snaps/scales/scale-discrete-geo-new.svg @@ -1127,13 +1127,6 @@ E Cr T -St -Ec -Ca -St -Or -R -Sd