Add cap argument

NEWS.md

@@ -75,6 +75,11 @@ visualizations.
   providing finer control for spacing between ticks-labels and labels-titles,
   respectively, in dynamic themes. See the **Dynamic themes** entry above.
   (#590 @grantmcdermott)
+- New `tinyplot(..., cap = <caption>)` argument for adding a caption to your 
+  plots. Captions are drawn at the bottom of the plot and are best paired with
+  dynamic themes (since separation from `sub` is guaranteed). Appearance is
+  customizable via `tpar()` parameters: `adj.cap`, `cex.cap`, `col.cap`,
+  `font.cap`, and `line.cap`. (#592 @grantmcdermott)
 
 ### Bug fixes
 

R/facet.R

@@ -33,6 +33,7 @@ draw_facet_window = function(
     has_legend,
     main,
     sub,
+    cap,
     type,
     xlab,
     x, xmax, xmin,

R/legend.R

@@ -169,6 +169,10 @@ legend_outer_margins = function(legend_env, apply = TRUE) {
     } else if (legend_env$outer_end) {
       if (legend_env$outer_bottom) {
         legend_env$ooma[1] = soma
+        if (legend_env$has_cap) {
+          cex_cap = get_tpar("cex.cap", 1)
+          legend_env$ooma[1] = legend_env$ooma[1] + cex_cap + 0.2
+        }
       } else {
         legend_env$omar[3] = legend_env$omar[3] + soma - legend_env$topmar_epsilon
         par(mar = legend_env$omar)
@@ -269,6 +273,10 @@ tinylegend = function(legend_env) {
   } else if (legend_env$outer_end) {
     if (legend_env$outer_bottom) {
       legend_env$ooma[1] = soma
+      if (legend_env$has_cap) {
+        cex_cap = get_tpar("cex.cap", 1)
+        legend_env$ooma[1] = legend_env$ooma[1] + cex_cap + 0.2
+      }
     } else {
       legend_env$omar[3] = legend_env$omar[3] + soma - legend_env$topmar_epsilon
       par(mar = legend_env$omar)
@@ -321,6 +329,21 @@ tinylegend = function(legend_env) {
   } else {
     do.call("legend", legend_env$args)
   }
+
+  if (legend_env$outer_bottom && legend_env$has_cap) {
+    cex_cap = get_tpar("cex.cap", 1)
+    mtext(
+      legend_env$cap_text,
+      side = 1,
+      outer = TRUE,
+      line = par("oma")[1] - 1,
+      cex = cex_cap,
+      col = get_tpar("col.cap", "black"),
+      adj = get_tpar(c("adj.cap", "adj")),
+      font = get_tpar("font.cap", 1),
+      las = 1
+    )
+  }
 }
 
 
@@ -385,6 +408,7 @@ prepare_legend = function(settings) {
       "bubble_cex",
       "by",
       "by_continuous",
+      "cap",
       "cex_dep",
       "cex_fct_adj",
       "col",
@@ -448,6 +472,7 @@ prepare_legend = function(settings) {
 
   legend_draw_flag = (is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !isTRUE(add)
   has_sub = text_line_count(sub) > 0L
+  has_cap = text_line_count(cap) > 0L
 
   # Generate labels for discrete legends
   if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || multi_legend)) {
@@ -469,7 +494,8 @@ prepare_legend = function(settings) {
       "legend",
       "legend_args",
       "legend_draw_flag",
-      "has_sub"
+      "has_sub",
+      "has_cap"
     )
   )
 }
@@ -711,6 +737,8 @@ build_legend_env = function(
   gradient,
   lmar,
   has_sub = FALSE,
+  has_cap = FALSE,
+  cap_text = NULL,
   new_plot = TRUE
 ) {
   # Create legend environment
@@ -720,6 +748,8 @@ build_legend_env = function(
   legend_env$gradient = gradient
   legend_env$type = type
   legend_env$has_sub = has_sub
+  legend_env$has_cap = has_cap
+  legend_env$cap_text = cap_text
   legend_env$new_plot = new_plot
   legend_env$dynmar = isTRUE(.tpar[["dynmar"]])
   legend_env$topmar_epsilon = 0.1
@@ -793,6 +823,11 @@ build_legend_env = function(
 #' @param has_sub Logical. Does the plot have a sub-caption. Only used if
 #'   keyword position is "bottom!", in which case we need to bump the legend
 #'   margin a bit further.
+#' @param has_cap Logical. Does the plot have a caption. Only used if
+#'   keyword position is "bottom!", in which case we need to bump the legend
+#'   margin a bit further.
+#' @param cap_text Character. The caption text to draw below the legend when
+#'   position is "bottom!". Ignored otherwise.
 #' @param new_plot Logical. Should we be calling plot.new internally?
 #' @param draw Logical. If `FALSE`, no legend is drawn but the sizes are
 #'   returned. Note that a new (blank) plot frame will still need to be started
@@ -881,6 +916,8 @@ draw_legend = function(
   gradient = FALSE,
   lmar = NULL,
   has_sub = FALSE,
+  has_cap = FALSE,
+  cap_text = NULL,
   new_plot = TRUE,
   draw = TRUE,
   soma_target = NULL
@@ -895,6 +932,7 @@ draw_legend = function(
 
   assert_logical(gradient)
   assert_logical(has_sub)
+  assert_logical(has_cap)
   assert_logical(new_plot)
   assert_logical(draw)
 
@@ -929,6 +967,8 @@ draw_legend = function(
     gradient = gradient,
     lmar = lmar,
     has_sub = has_sub,
+    has_cap = has_cap,
+    cap_text = cap_text,
     new_plot = new_plot
   )
 

R/tinyplot.R

@@ -167,6 +167,12 @@
 #'    legend arguments, e.g. "bty", "horiz", and so forth.
 #' @param main a main title for the plot, see also `title`.
 #' @param sub a subtitle for the plot.
+#' @param cap a caption for the plot, drawn at the bottom. Useful for
+#'   annotations like data sources. Best paired with a dynamic
+#'   \code{\link[tinyplot]{tinytheme}}. For the default theme, should be seen as
+#'   a substitute for `sub`, since these two will otherwise overlap. Appearance
+#'   can be customized via \code{\link[tinyplot]{tpar}} parameters `adj.cap`,
+#'   `cex.cap`, `col.cap`, `font.cap`, and `line.cap`.
 #' @param xlab a label for the x axis, defaults to a description of x.
 #' @param ylab a label for the y axis, defaults to a description of y.
 #' @param ann a logical value indicating whether the default annotation (title
@@ -609,17 +615,16 @@
 #' # parameters (e.g., via `(t)par`)... But a more convenient way is to just use
 #' # built-in themes (see `?tinytheme`).
 #'
-#' tinytheme("clean2")
 #' tinyplot(
 #'   Temp ~ Day | Month,
 #'   data = aq,
 #'   type = "b",
 #'   alpha = 0.5,
 #'   main = "Daily temperatures by month",
-#'   sub = "Brought to you by tinyplot"
+#'   sub = "Brought to you by tinyplot",
+#'   cap = "Source: Base R airquality dataset",
+#'   theme = "clean2"
 #' )
-#' # reset the theme
-#' tinytheme()
 #'
 #' # For more examples and a detailed walkthrough, please see the introductory
 #' # tinyplot tutorial available online:
@@ -649,6 +654,7 @@ tinyplot.default = function(
     legend = NULL,
     main = NULL,
     sub = NULL,
+    cap = NULL,
     xlab = NULL,
     ylab = NULL,
     ann = par("ann"),
@@ -855,11 +861,13 @@ tinyplot.default = function(
     # misc
     add           = add,
     by            = by,
+    cap       = cap,
     dodge         = NULL,
     dots          = dots,
     flip          = flip,
     group_offsets = NULL,
     offsets_axis  = NULL,
+    sub           = sub,
     type_info     = list() # pass type-specific info from type_data to type_draw
   )
 
@@ -1052,7 +1060,9 @@ tinyplot.default = function(
     )
 
     .dyn = c(
-      dynmar_side(1, xlab, main = main, sub = sub, side.sub = .side.sub,
+      dynmar_side(1, xlab, main = main, sub = sub,
+                  cap = if (.outer_sides[1]) NULL else cap,
+                  side.sub = .side.sub,
                   axis_on = !identical(xaxt, "none") && !identical(xaxt, "n"),
                   tpars = .tpars),
       dynmar_side(2, ylab,
@@ -1136,7 +1146,9 @@ tinyplot.default = function(
         bg = bg,
         gradient = by_continuous,
         cex = lgnd_cex,
-        has_sub = has_sub
+        has_sub = has_sub,
+        has_cap = has_cap,
+        cap_text = cap
       )
     } else {
       ## multi-legend case...
@@ -1210,7 +1222,7 @@ tinyplot.default = function(
       }
     }
 
-    draw_title(main, sub, xlab, ylab, legend, legend_args, opar,
+    draw_title(main, sub, cap, xlab, ylab, legend, legend_args, opar,
                xlab_line_offset = if (!is.null(dynmar_computed)) .whtsbp[1] else 0,
                ylab_line_offset = if (!is.null(dynmar_computed)) .whtsbp[2] - .ymgp_shift - .ylab_cex_shift else 0)
   }
@@ -1294,6 +1306,7 @@ tinyplot.default = function(
       has_legend = has_legend,
       main = main,
       sub = sub,
+      cap = cap,
       type = type,
       xlab = xlab,
       x = x, xmax = xmax, xmin = xmin,
@@ -1324,6 +1337,7 @@ tinyplot.default = function(
       has_legend = has_legend,
       main = main,
       sub = sub,
+      cap = cap,
       type = type,
       xlab = xlab,
       x = datapoints$x, xmax = datapoints$xmax, xmin = datapoints$xmin,
@@ -1594,6 +1608,7 @@ tinyplot.formula = function(
     # log = "",
     main = NULL,
     sub = NULL,
+    cap = NULL,
     xlab = NULL,
     ylab = NULL,
     ann = par("ann"),
@@ -1742,6 +1757,7 @@ tinyplot.formula = function(
     # log = "",
     main = main,
     sub = sub,
+    cap = cap,
     xlab = xlab,
     ylab = ylab,
     ann = ann,

R/tinytheme.R

@@ -162,7 +162,8 @@
 #'     I(Sepal.Length*1e4) ~ Petal.Length | Species, facet = "by", data = iris,
 #'     yaxl = ",", 
 #'     main = paste0('tinytheme("', thm, '")'),
-#'     sub = "A subtitle"
+#'     sub = "A subtitle",
+#'     cap = "A caption"
 #'   )
 #'   box("outer", lty = 2)
 #' }
@@ -267,13 +268,15 @@ theme_default = list(
   tinytheme = "default",
   adj = par("adj"), # 0.5,
   adj.main = par("adj"), # 0.5,
+  adj.cap = par("adj"), # 0.5,
   adj.sub = par("adj"), # 0.5,
   bg = "white", # par("bg") # "white"
   bty = par("bty"), #"o",
   cex = par("cex"), #1,
   cex.axis = par("cex.axis"), #1,
   cex.lab = par("cex.lab"), #1,
   cex.main = par("cex.main"), #1.2,
+  cex.cap = 1,
   cex.sub = par("cex.sub"), #1,
   cex.xlab = NULL, # defer to par("cex.lab") unless set explicitly
   cex.ylab = NULL, # defer to par("cex.lab") unless set explicitly
@@ -283,6 +286,7 @@ theme_default = list(
   col.yaxs = par("col.axis"), #1,
   col.lab = par("col.lab"), #"black",
   col.main = par("col.main"), #"black",
+  col.cap = "black",
   col.sub = par("col.sub"), #"black",
   dynmar = FALSE,
   facet.bg = NULL,
@@ -293,6 +297,7 @@ theme_default = list(
   font.axis = par("font.axis"), # 1,
   font.lab = par("font.lab"), # 1,
   font.main = par("font.main"), # 2,
+  font.cap = 1,
   font.sub = par("font.sub"), # 2,
   grid = FALSE,
   grid.col = "lightgray",
@@ -322,6 +327,7 @@ theme_default = list(
 
 theme_basic = modifyList(theme_default, list(
   tinytheme = "basic",
+  adj.cap = 1,
   facet.bg = "gray90",
   facet.border = "black",
   grid = TRUE,
@@ -330,6 +336,7 @@ theme_basic = modifyList(theme_default, list(
 
 theme_tufte = modifyList(theme_default, list(
   tinytheme = "tufte",
+  adj.cap = 1,
   adj.main = 0,
   adj.sub = 0,
   bty = "n",
@@ -343,6 +350,7 @@ theme_tufte = modifyList(theme_default, list(
 
 theme_void = modifyList(theme_default, list(
   tinytheme = "void",
+  adj.cap = 1,
   adj.main = 0,
   adj.sub = 0,
   font.main = 1,
@@ -391,6 +399,7 @@ theme_dynamic = modifyList(theme_basic, list(
 
 theme_clean = modifyList(theme_dynamic, list(
   tinytheme = "clean",
+  cex.cap = 0.8,
   grid = TRUE,
   palette.qualitative = "Tableau 10",
   palette.sequential = "ag_Sunset"
@@ -399,6 +408,7 @@ theme_clean = modifyList(theme_dynamic, list(
 theme_classic = modifyList(theme_dynamic, list(
   tinytheme = "classic",
   bty = "l",
+  cex.cap = 0.8,
   facet.bg = NULL,
   font.main = 1,
   palette.qualitative = "Okabe-Ito"
@@ -456,6 +466,7 @@ theme_dark = modifyList(theme_minimal, list(
   col.yaxs = "#BBBBBB",
   col.lab = "#BBBBBB",
   col.main = "#BBBBBB",
+  col.cap = "#BBBBBB",
   col.sub = "#BBBBBB",
   col.axis = "#BBBBBB",
   # facet.bg = "gray20",

R/title.R

@@ -1,4 +1,4 @@
-draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar,
+draw_title = function(main, sub, cap, xlab, ylab, legend, legend_args, opar,
                       xlab_line_offset = 0,
                       ylab_line_offset = 0) {
   # main title
@@ -79,6 +79,27 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar,
   }
 
 
+  cap_in_legend = !is.null(legend_args[["x"]]) && grepl("bottom!$", legend_args[["x"]])
+  if (!is.null(cap) && !cap_in_legend) {
+    cex_cap = get_tpar("cex.cap", 1)
+    line_cap = get_tpar("line.cap", NULL)
+    if (is.null(line_cap)) {
+      line_cap = par("mar")[1] - 1
+    }
+    args = list(
+      text = cap,
+      line = line_cap,
+      cex = cex_cap,
+      col = get_tpar("col.cap", "black"),
+      adj = get_tpar(c("adj.cap", "adj")),
+      font = get_tpar("font.cap", 1),
+      side = 1,
+      las = 1
+    )
+    args = Filter(function(x) !is.null(x), args)
+    do.call(mtext, args)
+  }
+
   # Axis titles. For multi-line labels, base R places line 1 at
   # `line = mgp[1] - (N-1)*cex`, which pushes line 1 up into the tick-label
   # zone. Shift `line` down so line 1 aligns with where a single-line xlab