Long legend title justification (#5570)

* justify titles when larger than legend

* add test

* add news bullet

* apply logical to `guide_custom` too

Author: teunbrand

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* When legend titles are larger than the legend, title justification extends
+  to the placement of keys and labels (#1903).
+
 * `draw_key_label()` now better reflects the appearance of labels.
 
 * The `minor_breaks` function argument in scales can now take a function with

R/guide-custom.R

@@ -124,11 +124,17 @@ GuideCustom <- ggproto(
       title.position <- "none"
     }
 
-    width  <- convertWidth(params$width, "cm")
-    height <- convertHeight(params$height, "cm")
-    gt <- gtable(widths = width, heights = height)
+    width  <- convertWidth(params$width, "cm", valueOnly = TRUE)
+    height <- convertHeight(params$height, "cm", valueOnly = TRUE)
+    gt <- gtable(widths = unit(width, "cm"), heights = unit(height, "cm"))
     gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1, clip = "off")
 
+    extra_width  <- max(0, width_cm(title) - width)
+    extra_height <- max(0, height_cm(title) - height)
+    just <- with(elems$title, rotate_just(angle, hjust, vjust))
+    hjust <- just$hjust
+    vjust <- just$vjust
+
     if (params$title.position == "top") {
       gt <- gtable_add_rows(gt, elems$margin[1], pos = 0)
       gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = 0)
@@ -146,6 +152,14 @@ GuideCustom <- ggproto(
       gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0)
       gt <- gtable_add_grob(gt, title, t = 1, l = -1, name = "title", clip = "off")
     }
+    if (params$title.position %in% c("top", "bottom")) {
+      gt <- gtable_add_cols(gt, unit(extra_width * hjust, "cm"), pos = 0)
+      gt <- gtable_add_cols(gt, unit(extra_width * (1 - hjust), "cm"), pos = -1)
+    } else {
+      gt <- gtable_add_rows(gt, unit(extra_height * (1 - vjust), "cm"), pos = 0)
+      gt <- gtable_add_rows(gt, unit(extra_height * vjust, "cm"), pos = -1)
+    }
+
     gt <- gtable_add_padding(gt, elems$margin)
 
     background <- element_grob(elems$background)

R/guide-legend.R

@@ -603,19 +603,24 @@ GuideLegend <- ggproto(
       # Measure title
       title_width  <- width_cm(grobs$title)
       title_height <- height_cm(grobs$title)
+      extra_width  <- max(0, title_width  - sum(widths))
+      extra_height <- max(0, title_height - sum(heights))
+      just  <- with(elements$title, rotate_just(angle, hjust, vjust))
+      hjust <- just$hjust
+      vjust <- just$vjust
 
       # Combine title with rest of the sizes based on its position
       widths <- switch(
         params$title.position,
         "left"  = c(title_width, widths),
         "right" = c(widths, title_width),
-        c(widths, max(0, title_width - sum(widths)))
+        c(extra_width * hjust, widths, extra_width * (1 - hjust))
       )
       heights <- switch(
         params$title.position,
         "top"    = c(title_height, heights),
         "bottom" = c(heights, title_height),
-        c(heights, max(0, title_height - sum(heights)))
+        c(extra_height * (1 - vjust), heights, extra_height * vjust)
       )
     }
 
@@ -670,29 +675,19 @@ GuideLegend <- ggproto(
 
     # Offset layout based on title position
     if (sizes$has_title) {
-      switch(
-        params$title.position,
-        "top" = {
-          key_row   <- key_row   + 1
-          label_row <- label_row + 1
-          title_row <- 2
-          title_col <- seq_along(sizes$widths) + 1
-        },
-        "bottom" = {
-          title_row <- length(sizes$heights)   + 1
-          title_col <- seq_along(sizes$widths) + 1
-        },
-        "left" = {
-          key_col   <- key_col   + 1
-          label_col <- label_col + 1
-          title_row <- seq_along(sizes$heights) + 1
-          title_col <- 2
-        },
-        "right" = {
-          title_row <- seq_along(sizes$heights) + 1
-          title_col <- length(sizes$widths)     + 1
-        }
-      )
+      position  <- params$title.position
+      if (position != "right") {
+        key_col   <- key_col   + 1
+        label_col <- label_col + 1
+      }
+      if (position != "bottom") {
+        key_row   <- key_row   + 1
+        label_row <- label_row + 1
+      }
+      nrow <- length(sizes$heights)
+      ncol <- length(sizes$widths)
+      title_row <- switch(position, top  = 1, bottom = nrow, seq_len(nrow)) + 1
+      title_col <- switch(position, left = 1, right  = ncol, seq_len(ncol)) + 1
     } else {
       title_row <- NA
       title_col <- NA

tests/testthat/_snaps/guides/legends-with-all-title-justifications.svg

@@ -831,6 +831,22 @@ test_that("guides title and text are positioned correctly", {
     )
 
   expect_doppelganger("rotated guide titles and labels", p )
+
+  # title justification
+  p <- ggplot(data.frame(x = 1:2)) +
+    aes(x, x, colour = factor(x), fill = factor(x), shape = factor(x), alpha = x) +
+    geom_point() +
+    scale_alpha(breaks = 1:2) +
+    guides(
+      colour = guide_legend("colour title with hjust = 0", title.hjust = 0, order = 1),
+      fill   = guide_legend("fill title with hjust = 1",   title.hjust = 1, order = 2,
+                            title.position = "bottom", override.aes = list(shape = 21)),
+      alpha  = guide_legend("Title\nfor\nalpha\nwith\nvjust=0", title.vjust = 0,
+                            title.position = "left", order = 3),
+      shape = guide_legend("Title\nfor\nshape\nwith\nvjust=1", title.vjust = 1,
+                           title.position = "right", order = 4)
+    )
+  expect_doppelganger("legends with all title justifications", p)
 })
 
 test_that("size and linewidth affect key size", {