Copy angle heuristic for more guides. (#5957)

* generalise angle heuristic

* apply heuristic

* parameter plumbing

* document

* add news bullet

* digusting simplification

* add comments for future generations

* accept phase-shift in angles

Author: teunbrand

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `guide_bins()`, `guide_colourbar()` and `guide_coloursteps()` gain an `angle`
+  argument to overrule theme settings, similar to `guide_axis(angle)` 
+  (@teunbrand, #4594).
 * `coord_*(expand)` can now take a logical vector to control expansion at any
   side of the panel (top, right, bottom, left) (@teunbrand, #6020)
 * (Breaking) The defaults for all geoms can be set at one in the theme. 
@@ -24,7 +27,7 @@
   class through new `Coord$draw_panel()` method.
 * `theme(strip.clip)` now defaults to `"on"` and is independent of Coord 
   clipping (@teunbrand, 5952).
-* (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand).
+* (internal) rearranged the code of `Facet$draw_panels()` method (@teunbrand).
 * Axis labels are now justified across facet panels (@teunbrand, #5820)
 * Fixed bug in `stat_function()` so x-axis title now produced automatically 
   when no data added. (@phispu, #5647).

R/guide-axis.R

@@ -254,21 +254,8 @@ GuideAxis <- ggproto(
   },
 
   override_elements = function(params, elements, theme) {
-    label <- elements$text
-    if (!inherits(label, "element_text")) {
-      return(elements)
-    }
-    label_overrides <- axis_label_element_overrides(
-      params$position, params$angle
-    )
-    # label_overrides is an element_text, but label_element may not be;
-    # to merge the two elements, we just copy angle, hjust, and vjust
-    # unless their values are NULL
-    label$angle <- label_overrides$angle %||% label$angle
-    label$hjust <- label_overrides$hjust %||% label$hjust
-    label$vjust <- label_overrides$vjust %||% label$vjust
-
-    elements$text <- label
+    elements$text <-
+      label_angle_heuristic(elements$text, params$position, params$angle)
     return(elements)
   },
 
@@ -584,49 +571,40 @@ axis_label_priority_between <- function(x, y) {
   )
 }
 
-#' Override axis text angle and alignment
+#' Override text angle and alignment
 #'
+#' @param element An `element_text()`
 #' @param axis_position One of bottom, left, top, or right
 #' @param angle The text angle, or NULL to override nothing
 #'
 #' @return An [element_text()] that contains parameters that should be
 #'   overridden from the user- or theme-supplied element.
 #' @noRd
-#'
-axis_label_element_overrides <- function(axis_position, angle = NULL) {
-
-  if (is.null(angle) || is.waive(angle)) {
-    return(element_text(angle = NULL, hjust = NULL, vjust = NULL))
+label_angle_heuristic <- function(element, position, angle) {
+  if (!inherits(element, "element_text")
+      || is.null(position)
+      || is.null(angle %|W|% NULL)) {
+    return(element)
   }
+  arg_match0(position, .trbl)
 
   check_number_decimal(angle)
-  angle <- angle %% 360
-  arg_match0(
-    axis_position,
-    c("bottom", "left", "top", "right")
-  )
-
-  if (axis_position == "bottom") {
-
-    hjust <- if (angle %in% c(0, 180))  0.5 else if (angle < 180) 1 else 0
-    vjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1
-
-  } else if (axis_position == "left") {
-
-    hjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1
-    vjust <- if (angle %in% c(0, 180))  0.5 else if (angle < 180) 0 else 1
-
-  } else if (axis_position == "top") {
-
-    hjust <- if (angle %in% c(0, 180))  0.5 else if (angle < 180) 0 else 1
-    vjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0
-
-  } else if (axis_position == "right") {
-
-    hjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0
-    vjust <- if (angle %in% c(0, 180))  0.5 else if (angle < 180) 1 else 0
-
-  }
-
-  element_text(angle = angle, hjust = hjust, vjust = vjust)
+  radian <- deg2rad(angle)
+  digits <- 3
+
+  # Taking the sign of the (co)sine snaps the value to c(-1, 0, 1)
+  # Doing `x / 2 + 0.5` rescales it to c(0, 0.5, 1), which are good values for justification
+  # The rounding step ensures we can get (co)sine to exact 0 so it can become 0.5
+  # which we need for center-justifications
+  cosine <- sign(round(cos(radian), digits)) / 2 + 0.5
+  sine   <- sign(round(sin(radian), digits)) / 2 + 0.5
+
+  # Depending on position, we might need to swap or flip justification values
+  hjust <- switch(position, left = cosine, right = 1 - cosine, top = 1 - sine, sine)
+  vjust <- switch(position, left = 1 - sine, right = sine, top = 1 - cosine, cosine)
+
+  element$angle <- angle %||% element$angle
+  element$hjust <- hjust %||% element$hjust
+  element$vjust <- vjust %||% element$vjust
+  element
 }

R/guide-bins.R

@@ -11,6 +11,10 @@ NULL
 #' guide if they are mapped in the same way.
 #'
 #' @inheritParams guide_legend
+#' @param angle Overrules the theme settings to automatically apply appropriate
+#'   `hjust` and `vjust` for angled legend text. Can be a single number
+#'   representing the text angle in degrees, or `NULL` to not overrule the
+#'   settings (default).
 #' @param show.limits Logical. Should the limits of the scale be shown with
 #'   labels and ticks. Default is `NULL` meaning it will take the value from the
 #'   scale. This argument is ignored if `labels` is given as a vector of
@@ -65,6 +69,7 @@ guide_bins <- function(
   theme = NULL,
 
   # general
+  angle        = NULL,
   position     = NULL,
   direction    = NULL,
   override.aes = list(),
@@ -85,6 +90,7 @@ guide_bins <- function(
     theme = theme,
 
     # general
+    angle = angle,
     position = position,
     direction = direction,
     override.aes = rename_aes(override.aes),
@@ -115,6 +121,7 @@ GuideBins <- ggproto(
     default_axis = element_line("black", linewidth = (0.5 / .pt)),
     default_ticks = element_line(inherit.blank = TRUE),
 
+    angle = NULL,
     direction = NULL,
     override.aes = list(),
     reverse = FALSE,

R/guide-colorbar.R

@@ -32,6 +32,10 @@ NULL
 #' @param alpha A numeric between 0 and 1 setting the colour transparency of
 #'   the bar. Use `NA` to preserve the alpha encoded in the colour itself
 #'   (default).
+#' @param angle Overrules the theme settings to automatically apply appropriate
+#'   `hjust` and `vjust` for angled legend text. Can be a single number
+#'   representing the text angle in degrees, or `NULL` to not overrule the
+#'   settings (default).
 #' @param draw.ulim A logical specifying if the upper limit tick marks should
 #'   be visible.
 #' @param draw.llim A logical specifying if the lower limit tick marks should
@@ -124,6 +128,7 @@ guide_colourbar <- function(
   alpha = NA,
   draw.ulim = TRUE,
   draw.llim = TRUE,
+  angle = NULL,
   position = NULL,
   direction = NULL,
   reverse = FALSE,
@@ -151,6 +156,7 @@ guide_colourbar <- function(
     nbin = nbin,
     display = display,
     alpha = alpha,
+    angle = angle,
     draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)),
     position = position,
     direction = direction,
@@ -193,6 +199,7 @@ GuideColourbar <- ggproto(
     direction = NULL,
     reverse = FALSE,
     order = 0,
+    angle = NULL,
 
     # parameter
     name = "colourbar",

R/guide-colorsteps.R

@@ -49,6 +49,7 @@ guide_coloursteps <- function(
   title = waiver(),
   theme = NULL,
   alpha = NA,
+  angle = NULL,
   even.steps  = TRUE,
   show.limits = NULL,
   direction = NULL,
@@ -66,6 +67,7 @@ guide_coloursteps <- function(
     title = title,
     theme = theme,
     alpha = alpha,
+    angle = angle,
     even.steps  = even.steps,
     show.limits = show.limits,
     position = position,

R/guide-legend.R

@@ -374,6 +374,9 @@ GuideLegend <- ggproto(
         ggname("legend.key", element_grob(elements$key))
     }
 
+    elements$text <-
+      label_angle_heuristic(elements$text, elements$text_position, params$angle)
+
     elements
   },