Pass legend customizations through own type_* functions

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tinyplot
 Type: Package
 Title: Lightweight Extension of the Base R Graphics System
-Version: 0.6.0
+Version: 0.6.99
 Date: 2025-11-26
 Authors@R: 
   c(

NEWS.md

@@ -4,6 +4,21 @@ _If you are viewing this file on CRAN, please check the
 [latest NEWS](https://grantmcdermott.com/tinyplot/NEWS.html) on our website
 where the formatting is also better._
 
+## Development version
+
+### Internals
+
+- We now encourage type-specific legend customizations within the individual
+  `type_<type>` constructors. (#531 @grantmcdermott)
+
+### Documentation
+
+- Improved guidance for
+  [custom types](https://grantmcdermott.com/tinyplot/vignettes/types.html#custom-types)
+  in the `Types` vignette. (#531 @grantmcdermott)
+
+### Breaking changes
+
 ## v0.6.0
 
 ### Breaking changes

R/bubble.R

@@ -0,0 +1,55 @@
+bubble = function(settings) {
+  # Only process for points and text types
+  if (!(settings$type %in% c("p", "text"))) return(invisible())
+
+  cex = settings$cex
+
+  # Only process if cex is a vector matching data length
+  if (is.null(cex) || length(cex) != nrow(settings$datapoints)) return(invisible())
+
+  clim = settings$clim %||% c(0.5, 2.5)
+
+  bubble = TRUE
+
+  ## Identify the pretty break points for our bubble labels
+  bubble_labs = pretty(cex, n = 5)
+  len_labs = length(bubble_labs)
+  cex = rescale_num(sqrt(c(bubble_labs, cex)) / pi, to = clim)
+  bubble_cex = cex[1:len_labs]
+  cex = cex[(len_labs+1):length(cex)]
+
+  # catch for cases where pretty breaks leads to smallest category of 0
+  if (bubble_labs[1] == 0) {
+    bubble_labs = bubble_labs[-1]
+    bubble_cex = bubble_cex[-1]
+  }
+  names(bubble_cex) = format(bubble_labs)
+
+  if (max(clim) > 2.5) {
+    settings$legend_args[["x.intersp"]] = max(clim) / 2.5
+    settings$legend_args[["y.intersp"]] = sapply(bubble_cex / 2.5, max, 1)
+  }
+
+  ## fixme: can't assign pt.cex here b/c of dual legend gotcha (don't want to
+  ##   override the "normal" pt.cex too) 
+  # legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% (settings[["cex"]] %||% par("cex"))
+
+  # Must update settings with bubble/bubble_cex/cex before calling sanitize_bubble
+  env2env(environment(), settings, c("bubble", "bubble_cex", "cex"))
+
+  sanitize_bubble(settings)
+}
+
+sanitize_bubble = function(settings) {
+  env2env(settings, environment(), c("datapoints", "pch", "alpha", "bg", "cex", "bubble"))
+
+  if (!bubble) return(invisible())
+
+  datapoints[["cex"]] = cex
+  bubble_pch = if (!is.null(pch) && length(pch)==1) pch else par("pch")
+  bubble_alpha = if (!is.null(alpha)) alpha else 1
+  bubble_bg_alpha = if (!is.null(bg) && length(bg)==1 && is.numeric(bg) && bg > 0 && bg <=1) bg else 1
+
+  env2env(environment(), settings, c("datapoints", "bubble_pch", "bubble_alpha", "bubble_bg_alpha"))
+}
+

R/draw_legend_utils.R

@@ -57,38 +57,29 @@ compute_legend_args = function(
   legend_args[["bty"]] = legend_args[["bty"]] %||% "n"
   legend_args[["horiz"]] = legend_args[["horiz"]] %||% FALSE
   legend_args[["xpd"]] = legend_args[["xpd"]] %||% NA
-  if (!isTRUE(type %in% c("p", "ribbon", "polygon", "polypath"))) {
-    legend_args[["lwd"]] = legend_args[["lwd"]] %||% lwd
-  }
-  if (is.null(type) || type %in% c("p", "pointrange", "errorbar", "text")) {
+  legend_args[["lwd"]] = legend_args[["lwd"]] %||% lwd
+  # special handling of pt.cex for bubble plots
+  # (fixme: can't handle ahead of time in bubble.R b/c of dual legend gotcha)
+  if (is.null(type) || type %in% c("p", "text")) {
     legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% (cex %||% par("cex"))
   }
-  # turn off inner line for "barplot" type
-  if (identical(type, "barplot")) {
-    legend_args[["lty"]] = 0
-  }
-  if (isTRUE(type %in% c("rect", "ribbon", "polygon", "polypath", "boxplot", "hist", "histogram", "spineplot", "ridge", "barplot", "violin")) || gradient) {
+  if (gradient) {
     legend_args[["pch"]] = 22
     legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% 3.5
     legend_args[["y.intersp"]] = legend_args[["y.intersp"]] %||% 1.25
     legend_args[["seg.len"]] = legend_args[["seg.len"]] %||% 1.25
   }
-  if (isTRUE(type %in% c("ribbon", "hist", "histogram", "spineplot"))) {
-    legend_args[["pt.lwd"]] = legend_args[["pt.lwd"]] %||% 0
-  }
-  if (identical(type, "p")) {
-    legend_args[["pt.lwd"]] = legend_args[["pt.lwd"]] %||% lwd
-  }
   if (identical(type, "n") && isFALSE(gradient)) {
     legend_args[["pch"]] = legend_args[["pch"]] %||% par("pch")
   }
+  # Special pt.bg handling for types that need color-based fills
   if (identical(type, "spineplot")) {
     legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% legend_args[["col"]]
-  }
-  if (identical(type, "ridge") && isFALSE(gradient)) {
+  } else if (identical(type, "ridge") && isFALSE(gradient)) {
     legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% sapply(legend_args[["col"]], function(ccol) seq_palette(ccol, n = 2)[2])
+  } else {
+    legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% bg
   }
-  legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% bg
   legend_args[["legend"]] = legend_args[["legend"]] %||% lgnd_labs
   if (length(lgnd_labs) != length(eval(legend_args[["legend"]]))) {
     warning(

R/tinyplot.R

@@ -733,6 +733,9 @@ tinyplot.default = function(
 
     # type-specific settings
     bubble        = FALSE,
+    bubble_pch    = NULL,
+    bubble_alpha  = NULL,
+    bubble_bg_alpha = NULL,
     ygroup        = NULL,  # for type_ridge()
 
     # data points and labels
@@ -767,9 +770,7 @@ tinyplot.default = function(
     null_ylim     = is.null(ylim),
     # when palette functions need pre-processing this check raises error
     null_palette  = tryCatch(is.null(palette), error = function(e) FALSE),
-    was_area_type = identical(type, "area"),  # mostly for legend
-    x_by          = identical(x, by), # for "boxplot", "spineplot" and "ridges"
-
+    x_by          = identical(x, by), # for "boxplot", "spineplot" and "ridge"
 
     # unevaluated expressions with side effects
     draw          = substitute(draw),
@@ -884,10 +885,10 @@ tinyplot.default = function(
   ## bubble plot -----
   #
 
-  # catch some simple aesthetics for bubble plots before the standard "by"
-  # grouping sanitizers (actually: will only be used for dual_legend plots but
-  # easiest to assign/determine now)
-  sanitize_bubble(settings)
+  # Transform cex values for bubble charts. Handles size transformation, legend
+  # gotchas, and aesthetic sanitization.
+  # Currently limited to "p" and "text" types, but could expand to others.
+  bubble(settings)
 
 
   #
@@ -910,12 +911,14 @@ tinyplot.default = function(
   #
   ## aesthetics by group -----
   #
+
   by_aesthetics(settings)
 
 
   #
   ## make settings available in the environment directly -----
   #
+
   env2env(settings, environment())
 
 
@@ -983,11 +986,6 @@ tinyplot.default = function(
 
     has_sub = !is.null(sub)
 
-    if (isTRUE(was_area_type) || isTRUE(type %in% c("area", "rect", "hist", "histogram"))) {
-      legend_args[["pt.lwd"]] = par("lwd")
-      legend_args[["lty"]] = 0
-    }
-
     if (!dual_legend) {
       ## simple case: single legend only
       if (is.null(lgnd_cex)) lgnd_cex = cex * cex_fct_adj

R/type_area.R

@@ -24,6 +24,14 @@ data_area = function(alpha = alpha) {
         # ribbon.alpha comes from parent scope, so assign it locally
         ribbon.alpha = ribbon.alpha
 
+        # legend customizations
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% par("lwd")
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% 0
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, c(
             "datapoints",
             "ymax",

R/type_barplot.R

@@ -199,6 +199,14 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL,
         xaxs = "r"
         xaxt = if (xaxt == "s") "l" else xaxt
         yaxs = "i"
+
+        # legend customizations
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% 0
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, c(
           "datapoints",
           "xlab",

R/type_boxplot.R

@@ -133,6 +133,13 @@ data_boxplot = function() {
         ymax = datapoints$ymax
         by = if (length(unique(datapoints$by)) > 1) datapoints$by else by
         facet = if (length(unique(datapoints$facet)) > 1) datapoints$facet else facet
+
+        # legend customizations
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, c(
             "x",
             "y",

R/type_density.R

@@ -149,16 +149,24 @@ data_density = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512,
 
         # flags for legend and fill
         dtype = if (!is.null(bg)) "ribbon" else "l"
-        dwas_area_type = !is.null(bg)
 
         type = dtype
-        was_area_type = dwas_area_type
         by = if (length(unique(datapoints$by)) == 1) by else datapoints$by
         facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet
+
+        # legend customizations (only for filled density plots)
+        if (!is.null(bg)) {
+            settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+            settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+            settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% par("lwd")
+            settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% 0
+            settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+            settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+        }
+
         env2env(environment(), settings, c(
             "ylab",
             "type",
-            "was_area_type",
             "ribbon.alpha",
             "datapoints",
             "by",

R/type_glm.R

@@ -61,6 +61,15 @@ data_glm = function(family, se, level, type, ...) {
         })
         datapoints = do.call(rbind, dat)
         datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ]
+
+        # legend customizations - same as ribbon but add line through square
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% 0
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% par("lty")
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, "datapoints")
     }
     return(fun)

R/type_histogram.R

@@ -145,7 +145,6 @@ data_histogram = function(breaks = "Sturges",
             ylab = ifelse(datapoints$freq[1], "Frequency", "Density")
         }
 
-        # browser()
         x = c(datapoints$xmin, datapoints$xmax)
         y = c(datapoints$ymin, datapoints$ymax)
         ymin = datapoints$ymin
@@ -154,6 +153,15 @@ data_histogram = function(breaks = "Sturges",
         xmax = datapoints$xmax
         by = if (length(unique(datapoints$by)) == 1) by else datapoints$by
         facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet
+
+        # legend customizations
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% par("lwd")
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% 0
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, c(
             "x",
             "y",

R/type_lm.R

@@ -57,6 +57,15 @@ data_lm = function(se, level, ...) {
         })
         datapoints = do.call(rbind, dat)
         datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ]
+
+        # legend customizations - same as ribbon but add line through square
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% 0
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% par("lty")
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, "datapoints")
     }
     return(fun)

R/type_loess.R

@@ -51,6 +51,15 @@ data_loess = function(span, degree, family, control, se, level, ...) {
         })
         datapoints = do.call(rbind, datapoints)
         datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ]
+
+        # legend customizations - same as ribbon but add line through square
+        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
+        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
+        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% 0
+        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% par("lty")
+        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
+        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
+
         env2env(environment(), settings, "datapoints")
     }
     return(fun)

R/type_pointrange.R

@@ -49,7 +49,7 @@ draw_pointrange = function() {
 
 data_pointrange = function(dodge, fixed.dodge) {
   fun = function(settings, ...) {
-    env2env(settings, environment(), c("datapoints", "xlabs"))
+    env2env(settings, environment(), c("datapoints", "xlabs", "cex"))
 
     if (is.character(datapoints$x)) {
       datapoints$x = as.factor(datapoints$x)
@@ -71,6 +71,10 @@ data_pointrange = function(dodge, fixed.dodge) {
     }
 
     x = datapoints$x
+
+    # legend customizations
+    settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% (cex %||% par("cex"))
+
     env2env(environment(), settings, c(
       "x",
       "xlabs",