Rework dynamic theme logic

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) * par("cex.lab")
+      if (ylab_lines > 1) omar[2] = omar[2] + (ylab_lines - 1) * par("cex.lab")
+      if (main_lines > 1) omar[3] = omar[3] + (main_lines - 1) * par("cex.main")
+
       # 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) * par("cex.lab")
+    if (ylab_lines > 1) omar[2] = omar[2] + (ylab_lines - 1) * par("cex.lab")
+    if (main_lines > 1) omar[3] = omar[3] + (main_lines - 1) * par("cex.main")
+
      par(mar = omar)
   }
 

R/legend.R

@@ -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

@@ -49,8 +49,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.
 #' 

R/title.R

@@ -29,6 +29,9 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar) {
       if (is.null(line_main)) line_main = par("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 = par("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 = par("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