Issue #303 margin adjustment for multi-line labels and titles

R/facet.R

@@ -31,8 +31,12 @@ draw_facet_window = function(
     draw,
     grid,
     has_legend,
+    main,
+    sub,
     type,
+    xlab,
     x, xmax, xmin,
+    ylab,
     y, ymax, ymin,
     tpars = NULL
     ) {
@@ -155,6 +159,20 @@ draw_facet_window = function(
           fmar[1] = fmar[1] - (whtsbp * cex_fct_adj)
         }
       }
+
+      # Adjust margins for missing and multi-line annotation strings.
+      xlab_lines = text_line_count(xlab)
+      ylab_lines = text_line_count(ylab)
+      main_lines = text_line_count(main)
+
+      if (xlab_lines == 0) omar[1] = omar[1] - 1
+      if (ylab_lines == 0) omar[2] = omar[2] - 1
+      if (main_lines == 0) omar[3] = omar[3] - 1
+
+      if (xlab_lines > 1) omar[1] = omar[1] + (xlab_lines - 1) * get_tpar(c("cex.xlab", "cex.lab"), tpar_list = tpars)
+      if (ylab_lines > 1) omar[2] = omar[2] + (ylab_lines - 1) * get_tpar(c("cex.ylab", "cex.lab"), tpar_list = tpars)
+      if (main_lines > 1) omar[3] = omar[3] + (main_lines - 1) * get_tpar("cex.main", tpar_list = tpars)
+
       # FIXME: Is this causing issues for lhs legends with facet_grid?
       # catch for missing rhs legend
       if (isTRUE(attr(facet, "facet_grid")) && !has_legend) {
@@ -218,6 +236,20 @@ draw_facet_window = function(
         omar[1] = omar[1] + whtsbp
       }
     }
+
+    # Adjust margins for missing and multi-line annotation strings.
+    xlab_lines = text_line_count(xlab)
+    ylab_lines = text_line_count(ylab)
+    main_lines = text_line_count(main)
+
+    if (xlab_lines == 0) omar[1] = omar[1] - 1
+    if (ylab_lines == 0) omar[2] = omar[2] - 1
+    if (main_lines == 0) omar[3] = omar[3] - 1
+
+    if (xlab_lines > 1) omar[1] = omar[1] + (xlab_lines - 1) * get_tpar(c("cex.xlab", "cex.lab"), tpar_list = tpars)
+    if (ylab_lines > 1) omar[2] = omar[2] + (ylab_lines - 1) * get_tpar(c("cex.ylab", "cex.lab"), tpar_list = tpars)
+    if (main_lines > 1) omar[3] = omar[3] + (main_lines - 1) * get_tpar("cex.main", tpar_list = tpars)
+
      par(mar = omar)
   }
 

R/legend.R

