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

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
  },