Merge branch 'main' into attr_stability

Author: teunbrand

NAMESPACE

@@ -721,6 +721,7 @@ export(theme_minimal)
 export(theme_replace)
 export(theme_set)
 export(theme_test)
+export(theme_transparent)
 export(theme_update)
 export(theme_void)
 export(transform_position)

NEWS.md

@@ -2,6 +2,11 @@
 
 * (internal) layer data can be attenuated with parameter attributes 
   (@teunbrand, #3175).
+* New argument `labs(dictionary)` to label based on variable name rather than 
+  based on aesthetic (@teunbrand, #5178)
+* Fixed bug in out-of-bounds binned breaks (@teunbrand, #6054)
+* Binned guides now accept expressions as labels (@teunbrand, #6005)
+* (internal) `Scale$get_labels()` format expressions as lists.
 * In non-orthogonal coordinate systems (`coord_sf()`, `coord_polar()` and 
   `coord_radial()`), using 'AsIs' variables escape transformation when
   both `x` and `y` is an 'AsIs' variable (@teunbrand, #6205).
@@ -214,6 +219,12 @@
 * `stat_summary_bin()` no longer ignores `width` parameter (@teunbrand, #4647).
 * Added `keep.zeroes` argument to `stat_bin()` (@teunbrand, #3449)
 * `coord_sf()` no longer errors when dealing with empty graticules (@teunbrand, #6052)
+* Added `theme_transparent()` with transparent backgrounds (@topepo).
+* New theme elements `palette.{aes}.discrete` and `palette.{aes}.continuous`. 
+  Theme palettes replace palettes in scales where `palette = NULL`, which is 
+  the new default in many scales (@teunbrand, #4696).
+* `guide_axis()` no longer reserves space for blank ticks 
+  (@teunbrand, #4722, #6069).
 
 # ggplot2 3.5.1
 

R/geom-text.R

@@ -95,7 +95,7 @@
 #' # Add aesthetic mappings
 #' p + geom_text(aes(colour = factor(cyl)))
 #' p + geom_text(aes(colour = factor(cyl))) +
-#'   scale_colour_discrete(l = 40)
+#'   scale_colour_hue(l = 40)
 #' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold")
 #'
 #' # Scale size of text, and change legend key glyph from a to point

R/guide-.R

@@ -225,13 +225,8 @@ Guide <- ggproto(
 
     mapped <- scale$map(breaks)
     labels <- scale$get_labels(breaks)
-    # {vctrs} doesn't play nice with expressions, convert to list.
-    # see also https://github.com/r-lib/vctrs/issues/559
-    if (is.expression(labels)) {
-      labels <- as.list(labels)
-    }
 
-    key <- data_frame(mapped, .name_repair = ~ aesthetic)
+    key <- data_frame(!!aesthetic := mapped)
     key$.value <- breaks
     key$.label <- labels
 

R/guide-axis-theta.R

@@ -110,7 +110,7 @@ GuideAxisTheta <- ggproto(
       # labels of these positions
       ends_apart <- (key$theta[n] - key$theta[1]) %% (2 * pi)
       if (n > 0 && ends_apart < 0.05 && !is.null(key$.label)) {
-        if (is.expression(key$.label)) {
+        if (is.expression(key$.label[[1]])) {
           combined <- substitute(
             paste(a, "/", b),
             list(a = key$.label[[1]], b = key$.label[[n]])

R/guide-axis.R

@@ -256,6 +256,12 @@ GuideAxis <- ggproto(
   override_elements = function(params, elements, theme) {
     elements$text <-
       label_angle_heuristic(elements$text, params$position, params$angle)
+    if (inherits(elements$ticks, "element_blank")) {
+      elements$major_length <- unit(0, "cm")
+    }
+    if (inherits(elements$minor, "element_blank") || isFALSE(params$minor.ticks)) {
+      elements$minor_length <- unit(0, "cm")
+    }
     return(elements)
   },
 

R/guide-bins.R

@@ -161,7 +161,10 @@ GuideBins <- ggproto(
     key$.show  <- NA
 
     labels <- scale$get_labels(breaks)
-    if (is.character(scale$labels) || is.numeric(scale$labels)) {
+    labels <- labels[!is.na(breaks)]
+    breaks <- breaks[!is.na(breaks)]
+
+    if (is.character(scale$labels) || is.numeric(scale$labels) || is.expression(scale$labels)) {
       limit_lab <- c(NA, NA)
     } else {
       limit_lab <- scale$get_labels(limits)
@@ -265,7 +268,7 @@ GuideBins <- ggproto(
 
     list(labels = flip_element_grob(
       elements$text,
-      label = key$.label,
+      label = validate_labels(key$.label),
       x = unit(key$.value, "npc"),
       margin_x = FALSE,
       margin_y = TRUE,
@@ -335,19 +338,22 @@ GuideBins <- ggproto(
 
 parse_binned_breaks <- function(scale, breaks = scale$get_breaks()) {
 
-  breaks <- breaks[!is.na(breaks)]
+  if (is.waiver(scale$labels) || is.function(scale$labels)) {
+    breaks <- breaks[!is.na(breaks)]
+  }
   if (length(breaks) == 0) {
     return(NULL)
   }
 
   if (is.numeric(breaks)) {
-    breaks <- sort(breaks)
     limits <- scale$get_limits()
     if (!is.numeric(scale$breaks)) {
-      breaks <- breaks[!breaks %in% limits]
+      breaks[breaks %in% limits] <- NA
     }
-    breaks <- oob_discard(breaks, limits)
+    breaks <- oob_censor(breaks, limits)
     all_breaks <- unique0(c(limits[1], breaks, limits[2]))
+    # Sorting drops NAs on purpose here
+    all_breaks <- sort(all_breaks, na.last = NA)
     bin_at <- all_breaks[-1] - diff(all_breaks) / 2
   } else {
     bin_at <- breaks

R/guide-colorsteps.R

@@ -112,11 +112,13 @@ GuideColoursteps <- ggproto(
 
     key <- data_frame0(!!aesthetic := scale$map(breaks))
     if (even.steps) {
-      key$.value <- seq_along(breaks)
+      key$.value <- NA_integer_
+      key$.value[!is.na(breaks)] <- seq_along(breaks[!is.na(breaks)])
     } else {
       key$.value <- breaks
     }
     key$.label <- scale$get_labels(breaks)
+    key <- vec_slice(key, !is.na(breaks))
 
     if (breaks[1] %in% limits) {
       key$.value  <- key$.value - 1L

R/labels.R

@@ -84,6 +84,15 @@ setup_plot_labels <- function(plot, layers, data) {
     ))
   }
 
+  dict <- plot_labels$dictionary
+  if (length(dict) > 0) {
+    labels <- lapply(labels, function(x) {
+      dict <- dict[names(dict) %in% x]
+      x[match(names(dict), x)] <- dict
+      x
+    })
+  }
+
   defaults(plot_labels, labels)
 }
 
@@ -114,6 +123,10 @@ setup_plot_labels <- function(plot, layers, data) {
 #'        bottom-right of the plot by default.
 #' @param tag The text for the tag label which will be displayed at the
 #'        top-left of the plot by default.
+#' @param dictionary A named character vector to serve as dictionary.
+#'        Automatically derived labels, such as those based on variables will
+#'        be matched with `names(dictionary)` and replaced by the matching
+#'        entry in `dictionary`.
 #' @param alt,alt_insight Text used for the generation of alt-text for the plot.
 #'        See [get_alt_text] for examples. `alt` can also be a function that
 #'        takes the plot as input and returns text as output. `alt` also accepts
@@ -128,6 +141,14 @@ setup_plot_labels <- function(plot, layers, data) {
 #' p + labs(colour = "Cylinders")
 #' p + labs(x = "New x label")
 #'
+#' # Set labels by variable name instead of aesthetic
+#' p + labs(dict = c(
+#'   disp = "Displacment", # Not in use
+#'   cyl  = "Number of cylinders",
+#'   mpg  = "Miles per gallon",
+#'   wt   = "Weight (1000 lbs)"
+#' ))
+#'
 #' # The plot title appears at the top-left, with the subtitle
 #' # display in smaller text underneath it
 #' p + labs(title = "New plot title")
@@ -146,11 +167,12 @@ setup_plot_labels <- function(plot, layers, data) {
 #'  labs(title = "title") +
 #'  labs(title = NULL)
 labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(),
-                 tag = waiver(), alt = waiver(), alt_insight = waiver()) {
+                 tag = waiver(), dictionary = waiver(), alt = waiver(),
+                 alt_insight = waiver()) {
   # .ignore_empty = "all" is needed to allow trailing commas, which is NOT a trailing comma for dots_list() as it's in ...
   args <- dots_list(..., title = title, subtitle = subtitle, caption = caption,
     tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight,
-    .ignore_empty = "all")
+    dictionary = dictionary, .ignore_empty = "all")
 
   is_waive <- vapply(args, is.waiver, logical(1))
   args <- args[!is_waive]

R/plot-build.R

@@ -106,6 +106,7 @@ ggplot_build.ggplot <- function(plot) {
   # Train and map non-position scales and guides
   npscales <- scales$non_position_scales()
   if (npscales$n() > 0) {
+    npscales$set_palettes(plot$theme)
     lapply(data, npscales$train_df)
     plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data, plot$theme)
     data <- lapply(data, npscales$map_df)