@@ -124,7 +124,7 @@ legend_outer_margins = function(legend_env, apply = TRUE) {
       if (legend_env$dynmar) {
         omar = par("mar")
         if (legend_env$outer_bottom) {
-          omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab")
+          omar[1] = theme_dynamic$mgp[1] + 1 * par("cex.lab")
           if (legend_env$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) {
             omar[1] = omar[1] + 1 * par("cex.sub")
           }
@@ -407,7 +407,7 @@ prepare_legend = function(settings) {
   }
 
   legend_draw_flag = (is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !isTRUE(add)
-  has_sub = !is.null(sub)
+  has_sub = text_line_count(sub) > 0L
 
   # Generate labels for discrete legends
   if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || multi_legend)) {

R/tinyplot.R

@@ -1051,8 +1051,12 @@ tinyplot.default = function(
       draw = draw,
       grid = grid,
       has_legend = has_legend,
+      main = main,
+      sub = sub,
       type = type,
+      xlab = xlab,
       x = x, xmax = xmax, xmin = xmin,
+      ylab = ylab,
       y = y, ymax = ymax, ymin = ymin,
       tpars = tpars
     ),
@@ -1075,16 +1079,19 @@ tinyplot.default = function(
       draw = draw,
       grid = grid,
       has_legend = has_legend,
+      main = main,
+      sub = sub,
       type = type,
+      xlab = xlab,
       x = datapoints$x, xmax = datapoints$xmax, xmin = datapoints$xmin,
+      ylab = ylab,
       y = datapoints$y, ymax = datapoints$ymax, ymin = datapoints$ymin,
       tpars = tpar() # https://github.com/grantmcdermott/tinyplot/issues/474
     ),
     getNamespace("tinyplot")
   )
   list2env(facet_window_args, environment())
 
-
   #
   ## split and draw datapoints -----
   #

R/tinytheme.R

@@ -16,12 +16,13 @@
 #'   
 #'   - `"default"`: inherits the user's default base graphics settings.
 #'   - `"basic"`: light modification of `"default"`, only adding filled points, a panel background grid, and light gray background to facet titles.
-#'   - `"clean"` (*): builds on `"basic"` by moving the subtitle above the plotting area, adding horizontal axis labels, employing tighter default plot margins and title gaps to reduce whitespace, and setting different default palettes ("Tableau 10" for discrete colors and "agSunset" for gradient colors). The first of our dynamic themes and the foundation for several derivative themes that follow below.
+#'   - `"dynamic"` (*): builds on `"basic"` by enabling dynamic margin adjustment with tighter default margins, horizontal axis labels, and the subtitle moved above the plotting area. Turns off the panel grid. Provides the foundation for all other dynamic themes and is a good starting point for users who wish to build custom dynamic themes.
+#'   - `"clean"` (*): builds on `"dynamic"` by re-enabling the panel background grid and setting different default palettes ("Tableau 10" for discrete colors and "agSunset" for gradient colors).
 #'   - `"clean2"` (*): removes the plot frame (box) from `"clean"`.
-#'   - `"classic"` (*): connects the axes in a L-shape, but removes the other top and right-hand edges of the plot frame (box). Also sets the "Okabe-Ito" palette as a default for discrete colors. Inspired by the **ggplot2** theme of the same name. 
-#'   - `"bw"` (*): similar to `"clean"`, except uses thinner lines for the plot frame (box), solid grid lines, and sets the "Okabe-Ito" palette as a default for discrete colors. Inspired by the **ggplot2** theme of the same name. 
-#'   - `"minimal"` (*): removes the plot frame (box) from `"bw"`, as well as the background for facet titles. Inspired by the **ggplot2** theme of the same name. 
-#'   - `"ipsum"` (*): similar to `"minimal"`, except subtitle is italicised and axes titles are aligned to the far edges. Inspired by the **hrbrthemes** theme of the same name for **ggplot2**. 
+#'   - `"classic"` (*): builds on `"dynamic"` with L-shaped axes (removing the top and right-hand edges of the plot frame). Also sets the "Okabe-Ito" palette as a default for discrete colors. Inspired by the **ggplot2** theme of the same name.
+#'   - `"bw"` (*): similar to `"clean"`, except uses thinner lines for the plot frame (box), solid grid lines, and sets the "Okabe-Ito" palette as a default for discrete colors. Inspired by the **ggplot2** theme of the same name.
+#'   - `"minimal"` (*): removes the plot frame (box) from `"bw"`, as well as the background for facet titles. Inspired by the **ggplot2** theme of the same name.
+#'   - `"ipsum"` (*): similar to `"minimal"`, except subtitle is italicised and axes titles are aligned to the far edges. Inspired by the **hrbrthemes** theme of the same name for **ggplot2**.
 #'   - `"dark"` (*): similar to `"minimal"`, but set against a dark background with foreground and a palette colours lightened for appropriate contrast.
 #'   - `"ridge"` (*): a specialized theme for ridge plots (see [`type_ridge()`]). Builds off of `"clean"`, but adds ridge-specific tweaks (e.g. default "Zissou 1" palette for discrete colors, solid horizontal grid lines, and minor adjustments to y-axis labels). Not recommended for non-ridge plots.
 #'   - `"ridge2"` (*): removes the plot frame (box) from `"ridge"`, but retains the x-axis line. Again, not recommended for non-ridge plots.
@@ -49,8 +50,6 @@
 #' Known current limitations include:
 #' 
 #' - Themes do not work well when `legend = "top!"`.
-#' - Dynamic margin spacing does not account for multi-line strings (e.g., axes
-#' or main titles that contain "\\n").
 #'
 #' @return The function returns nothing. It is called for its side effects.
 #' 
@@ -119,7 +118,7 @@
 #' @export
 tinytheme = function(
     theme = c(
-      "default", "basic",
+      "default", "basic", "dynamic",
       "clean", "clean2", "bw", "classic",
       "minimal", "ipsum", "dark",
       "ridge", "ridge2",
@@ -138,8 +137,8 @@ tinytheme = function(
     theme,
     c(
       "default",
-      sort(c("basic", "bw", "classic", "clean", "clean2", "dark", "ipsum",
-             "minimal", "ridge", "ridge2", "tufte", "void"))
+      sort(c("basic", "bw", "classic", "clean", "clean2", "dark", "dynamic",
+             "ipsum", "minimal", "ridge", "ridge2", "tufte", "void"))
     )
   )
 
@@ -151,6 +150,7 @@ tinytheme = function(
     "clean" = theme_clean,
     "clean2" = theme_clean2,
     "dark" = theme_dark,
+    "dynamic" = theme_dynamic,
     "ipsum" = theme_ipsum,
     "minimal" = theme_minimal,
     "ridge" = theme_ridge,
@@ -273,10 +273,10 @@ theme_void = modifyList(theme_default, list(
   yaxt = "none"
 ))
 
-# derivatives of "basic" 
-# - clean
+# derivatives of "basic"
+# - dynamic
 
-theme_clean = modifyList(theme_basic, list(
+theme_dynamic = modifyList(theme_basic, list(
   ## Notes:
   ##  - 1. Reduce axis title gap by 0.5 lines and also reduce tcl to 0.3 lines.
   ##  - 2. Sub moves to top.
@@ -289,40 +289,48 @@ theme_clean = modifyList(theme_basic, list(
   ##    -- mar[3] should remain unchanged (main + sub will adjust automatically)
   ##    -- mar[4] should be adjusted by 1.5 (relative to 2.1)
   ##
-  tinytheme = "clean",
+  tinytheme = "dynamic",
   adj.main = 0,
   adj.sub = 0,
   dynmar = TRUE,
+  grid = FALSE,
   las = 1,
   mar = c(5.1, 4.1, 4.1, 2.1) - c(1+0.5+0.3, 0.5+0.3, 0, 1.5), ## test
   mgp = c(3, 1, 0) - c(0.5+0.3, 0.3, 0), # i.e., subtract 0.5 lines + the (abs) value of the tcl adjustment
-  palette.qualitative = "Tableau 10",
-  palette.sequential = "ag_Sunset",
   side.sub = 3,
   tcl = -0.3
 ))
 
-# derivatives of "clean" 
-# - clean2
+# derivatives of "dynamic"
+# - clean
 # - classic
-# - bw
 
-theme_clean2 = modifyList(theme_clean, list(
-  tinytheme = "clean2",
-  facet.border = "gray90",
-  xaxt = "labels",
-  yaxt = "labels"
+theme_clean = modifyList(theme_dynamic, list(
+  tinytheme = "clean",
+  grid = TRUE,
+  palette.qualitative = "Tableau 10",
+  palette.sequential = "ag_Sunset"
 ))
 
-theme_classic = modifyList(theme_clean, list(
+theme_classic = modifyList(theme_dynamic, list(
   tinytheme = "classic",
   bty = "l",
   facet.bg = NULL,
   font.main = 1,
-  grid = FALSE,
   palette.qualitative = "Okabe-Ito"
 ))
 
+# derivatives of "clean"
+# - clean2
+# - bw
+
+theme_clean2 = modifyList(theme_clean, list(
+  tinytheme = "clean2",
+  facet.border = "gray90",
+  xaxt = "labels",
+  yaxt = "labels"
+))
+
 theme_bw = modifyList(theme_clean, list(
   tinytheme = "bw",
   font.main = 1,
@@ -372,7 +380,7 @@ theme_dark = modifyList(theme_minimal, list(
   palette.sequential = "Sunset"
 ))
 
-# derivative of clean/clean2
+# derivatives of clean/clean2
 
 theme_ridge = modifyList(theme_clean, list(
   tinytheme = "ridge",

R/title.R

@@ -26,9 +26,12 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar) {
 
   if (!is.null(sub)) {
     if (isTRUE(get_tpar("side.sub", 1) == 3)) {
-      if (is.null(line_main)) line_main = par("mgp")[3] + 1.7 - .1
+      if (is.null(line_main)) line_main = get_tpar("mgp")[3] + 1.7 - .1
       line_main = line_main + 1.2
     }
+  }
+
+  if (!is.null(sub)) {
     if (isTRUE(get_tpar("side.sub", 1) == 3)) {
       line_sub = get_tpar("line.sub", 1.7)
     } else {
@@ -49,13 +52,33 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar) {
   }
 
   if (!is.null(main)) {
+    main_lines = text_line_count(main)
+    if (main_lines > 1L) {
+      # Keep line 1 aligned with single-line titles by shifting the centered
+      # multi-line block downward by half its extra line height.
+      if (is.null(line_main)) line_main = get_tpar("mgp")[3] + 1.1
+      line_main = line_main - (main_lines - 1) / 2
+    }
+    adj_main = get_tpar(c("adj.main", "adj"), 3)
+    ylab_lines = text_line_count(ylab)
+    # dynmar can expand left margin for multi-line ylab after title draw; apply
+    # a compensating right shift so main stays aligned with the plot box.
+    if (ylab_lines > 1L && isTRUE(get_tpar("dynmar", FALSE))) {
+      delta_in = (ylab_lines - 1) * par("csi") * par("cex.lab")
+      if (is.finite(par("pin")[1]) && par("pin")[1] > 0) {
+        multi_panel = prod(par("mfrow")) > 1 || prod(par("mfcol")) > 1
+        panel_boost = if (isTRUE(multi_panel)) 2 else 1
+        adj_main = adj_main + panel_boost * (delta_in / par("pin")[1])
+      }
+      adj_main = min(1, max(0, adj_main))
+    }
     args = list(
       main = main,
       line = line_main,
       cex.main = get_tpar("cex.main", 1.4),
       col.main = get_tpar("col.main", "black"),
       font.main = get_tpar("font.main", 2),
-      adj = get_tpar(c("adj.main", "adj"), 3))
+      adj = adj_main)
     args = Filter(function(x) !is.null(x), args)
     do.call(title, args)
   }
@@ -65,7 +88,23 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar) {
   args = list(xlab = xlab)
   args[["adj"]] = get_tpar(c("adj.xlab", "adj"))
   do.call(title, args)
+
   args = list(ylab = ylab)
+  ylab_lines = text_line_count(ylab)
+  if (ylab_lines > 1L) {
+    # Keep multi-line ylab centered around the default label line so outer
+    # lines do not get pushed off-device in tighter layouts (e.g., mfrow 2x2).
+    line_ylab = get_tpar("mgp")[1] - (ylab_lines - 1)
+    cex_ylab = get_tpar(c("cex.ylab", "cex.lab"), 1)
+    csi = par("csi")
+    left_margin_in = par("mai")[2]
+    # Keep roughly one glyph-width of room from the left device edge to avoid
+    # clipping of the outermost ylab line on compact multi-panel layouts.
+    edge_pad_in = 0.75 * csi * cex_ylab
+    max_line = (left_margin_in - edge_pad_in) / csi
+    line_ylab = min(line_ylab, max_line)
+    args[["line"]] = max(0, line_ylab)
+  }
   args[["adj"]] = get_tpar(c("adj.ylab", "adj"))
   do.call(title, args)
 }

R/utils.R

@@ -3,6 +3,18 @@ if (getRversion() <= "4.4.0") {
   `%||%` = function(x, y) if (is.null(x)) y else x
 }
 
+# Count text lines. Returns 0 for absent text and 1 for expression objects.
+text_line_count = function(x) {
+  if (is.null(x)) return(0L)
+  if (identical(x, NA) || identical(x, NA_character_)) return(0L)
+  if (!is.character(x)) return(1L)
+  if (!length(x)) return(0L)
+  keep = !is.na(x) & nzchar(x)
+  if (!any(keep)) return(0L)
+  x = x[which(keep)[1L]]
+  as.integer(1L + nchar(gsub("[^\n]", "", x)))
+}
+
 
 ## Function that computes an appropriate bandwidth kernel based on a string
 ## input