From 300ab232e9a930b2fe254784db91ea57b8d7098d Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 09:45:02 -0400 Subject: [PATCH 01/54] settings container --- R/sanitize.R | 108 ++++++++++++++++++++++++++--------------------- R/setup_device.R | 6 ++- R/tinyplot.R | 85 ++++++++++++++++++++++--------------- 3 files changed, 115 insertions(+), 84 deletions(-) diff --git a/R/sanitize.R b/R/sanitize.R index 5d4aa811..4e62bcf0 100644 --- a/R/sanitize.R +++ b/R/sanitize.R @@ -6,13 +6,20 @@ sanitize_ribbon.alpha = function(ribbon.alpha) { -sanitize_type = function(type, x, y, dots) { +sanitize_type = function(settings) { + list2env(settings, environment()) + if (inherits(type, "tinyplot_type")) { - return(type) + settings = modifyList(settings, list( + type = type$name, + type_draw = type$draw, + type_data = type$data + ), keep.null = TRUE) + return(settings) } known_types = c( - "p", "l", "o", "b", "c", "h", "j", "s", "S", "n", + "p", "l", "o", "b", "c", "h", "j", "s", "S", "n", "abline", "area", "bar", "barplot", @@ -57,57 +64,64 @@ sanitize_type = function(type, x, y, dots) { } } - if (is.character(type)) type = switch(type, - "abline" = type_abline, - "area" = type_area, - "bar" = type_barplot, - "barplot" = type_barplot, - "box" = type_boxplot, - "boxplot" = type_boxplot, - "density" = type_density, - "errorbar" = type_errorbar, - "function" = type_function, - "glm" = type_glm, - "hist" = type_histogram, - "histogram" = type_histogram, - "hline" = type_hline, - "j" = type_jitter, - "jitter" = type_jitter, - "lines" = type_lines, - "lm" = type_lm, - "loess" = type_loess, - "p" = type_points, - "pointrange" = type_pointrange, - "points" = type_points, - "polygon" = type_polygon, - "polypath" = type_polypath, - "qq" = type_qq, - "rect" = type_rect, - "ribbon" = type_ribbon, - "ridge" = type_ridge, - "rug" = type_rug, - "segments" = type_segments, - "spine" = type_spineplot, - "spineplot" = type_spineplot, - "spline" = type_spline, - "summary" = type_summary, - "text" = type_text, - "violin" = type_violin, - "vline" = type_vline, - type # default case - ) - + if (is.character(type)) { + type = switch(type, + "abline" = type_abline, + "area" = type_area, + "bar" = type_barplot, + "barplot" = type_barplot, + "box" = type_boxplot, + "boxplot" = type_boxplot, + "density" = type_density, + "errorbar" = type_errorbar, + "function" = type_function, + "glm" = type_glm, + "hist" = type_histogram, + "histogram" = type_histogram, + "hline" = type_hline, + "j" = type_jitter, + "jitter" = type_jitter, + "lines" = type_lines, + "lm" = type_lm, + "loess" = type_loess, + "p" = type_points, + "pointrange" = type_pointrange, + "points" = type_points, + "polygon" = type_polygon, + "polypath" = type_polypath, + "qq" = type_qq, + "rect" = type_rect, + "ribbon" = type_ribbon, + "ridge" = type_ridge, + "rug" = type_rug, + "segments" = type_segments, + "spine" = type_spineplot, + "spineplot" = type_spineplot, + "spline" = type_spline, + "summary" = type_summary, + "text" = type_text, + "violin" = type_violin, + "vline" = type_vline, + type # default case + ) + } + if (is.function(type)) { args = intersect(names(formals(type)), names(dots)) args = if (length(args) >= 1L) dots[args] else list() type = do.call(type, args) type$dots = dots[setdiff(names(dots), names(args))] } - - if (inherits(type, "tinyplot_type")) return(type) - out = list(draw = NULL, data = NULL, name = type) - return(out) + if (inherits(type, "tinyplot_type")) { + settings = modifyList(settings, list( + type = type$name, + type_draw = type$draw, + type_data = type$data + ), keep.null = TRUE) + } + + return(settings) } diff --git a/R/setup_device.R b/R/setup_device.R index e3837748..286682b8 100644 --- a/R/setup_device.R +++ b/R/setup_device.R @@ -1,4 +1,6 @@ -setup_device = function(file, width, height) { +setup_device = function(settings) { + list2env(settings[c("file", "width", "height")], environment()) + # write to file if (!is.null(file)) { filepath = file @@ -30,7 +32,7 @@ setup_device = function(file, width, height) { dop$new = FALSE # catch for some interfaces par(dop) - # interactive plot with user-specified width/height + # interactive plot with user-specified width/height } else if (!is.null(width) || !is.null(height)) { devwidth = width devheight = height diff --git a/R/tinyplot.R b/R/tinyplot.R index 83a6dc31..b55b6431 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -676,53 +676,68 @@ tinyplot.default = function( # - ## devices and files ----- + ## settings container ----- # - # Write plot to output file or window with fixed dimensions - setup_device(file = file, width = width, height = height) - if (!is.null(file)) on.exit(dev.off(), add = TRUE) - + settings = list( + # save call to check user input later + call = match.call(), + # save to file + file = file, + width = width, + height = height, + # deparsed input for use in labels + by_dep = deparse1(substitute(by)), + cex_dep = if (!is.null(cex)) deparse1(substitute(cex)) else NULL, + facet_dep = deparse1(substitute(facet)), + x_dep = if (is.null(x)) NULL else deparse1(substitute(x)), + xmax_dep = if (is.null(xmax)) NULL else deparse1(substitute(xmax)), + xmin_dep = if (is.null(xmin)) NULL else deparse1(substitute(xmin)), + y_dep = if (is.null(y)) NULL else deparse1(substitute(y)), + ymax_dep = if (is.null(ymax)) NULL else deparse1(substitute(ymax)), + ymin_dep = if (is.null(ymin)) NULL else deparse1(substitute(ymin)), + # types + type = type, + type_data = NULL, + type_draw = NULL, + type_name = NULL, + # type-specific + bubble = FALSE, + ygroup = NULL, # for type_ridge() + # data points and labels + x = x, + xmax = xmax, + xmin = xmin, + xlab = xlab, + xlabs = NULL, + y = y, + ymax = ymax, + ymin = ymin, + ylab = ylab, + ylabs = NULL, + # unevaluated expressions with side effects + draw = substitute(draw), + # extra / unknown arguments + dots = list(...) + ) + settings[["user_input"]] <- settings # - ## deparsed expressions for labels ----- + ## devices and files ----- # - - x_dep = if (is.null(x)) NULL else deparse1(substitute(x)) - xmin_dep = if (is.null(xmin)) NULL else deparse1(substitute(xmin)) - xmax_dep = if (is.null(xmax)) NULL else deparse1(substitute(xmax)) - y_dep = if (is.null(y)) NULL else deparse1(substitute(y)) - ymin_dep = if (is.null(ymin)) NULL else deparse1(substitute(ymin)) - ymax_dep = if (is.null(ymax)) NULL else deparse1(substitute(ymax)) - by_dep = deparse1(substitute(by)) - cex_dep = if (!is.null(cex)) deparse1(substitute(cex)) else NULL - facet_dep = deparse1(substitute(facet)) - + # Write plot to output file or window with fixed dimensions + setup_device(settings) + if (!is.null(settings$file)) on.exit(dev.off(), add = TRUE) # ## sanitize arguments ----- # - # init variables - xlabs = ylabs = NULL - ygroup = NULL # type_ridge() - bubble = FALSE - - # ellipsis - dots = list(...) - - # draw - draw = substitute(draw) - - # type # sanitize_type: validates/converts type argument and returns list with name, data, and draw components - type = sanitize_type(type, x, y, dots) - if ("dots" %in% names(type)) dots = type$dots - type_data = type$data - type_draw = type$draw - type = type$name + settings = sanitize_type(settings) + list2env(settings, environment()) - # area flag (mostly for legend) + # # area flag (mostly for legend) was_area_type = identical(type, "area") # legend From 17f952b84faa071a805e800c24838a1cb30e3c0f Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 10:51:12 -0400 Subject: [PATCH 02/54] sanitize_() functions now use settings --- R/sanitize.R | 148 --------------------------------------------- R/sanitize_axes.R | 30 +++++++++ R/sanitize_type.R | 117 +++++++++++++++++++++++++++++++++++ R/sanitize_xylab.R | 16 +++-- R/tinyplot.R | 75 +++++++++++------------ 5 files changed, 194 insertions(+), 192 deletions(-) create mode 100644 R/sanitize_axes.R create mode 100644 R/sanitize_type.R diff --git a/R/sanitize.R b/R/sanitize.R index 4e62bcf0..02285dc8 100644 --- a/R/sanitize.R +++ b/R/sanitize.R @@ -3,151 +3,3 @@ sanitize_ribbon.alpha = function(ribbon.alpha) { if (is.null(ribbon.alpha)) ribbon.alpha = .tpar[["ribbon.alpha"]] return(ribbon.alpha) } - - - -sanitize_type = function(settings) { - list2env(settings, environment()) - - if (inherits(type, "tinyplot_type")) { - settings = modifyList(settings, list( - type = type$name, - type_draw = type$draw, - type_data = type$data - ), keep.null = TRUE) - return(settings) - } - - known_types = c( - "p", "l", "o", "b", "c", "h", "j", "s", "S", "n", - "abline", - "area", - "bar", "barplot", - "box", "boxplot", - "density", - "errorbar", - "function", - "glm", - "hist", "histogram", - "hline", - "j", "jitter", - "lines", - "lm", - "loess", - "pointrange", - "points", - "polygon", "polypath", - "qq", - "rect", - "ribbon", - "ridge", - "rug", - "segments", - "spine", "spineplot", - "spline", - "summary", - "text", - "violin", - "vline" - ) - assert_choice(type, known_types, null.ok = TRUE) - - if (is.null(type)) { - if (!is.null(x) && (is.factor(x) || is.character(x)) && !(is.factor(y) || is.character(y))) { - # enforce boxplot type for y ~ factor(x) - type = type_boxplot - } else if (is.factor(y) || is.character(y)) { - # enforce spineplot type for factor(y) ~ x - type = type_spineplot - } else { - type = "p" - } - } - - if (is.character(type)) { - type = switch(type, - "abline" = type_abline, - "area" = type_area, - "bar" = type_barplot, - "barplot" = type_barplot, - "box" = type_boxplot, - "boxplot" = type_boxplot, - "density" = type_density, - "errorbar" = type_errorbar, - "function" = type_function, - "glm" = type_glm, - "hist" = type_histogram, - "histogram" = type_histogram, - "hline" = type_hline, - "j" = type_jitter, - "jitter" = type_jitter, - "lines" = type_lines, - "lm" = type_lm, - "loess" = type_loess, - "p" = type_points, - "pointrange" = type_pointrange, - "points" = type_points, - "polygon" = type_polygon, - "polypath" = type_polypath, - "qq" = type_qq, - "rect" = type_rect, - "ribbon" = type_ribbon, - "ridge" = type_ridge, - "rug" = type_rug, - "segments" = type_segments, - "spine" = type_spineplot, - "spineplot" = type_spineplot, - "spline" = type_spline, - "summary" = type_summary, - "text" = type_text, - "violin" = type_violin, - "vline" = type_vline, - type # default case - ) - } - - if (is.function(type)) { - args = intersect(names(formals(type)), names(dots)) - args = if (length(args) >= 1L) dots[args] else list() - type = do.call(type, args) - type$dots = dots[setdiff(names(dots), names(args))] - } - - if (inherits(type, "tinyplot_type")) { - settings = modifyList(settings, list( - type = type$name, - type_draw = type$draw, - type_data = type$data - ), keep.null = TRUE) - } - - return(settings) -} - - - -sanitize_axes = function(axes, xaxt, yaxt, frame.plot) { - ## handle defaults of axes, xaxt, yaxt, frame.plot - ## - convert axes to character if necessary - ## - set defaults of xaxt/yaxt (if these are NULL) based on axes - ## - set logical axes based on xaxt/yaxt - ## - set frame.plot default based on xaxt/yaxt - if (isFALSE(axes)) { - axes = xaxt = yaxt = "none" - } else if (isTRUE(axes)) { - axes = "standard" - if (is.null(xaxt)) xaxt = get_tpar("xaxt", default = "standard") - if (is.null(yaxt)) yaxt = get_tpar("yaxt", default = "standard") - } else { - xaxt = yaxt = axes - } - axis_types = c("standard", "none", "labels", "ticks", "axis") - axes = match.arg(axes, axis_types) - xaxt = match.arg(xaxt, axis_types) - yaxt = match.arg(yaxt, axis_types) - xaxt = substr(match.arg(xaxt, axis_types), 1L, 1L) - yaxt = substr(match.arg(yaxt, axis_types), 1L, 1L) - axes = any(c(xaxt, yaxt) != "n") - if (is.null(frame.plot) || !is.logical(frame.plot)) frame.plot = all(c(xaxt, yaxt) %in% c("s", "a")) - return(list(axes = axes, xaxt = xaxt, yaxt = yaxt, frame.plot = frame.plot)) -} diff --git a/R/sanitize_axes.R b/R/sanitize_axes.R new file mode 100644 index 00000000..ab3f52ce --- /dev/null +++ b/R/sanitize_axes.R @@ -0,0 +1,30 @@ +sanitize_axes = function(settings) { + list2env(settings[c("axes", "xaxt", "yaxt", "frame.plot")], environment()) + ## handle defaults of axes, xaxt, yaxt, frame.plot + ## - convert axes to character if necessary + ## - set defaults of xaxt/yaxt (if these are NULL) based on axes + ## - set logical axes based on xaxt/yaxt + ## - set frame.plot default based on xaxt/yaxt + if (isFALSE(axes)) { + axes = xaxt = yaxt = "none" + } else if (isTRUE(axes)) { + axes = "standard" + if (is.null(xaxt)) xaxt = get_tpar("xaxt", default = "standard") + if (is.null(yaxt)) yaxt = get_tpar("yaxt", default = "standard") + } else { + xaxt = yaxt = axes + } + axis_types = c("standard", "none", "labels", "ticks", "axis") + axes = match.arg(axes, axis_types) + xaxt = match.arg(xaxt, axis_types) + yaxt = match.arg(yaxt, axis_types) + xaxt = substr(match.arg(xaxt, axis_types), 1L, 1L) + yaxt = substr(match.arg(yaxt, axis_types), 1L, 1L) + axes = any(c(xaxt, yaxt) != "n") + if (is.null(frame.plot) || !is.logical(frame.plot)) frame.plot = all(c(xaxt, yaxt) %in% c("s", "a")) + + + new = list(axes = axes, xaxt = xaxt, yaxt = yaxt, frame.plot = frame.plot) + settings = modifyList(settings, new, keep.null = TRUE) + return(settings) +} diff --git a/R/sanitize_type.R b/R/sanitize_type.R new file mode 100644 index 00000000..727c2bc7 --- /dev/null +++ b/R/sanitize_type.R @@ -0,0 +1,117 @@ +sanitize_type = function(settings) { + list2env(settings, environment()) + + if (inherits(type, "tinyplot_type")) { + settings = modifyList(settings, list( + type = type$name, + type_draw = type$draw, + type_data = type$data + ), keep.null = TRUE) + return(settings) + } + + known_types = c( + "p", "l", "o", "b", "c", "h", "j", "s", "S", "n", + "abline", + "area", + "bar", "barplot", + "box", "boxplot", + "density", + "errorbar", + "function", + "glm", + "hist", "histogram", + "hline", + "j", "jitter", + "lines", + "lm", + "loess", + "pointrange", + "points", + "polygon", "polypath", + "qq", + "rect", + "ribbon", + "ridge", + "rug", + "segments", + "spine", "spineplot", + "spline", + "summary", + "text", + "violin", + "vline" + ) + assert_choice(type, known_types, null.ok = TRUE) + + if (is.null(type)) { + if (!is.null(x) && (is.factor(x) || is.character(x)) && !(is.factor(y) || is.character(y))) { + # enforce boxplot type for y ~ factor(x) + type = type_boxplot + } else if (is.factor(y) || is.character(y)) { + # enforce spineplot type for factor(y) ~ x + type = type_spineplot + } else { + type = "p" + } + } + + if (is.character(type)) { + type = switch(type, + "abline" = type_abline, + "area" = type_area, + "bar" = type_barplot, + "barplot" = type_barplot, + "box" = type_boxplot, + "boxplot" = type_boxplot, + "density" = type_density, + "errorbar" = type_errorbar, + "function" = type_function, + "glm" = type_glm, + "hist" = type_histogram, + "histogram" = type_histogram, + "hline" = type_hline, + "j" = type_jitter, + "jitter" = type_jitter, + "lines" = type_lines, + "lm" = type_lm, + "loess" = type_loess, + "p" = type_points, + "pointrange" = type_pointrange, + "points" = type_points, + "polygon" = type_polygon, + "polypath" = type_polypath, + "qq" = type_qq, + "rect" = type_rect, + "ribbon" = type_ribbon, + "ridge" = type_ridge, + "rug" = type_rug, + "segments" = type_segments, + "spine" = type_spineplot, + "spineplot" = type_spineplot, + "spline" = type_spline, + "summary" = type_summary, + "text" = type_text, + "violin" = type_violin, + "vline" = type_vline, + type # default case + ) + } + + if (is.function(type)) { + args = intersect(names(formals(type)), names(dots)) + args = if (length(args) >= 1L) dots[args] else list() + type = do.call(type, args) + type$dots = dots[setdiff(names(dots), names(args))] + } + + if (inherits(type, "tinyplot_type")) { + settings = modifyList(settings, list( + type = type$name, + type_draw = type$draw, + type_data = type$data + ), keep.null = TRUE) + } + + return(settings) +} diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index f1d3600f..d7c43533 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -1,7 +1,12 @@ -sanitize_xylab = function( - x, xlab = NULL, x_dep = NULL, xmin_dep = NULL, xmax_dep = NULL, - y, ylab = NULL, y_dep = NULL, ymin_dep = NULL, ymax_dep = NULL, - type = NULL) { +sanitize_xylab = function(settings) { + list2env(settings[ + c( + "type", + "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", + "y", "ylab", "y_dep", "ymin_dep", "ymax_dep" + ) + ], environment()) + out_xlab = NULL out_ylab = NULL @@ -50,5 +55,6 @@ sanitize_xylab = function( } out = list(xlab = out_xlab, ylab = out_ylab) - return(out) + settings = modifyList(settings, out, keep.null = TRUE) + return(settings) } diff --git a/R/tinyplot.R b/R/tinyplot.R index b55b6431..37b5dfe4 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -679,6 +679,7 @@ tinyplot.default = function( ## settings container ----- # + dots = list(...) settings = list( # save call to check user input later call = match.call(), @@ -715,12 +716,26 @@ tinyplot.default = function( ymin = ymin, ylab = ylab, ylabs = NULL, + # axes + axes = axes, + xaxt = xaxt, + yaxt = yaxt, + frame.plot = frame.plot, + # flags to check user input that is useful later on + null_by = is.null(by), + was_area_type = identical(type, "area"), # mostly for legend # unevaluated expressions with side effects draw = substitute(draw), + palette = substitute(palette), + legend = if (add) FALSE else substitute(legend), + # ribbon.alpha is overwritten by some type_data() functions + # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots + ribbon.alpha = sanitize_ribbon.alpha(NULL), # extra / unknown arguments - dots = list(...) + dots = dots ) - settings[["user_input"]] <- settings + settings[["raw_input"]] <- settings + # ## devices and files ----- @@ -735,36 +750,33 @@ tinyplot.default = function( # sanitize_type: validates/converts type argument and returns list with name, data, and draw components settings = sanitize_type(settings) - list2env(settings, environment()) - # # area flag (mostly for legend) - was_area_type = identical(type, "area") - - # legend - if (add) legend = FALSE - if (!exists("legend_args")) { - legend_args = dots[["legend_args"]] - dots[["legend_args"]] = NULL + # alias: bg = fill + if (is.null(bg) && !is.null(fill)) settings$bg = fill + + # extract legend_args from dots + if ("legend_args" %in% names(dots)) { + settings$legend_args = settings$dots[["legend_args"]] + settings$dots$legend_args = NULL # avoid passing both directly and via ... + } else { + settings$legend_args = list(x = NULL) } - if (is.null(legend_args)) legend_args = list(x = NULL) - legend = substitute(legend) - # palette - palette = substitute(palette) + # axes + # sanitize_axes: standardizes axis arguments and returns consistent axes, xaxt, yaxt, frame.plot values + settings = sanitize_axes(settings) + + # sanitize xlab & ylab + # generates appropriate axis labels based on input data and plot type + settings = sanitize_xylab(settings) + + list2env(settings, environment()) # themes if (is.null(palette)) palette = get_tpar("palette", default = NULL) if (is.null(pch)) pch = get_tpar("pch", default = NULL) - # alias: bg = fill - if (is.null(bg) && !is.null(fill)) bg = fill - - # ribbon.alpha is overwritten by some type_data() functions - # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots - ribbon.alpha = sanitize_ribbon.alpha(NULL) - # by - null_by = is.null(by) if (!null_by && is.character(by)) by = factor(by) x_by = identical(x, by) # flag if x==by (currently only used for "boxplot", "spineplot" and "ridges" types) @@ -774,22 +786,7 @@ tinyplot.default = function( xlim_user = !is.null(xlim) ylim_user = !is.null(ylim) - # axes - # sanitize_axes: standardizes axis arguments and returns consistent axes, xaxt, yaxt, frame.plot values - tmp = sanitize_axes(axes, xaxt, yaxt, frame.plot) - list2env(tmp[c("axes", "xaxt", "yaxt", "frame.plot")], environment()) - rm("tmp") - - # xlab & ylab - # sanitize_xylab: generates appropriate axis labels based on input data and plot type - tmp = sanitize_xylab( - x = x, xlab = xlab, x_dep = x_dep, xmin_dep = xmin_dep, xmax_dep = xmax_dep, - y = y, ylab = ylab, y_dep = y_dep, ymin_dep = ymin_dep, ymax_dep = ymax_dep, - type = type - ) - xlab = tmp$xlab - ylab = tmp$ylab - rm("tmp") + # facet facet_by = FALSE # flag if facet=="by" (i.e., facet matches the grouping variable) From d138d8dd9315bd8ec320470f8876fc71c34b6b81 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 11:07:33 -0400 Subject: [PATCH 03/54] internal settings: more internal reorg --- R/facet.R | 8 +++--- R/lim.R | 23 ++++++++-------- R/tinyplot.R | 74 +++++++++++++++++++++++----------------------------- R/zzz.R | 4 +-- 4 files changed, 50 insertions(+), 59 deletions(-) diff --git a/R/facet.R b/R/facet.R index 7f580f01..dd5cf05b 100644 --- a/R/facet.R +++ b/R/facet.R @@ -23,8 +23,8 @@ draw_facet_window = function( nfacets, nfacet_cols, nfacet_rows, # axes args axes, flip, frame.plot, oxaxis, oyaxis, - xlabs, xlim, xlim_user, xaxt, xaxs, xaxb, xaxl, - ylabs, ylim, ylim_user, yaxt, yaxs, yaxb, yaxl, + xlabs, xlim, null_xlim, xaxt, xaxs, xaxb, xaxl, + ylabs, ylim, null_ylim, yaxt, yaxs, yaxb, yaxl, asp, log, # other args (in approx. alphabetical + group ordering) dots, @@ -299,8 +299,8 @@ draw_facet_window = function( # individual facet. xfree = split(c(x, xmin, xmax), facet)[[ii]] yfree = split(c(y, ymin, ymax), facet)[[ii]] - if (!xlim_user) xlim = range(xfree, na.rm = TRUE) - if (!ylim_user) ylim = range(yfree, na.rm = TRUE) + if (null_xlim) xlim = range(xfree, na.rm = TRUE) + if (null_ylim) ylim = range(yfree, na.rm = TRUE) xext = extendrange(xlim, f = 0.04) yext = extendrange(ylim, f = 0.04) # We'll save this in a special .fusr env var (list) that we'll re-use diff --git a/R/lim.R b/R/lim.R index 46ed59e2..2448b863 100644 --- a/R/lim.R +++ b/R/lim.R @@ -4,27 +4,26 @@ lim_args = function( datapoints, xlim, ylim, xaxb = NULL, yaxb = NULL, - xlim_user = FALSE, ylim_user = FALSE, - type -) { - + null_xlim = FALSE, null_ylim = FALSE, + type) { if (is.null(xlim)) { - xlim = range(c(datapoints[["x"]], datapoints[["xmin"]], - datapoints[["xmax"]]), finite = TRUE) + xlim = range(c( + datapoints[["x"]], datapoints[["xmin"]], + datapoints[["xmax"]]), finite = TRUE) } if (is.null(ylim)) { - ylim = range(c(datapoints[["y"]], datapoints[["ymin"]], - datapoints[["ymax"]]), finite = TRUE) + ylim = range(c( + datapoints[["y"]], datapoints[["ymin"]], + datapoints[["ymax"]]), finite = TRUE) } if (identical(type, "boxplot")) { xlim = xlim + c(-0.5, 0.5) } - - if (!xlim_user && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) - if (!ylim_user && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) + + if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) + if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) out = list(xlim = xlim, ylim = ylim) return(out) } - diff --git a/R/tinyplot.R b/R/tinyplot.R index 37b5dfe4..224a5543 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -683,10 +683,8 @@ tinyplot.default = function( settings = list( # save call to check user input later call = match.call(), - # save to file - file = file, - width = width, - height = height, + # save to file & device dimensions + file = file, width = width, height = height, # deparsed input for use in labels by_dep = deparse1(substitute(by)), cex_dep = if (!is.null(cex)) deparse1(substitute(cex)) else NULL, @@ -698,24 +696,13 @@ tinyplot.default = function( ymax_dep = if (is.null(ymax)) NULL else deparse1(substitute(ymax)), ymin_dep = if (is.null(ymin)) NULL else deparse1(substitute(ymin)), # types - type = type, - type_data = NULL, - type_draw = NULL, - type_name = NULL, - # type-specific + type = type, type_data = NULL, type_draw = NULL, type_name = NULL, + # type-specific settings bubble = FALSE, ygroup = NULL, # for type_ridge() # data points and labels - x = x, - xmax = xmax, - xmin = xmin, - xlab = xlab, - xlabs = NULL, - y = y, - ymax = ymax, - ymin = ymin, - ylab = ylab, - ylabs = NULL, + x = x, xmax = xmax, xmin = xmin, xlab = xlab, xlabs = NULL, + y = y, ymax = ymax, ymin = ymin, ylab = ylab, ylabs = NULL, # axes axes = axes, xaxt = xaxt, @@ -723,11 +710,17 @@ tinyplot.default = function( frame.plot = frame.plot, # flags to check user input that is useful later on null_by = is.null(by), + null_xlim = is.null(xlim), + null_ylim = is.null(ylim), was_area_type = identical(type, "area"), # mostly for legend # unevaluated expressions with side effects draw = substitute(draw), palette = substitute(palette), legend = if (add) FALSE else substitute(legend), + # aesthetics + lty = lty, lwd = lwd, col = col, bg = bg, + fill = fill, alpha = alpha, cex = cex, + pch = if (is.null(pch)) get_tpar("pch", default = NULL) else pch, # ribbon.alpha is overwritten by some type_data() functions # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots ribbon.alpha = sanitize_ribbon.alpha(NULL), @@ -744,16 +737,11 @@ tinyplot.default = function( setup_device(settings) if (!is.null(settings$file)) on.exit(dev.off(), add = TRUE) + # ## sanitize arguments ----- # - # sanitize_type: validates/converts type argument and returns list with name, data, and draw components - settings = sanitize_type(settings) - - # alias: bg = fill - if (is.null(bg) && !is.null(fill)) settings$bg = fill - # extract legend_args from dots if ("legend_args" %in% names(dots)) { settings$legend_args = settings$dots[["legend_args"]] @@ -762,19 +750,27 @@ tinyplot.default = function( settings$legend_args = list(x = NULL) } - # axes - # sanitize_axes: standardizes axis arguments and returns consistent axes, xaxt, yaxt, frame.plot values + # alias: bg = fill + if (is.null(bg) && !is.null(fill)) settings$bg = fill + + # validate types and returns list with name, data, and draw components + settings = sanitize_type(settings) + + # standardize axis arguments and returns consistent axes, xaxt, yaxt, frame.plot settings = sanitize_axes(settings) - # sanitize xlab & ylab - # generates appropriate axis labels based on input data and plot type + # generate appropriate axis labels based on input data and plot type settings = sanitize_xylab(settings) + # palette default + if (is.null(settings$palette)) { + settings$palette = get_tpar("palette", default = NULL) + } + + + list2env(settings, environment()) - # themes - if (is.null(palette)) palette = get_tpar("palette", default = NULL) - if (is.null(pch)) pch = get_tpar("pch", default = NULL) # by if (!null_by && is.character(by)) by = factor(by) @@ -783,10 +779,6 @@ tinyplot.default = function( # plot limits # flag(s) indicating whether x/ylim was set by the user (needed later for # special case where facets are free but still want to set x/ylim manually) - xlim_user = !is.null(xlim) - ylim_user = !is.null(ylim) - - # facet facet_by = FALSE # flag if facet=="by" (i.e., facet matches the grouping variable) @@ -946,7 +938,7 @@ tinyplot.default = function( datapoints = datapoints, xlim = xlim, ylim = ylim, xaxb = xaxb, yaxb = yaxb, - xlim_user = xlim_user, ylim_user = ylim_user, + null_xlim = null_xlim, null_ylim = null_ylim, type = type )[c("xlim", "ylim")] list2env(fargs, environment()) @@ -1231,8 +1223,8 @@ tinyplot.default = function( # axes args axes = axes, flip = flip, frame.plot = frame.plot, oxaxis = oxaxis, oyaxis = oyaxis, - xlabs = xlabs, xlim = xlim, xlim_user = xlim_user, xaxt = xaxt, xaxs = xaxs, xaxb = xaxb, xaxl = xaxl, - ylabs = ylabs, ylim = ylim, ylim_user = ylim_user, yaxt = yaxt, yaxs = yaxs, yaxb = yaxb, yaxl = yaxl, + xlabs = xlabs, xlim = xlim, null_xlim = null_xlim, xaxt = xaxt, xaxs = xaxs, xaxb = xaxb, xaxl = xaxl, + ylabs = ylabs, ylim = ylim, null_ylim = null_ylim, yaxt = yaxt, yaxs = yaxs, yaxb = yaxb, yaxl = yaxl, asp = asp, log = log, # other args (in approx. alphabetical + group ordering) dots = dots, @@ -1255,8 +1247,8 @@ tinyplot.default = function( nfacets = nfacets, nfacet_cols = nfacet_cols, nfacet_rows = nfacet_rows, axes = axes, flip = flip, frame.plot = frame.plot, oxaxis = oxaxis, oyaxis = oyaxis, - xlabs = xlabs, xlim = xlim, xlim_user = xlim_user, xaxt = xaxt, xaxs = xaxs, xaxb = xaxb, xaxl = xaxl, - ylabs = ylabs, ylim = ylim, ylim_user = ylim_user, yaxt = yaxt, yaxs = yaxs, yaxb = yaxb, yaxl = yaxl, + xlabs = xlabs, xlim = xlim, null_xlim = null_xlim, xaxt = xaxt, xaxs = xaxs, xaxb = xaxb, xaxl = xaxl, + ylabs = ylabs, ylim = ylim, null_ylim = null_ylim, yaxt = yaxt, yaxs = yaxs, yaxb = yaxb, yaxl = yaxl, asp = asp, log = log, dots = dots, draw = draw, diff --git a/R/zzz.R b/R/zzz.R index ddd76daa..b99d6d2f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -49,7 +49,8 @@ "xaxt", "xlabs", "xlim", - "xlim_user", + "null_ylim", + "null_xlim", "xlvls", "xmax", "xmin", @@ -59,7 +60,6 @@ "yaxt", "ylabs", "ylim", - "ylim_user", "ymax", "ymin" )) From cd7706782b9261d7afabc36e45965f4b5ec22234 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 11:38:03 -0400 Subject: [PATCH 04/54] sanitize_facet() --- R/sanitize_datapoints.R | 48 +++++++++++++++++++++++++++++++++++++++++ R/sanitize_facet.R | 26 ++++++++++++++++++++++ R/tinyplot.R | 41 ++++++++++++----------------------- 3 files changed, 88 insertions(+), 27 deletions(-) create mode 100644 R/sanitize_datapoints.R create mode 100644 R/sanitize_facet.R diff --git a/R/sanitize_datapoints.R b/R/sanitize_datapoints.R new file mode 100644 index 00000000..a224b443 --- /dev/null +++ b/R/sanitize_datapoints.R @@ -0,0 +1,48 @@ +sanitize_datapoints = function(settings) { + # potentially useful variables + list2env( + settings[c("x", "xmin", "xmax", "xaxt", "y", "ymin", "ymax", "ygroup", "facet")], + environment()) + + ## coerce character variables to factors + if (!is.null(x) && is.character(x)) x = factor(x) + if (!is.null(y) && is.character(y)) y = factor(y) + + if (is.null(x)) { + ## Special catch for rect and segment plots without a specified y-var + if (type %in% c("rect", "segments")) { + x = rep(NA, length(x)) + } + } + + if (is.null(y)) { + ## Special catch for area and interval plots without a specified y-var + if (type %in% c("rect", "segments", "pointrange", "errorbar", "ribbon")) { + y = rep(NA, length(x)) + } else if (type == "boxplot") { + y = x + x = rep.int("", length(y)) + xaxt = "a" + } else if (!(type %in% c("histogram", "barplot", "density", "function"))) { + y = x + x = seq_along(x) + } + } + + datapoints = list( + x = x, xmin = xmin, xmax = xmax, + y = y, ymin = ymin, ymax = ymax, ygroup = ygroup + ) + datapoints = Filter(function(z) length(z) > 0, datapoints) + datapoints = data.frame(datapoints) + if (nrow(datapoints) > 0) { + datapoints[["rowid"]] = seq_len(nrow(datapoints)) + datapoints[["facet"]] = if (!is.null(facet)) facet else "" + datapoints[["by"]] = if (!null_by) by else "" + } + + # potentially modified variables + new = list(x = x, y = y, xaxt = xaxt, datapoints = datapoints) + settings = modifyList(settings, new, keep.null = TRUE) + return(settings) +} diff --git a/R/sanitize_facet.R b/R/sanitize_facet.R new file mode 100644 index 00000000..d03ab296 --- /dev/null +++ b/R/sanitize_facet.R @@ -0,0 +1,26 @@ +sanitize_facet = function(settings) { + list2env(settings, environment()) + + # flag if facet=="by" (i.e., facet matches the grouping variable) + facet_by = FALSE + if (!is.null(facet) && length(facet) == 1 && facet == "by") { + by = as.factor(by) ## if by==facet, then both need to be factors + facet = by + facet_by = TRUE + } else if (!is.null(facet) && inherits(facet, "formula")) { + facet = get_facet_fml(facet, data = data) + if (isTRUE(attr(facet, "facet_grid"))) { + facet.args[["nrow"]] = attr(facet, "facet_nrow") + } + } + facet_attr = attributes(facet) # TODO: better way to restore facet attributes? + null_facet = is.null(facet) + new = list( + facet = facet, + null_facet = null_facet, + facet_attr = facet_attr, + facet_by = facet_by, + by = by) + settings = modifyList(settings, new, keep.null = TRUE) + return(settings) +} diff --git a/R/tinyplot.R b/R/tinyplot.R index 224a5543..0a77c777 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -715,6 +715,7 @@ tinyplot.default = function( was_area_type = identical(type, "area"), # mostly for legend # unevaluated expressions with side effects draw = substitute(draw), + facet = facet, palette = substitute(palette), legend = if (add) FALSE else substitute(legend), # aesthetics @@ -724,7 +725,8 @@ tinyplot.default = function( # ribbon.alpha is overwritten by some type_data() functions # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots ribbon.alpha = sanitize_ribbon.alpha(NULL), - # extra / unknown arguments + # misc + by = by, dots = dots ) settings[["raw_input"]] <- settings @@ -753,7 +755,7 @@ tinyplot.default = function( # alias: bg = fill if (is.null(bg) && !is.null(fill)) settings$bg = fill - # validate types and returns list with name, data, and draw components + # validate types and returns a list with name, data, and draw components settings = sanitize_type(settings) # standardize axis arguments and returns consistent axes, xaxt, yaxt, frame.plot @@ -767,34 +769,19 @@ tinyplot.default = function( settings$palette = get_tpar("palette", default = NULL) } + # by: coerce character groups to factor + if (!settings$null_by && is.character(settings$by)) { + settings$by = factor(settings$by) + } + # flag if x==by, currently only used for + # "boxplot", "spineplot" and "ridges" types) + settings$x_by = identical(settings$x, settings$by) - list2env(settings, environment()) - - - # by - if (!null_by && is.character(by)) by = factor(by) - x_by = identical(x, by) # flag if x==by (currently only used for "boxplot", "spineplot" and "ridges" types) - - # plot limits - # flag(s) indicating whether x/ylim was set by the user (needed later for - # special case where facets are free but still want to set x/ylim manually) - - # facet - facet_by = FALSE # flag if facet=="by" (i.e., facet matches the grouping variable) - if (!is.null(facet) && length(facet) == 1 && facet == "by") { - by = as.factor(by) ## if by==facet, then both need to be factors - facet = by - facet_by = TRUE - } else if (!is.null(facet) && inherits(facet, "formula")) { - facet = get_facet_fml(facet, data = data) - if (isTRUE(attr(facet, "facet_grid"))) { - facet.args[["nrow"]] = attr(facet, "facet_nrow") - } - } - facet_attr = attributes(facet) # TODO: better way to restore facet attributes? - null_facet = is.null(facet) + # facet: parse facet formula and prepares variables when facet==by + settings = sanitize_facet(settings) + list2env(settings, environment()) # ## datapoints: x, y, etc. ----- From 17718e75340e0e05f0004056fb37c93af5da5bcf Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 11:44:29 -0400 Subject: [PATCH 05/54] sanitize_datapoints() --- R/sanitize_datapoints.R | 2 +- R/tinyplot.R | 48 ++++++----------------------------------- 2 files changed, 8 insertions(+), 42 deletions(-) diff --git a/R/sanitize_datapoints.R b/R/sanitize_datapoints.R index a224b443..9312818b 100644 --- a/R/sanitize_datapoints.R +++ b/R/sanitize_datapoints.R @@ -1,7 +1,7 @@ sanitize_datapoints = function(settings) { # potentially useful variables list2env( - settings[c("x", "xmin", "xmax", "xaxt", "y", "ymin", "ymax", "ygroup", "facet")], + settings[c("x", "xmin", "xmax", "xaxt", "y", "ymin", "ymax", "ygroup", "facet", "null_by", "by", "type")], environment()) ## coerce character variables to factors diff --git a/R/tinyplot.R b/R/tinyplot.R index 0a77c777..e0710ee0 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -781,49 +781,15 @@ tinyplot.default = function( # facet: parse facet formula and prepares variables when facet==by settings = sanitize_facet(settings) - list2env(settings, environment()) - - # - ## datapoints: x, y, etc. ----- - # + # x / y processing + # convert characters to factors + # set x automatically when omitted (ex: rect) + # set y automatically when omitted (ex: boxplots) + # combine x, y, xmax, by, facet etc. into a single `datapoints` data.frame + settings = sanitize_datapoints(settings) - ## coerce character variables to factors - if (!is.null(x) && is.character(x)) x = factor(x) - if (!is.null(y) && is.character(y)) y = factor(y) - - if (is.null(x)) { - ## Special catch for rect and segment plots without a specified y-var - if (type %in% c("rect", "segments")) { - x = rep(NA, length(x)) - } - } - - if (is.null(y)) { - ## Special catch for area and interval plots without a specified y-var - if (type %in% c("rect", "segments", "pointrange", "errorbar", "ribbon")) { - y = rep(NA, length(x)) - } else if (type == "boxplot") { - y = x - x = rep.int("", length(y)) - xaxt = "a" - } else if (!(type %in% c("histogram", "barplot", "density", "function"))) { - y = x - x = seq_along(x) - } - } - - datapoints = list( - x = x, xmin = xmin, xmax = xmax, - y = y, ymin = ymin, ymax = ymax, ygroup = ygroup - ) - datapoints = Filter(function(z) length(z) > 0, datapoints) - datapoints = data.frame(datapoints) - if (nrow(datapoints) > 0) { - datapoints[["rowid"]] = seq_len(nrow(datapoints)) - datapoints[["facet"]] = if (!is.null(facet)) facet else "" - datapoints[["by"]] = if (!null_by) by else "" - } + list2env(settings, environment()) # ## transform datapoints using type_data() ----- From 302f20cd182fddc48c57b9d699e9e0fcffee5c0f Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 12:18:54 -0400 Subject: [PATCH 06/54] some types use settings --- R/tinyplot.R | 66 +++++++++++++++++++++-------------------- R/type_abline.R | 78 ++++++++++++++++++++++++------------------------- R/type_area.R | 17 ++++++----- R/type_glm.R | 14 +++++---- R/type_lm.R | 14 +++++---- 5 files changed, 99 insertions(+), 90 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index e0710ee0..2e63f542 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -799,37 +799,41 @@ tinyplot.default = function( type_info = list() if (!is.null(type_data)) { - fargs = list( - datapoints = datapoints, - bg = bg, - by = by, - col = col, - log = log, - lty = lty, - lwd = lwd, - cex = cex, - facet = facet, - facet_by = facet_by, - facet.args = facet.args, - legend_args = legend_args, - null_by = null_by, - null_facet = null_facet, - palette = palette, - ribbon.alpha = ribbon.alpha, - xaxt = xaxt, - xaxb = xaxb, - xaxl = xaxl, - xlab = xlab, - xlabs = xlabs, - xlim = xlim, - yaxt = yaxt, - yaxb = yaxb, - yaxl = yaxl, - ylab = ylab, - ylim = ylim - ) - fargs = c(fargs, dots) - list2env(do.call(type_data, fargs), environment()) + if ("settings" %in% names(formals(type_data))) { + list2env(type_data(settings, ...), environment()) + } else { + fargs = list( + datapoints = datapoints, + bg = bg, + by = by, + col = col, + log = log, + lty = lty, + lwd = lwd, + cex = cex, + facet = facet, + facet_by = facet_by, + facet.args = facet.args, + legend_args = legend_args, + null_by = null_by, + null_facet = null_facet, + palette = palette, + ribbon.alpha = ribbon.alpha, + xaxt = xaxt, + xaxb = xaxb, + xaxl = xaxl, + xlab = xlab, + xlabs = xlabs, + xlim = xlim, + yaxt = yaxt, + yaxb = yaxb, + yaxl = yaxl, + ylab = ylab, + ylim = ylim + ) + fargs = c(fargs, dots) + list2env(do.call(type_data, fargs), environment()) + } } diff --git a/R/type_abline.R b/R/type_abline.R index 5b039474..a49e92d0 100644 --- a/R/type_abline.R +++ b/R/type_abline.R @@ -5,14 +5,14 @@ #' While `type_abline`, `type_hline`, and `type_vline` can be called in a base #' plot layer, we expect that they will typically be called as subsequent #' layers via [`tinyplot_add`]. -#' @section Recycling logic: +#' @section Recycling logic: #' The recycling behaviour of the line parameters (i.e., `a`, `b`, `h`, or `v`) #' is adaptive, depending on whether `by` or `facet` grouping is detected. While #' this leads to different recycling scenarios, the underlying code logic #' follows sensible heuristics designed to match user expectations. -#' +#' #' Parameter lengths must equal one of four options: -#' +#' #' 1. Single value (i.e., length = 1), i.e. simplest case where the same line is #' applied uniformly across all groups and facets. Uses the default user colour #' (e.g. `"black"`, or `tpar("palette.qualitative")[1]` if a theme is set). @@ -31,66 +31,69 @@ #' will give six separate lines, with the first three (`21:23`) coloured by #' group in the first facet, and second three (`24:26`) coloured by by group #' in the second facet. -#' +#' #' Alongside these general rules, we also try to accomodate special cases when #' other aesthetic parameters like `lwd` or `lty` are invoked by the user. See #' Examples. -#' +#' #' @param a,b the intercept (default: `a` = 0) and slope (default: `b` = 1) #' terms. Numerics of length 1, or equal to the number of groups or number of #' facets (or the product thereof). #' @examples #' # #' ## abline -#' +#' #' tinyplot(x = -10:10, y = rnorm(21) + -10:10, grid = TRUE) #' tinyplot_add(type = "abline") #' # same as... #' # tinyplot_add(type = type_abline(a = 0, b = 1)) -#' +#' #' # customize by passing bespoke intercept and slope values #' tinyplot_add(type = type_abline(a = -1, b = -0.5)) -#' +#' #' # note that calling as abline & co. as a base plot layer will still lead to #' # axes limits that respect the range of the data #' tinyplot(x = -10:10, y = -10:10, grid = TRUE, type = "abline") -#' +#' #' # #' ## hline and vline #' #' # Base plot layer #' tinyplot(mpg ~ hp | cyl, facet = "by", data = mtcars, ylim = c(0, 40)) -#' +#' #' # Add horizontal lines at the (default) 0 y-intercept #' tinyplot_add(type = "hline", col = "grey") -#' +#' #' # Note that group+facet aesthetics will be inherited. We can use this to -#' # add customized lines (here: the mean `mpg` for each `cyl` group) +#' # add customized lines (here: the mean `mpg` for each `cyl` group) #' tinyplot_add(type = type_hline(with(mtcars, tapply(mpg, cyl, mean))), lty = 2) -#' +#' #' # Similar idea for vline #' tinyplot_add(type = type_vline(with(mtcars, tapply(hp, cyl, mean))), lty = 2) -#' +#' #' # #' ## Recycling logic -#' +#' #' # length(h) == no. of groups #' tinyplot(mpg ~ wt | factor(cyl), data = mtcars, type = type_hline(h = 21:23)) -#' +#' #' # length(h) == no. of facets #' tinyplot(mpg ~ wt, facet = ~am, data = mtcars, type = type_hline(h = c(20, 30))) -#' +#' #' # length(h) == no. of groups x no. of facets -#' tinyplot(mpg ~ wt | factor(cyl), facet = ~am, data = mtcars, -#' type = type_hline(h = 21:26)) -#' +#' tinyplot(mpg ~ wt | factor(cyl), +#' facet = ~am, data = mtcars, +#' type = type_hline(h = 21:26)) +#' #' # special adjustment case (here: lwd by group) -#' tinyplot(mpg ~ wt | factor(cyl), facet = ~am, data = mtcars, -#' type = type_hline(c(20, 30)), lwd = c(21, 14, 7)) -#' +#' tinyplot(mpg ~ wt | factor(cyl), +#' facet = ~am, data = mtcars, +#' type = type_hline(c(20, 30)), lwd = c(21, 14, 7)) +#' #' @export type_abline = function(a = 0, b = 1) { - data_abline = function(datapoints, lwd, lty, col, ...) { + data_abline = function(settings, ...) { + list2env(settings[c("datapoints", "lwd", "lty", "col")], environment()) if (nrow(datapoints) == 0) { msg = "`type_abline() only works on existing plots with x and y data points." stop(msg, call. = FALSE) @@ -103,24 +106,21 @@ type_abline = function(a = 0, b = 1) { return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) } draw_abline = function() { - fun = function( - ifacet, iby, data_facet, icol, ilty, ilwd, - ngrps, nfacets, by_continuous, facet_by, - type_info, - ... - ) { - + fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, + ngrps, nfacets, by_continuous, facet_by, + type_info, + ...) { # flag for aesthetics by groups grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps - + if (length(a) != 1) { - if (!length(a) %in% c(ngrps, nfacets, ngrps*nfacets)) { + if (!length(a) %in% c(ngrps, nfacets, ngrps * nfacets)) { msg = "Length of 'a' must be 1, or equal to the number of facets or number of groups (or product thereof)." stop(msg, call. = FALSE) } if (!facet_by && length(a) == nfacets) { a = a[ifacet] - if (!grp_aes && type_info[["ul_col"]]!=ngrps) { + if (!grp_aes && type_info[["ul_col"]] != ngrps) { icol = 1 } else if (by_continuous) { icol = 1 @@ -133,15 +133,15 @@ type_abline = function(a = 0, b = 1) { } else if (!grp_aes) { icol = 1 } - + if (length(b) != 1) { - if (!length(b) %in% c(ngrps, nfacets, ngrps*nfacets)) { + if (!length(b) %in% c(ngrps, nfacets, ngrps * nfacets)) { msg = "Length of 'b' must be 1, or equal to the number of facets or number of groups (or product thereof)." stop(msg, call. = FALSE) } if (!facet_by && length(b) == nfacets) { b = b[ifacet] - if (!grp_aes && type_info[["ul_col"]]!=ngrps) { + if (!grp_aes && type_info[["ul_col"]] != ngrps) { icol = 1 } else if (by_continuous) { icol = 1 @@ -154,8 +154,8 @@ type_abline = function(a = 0, b = 1) { } else if (!grp_aes) { icol = 1 } - - if (type_info[["ul_col"]]!=1 && !(type_info[["ul_lty"]]==ngrps || type_info[["ul_lwd"]]==ngrps)) { + + if (type_info[["ul_col"]] != 1 && !(type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps)) { icol = 1 } diff --git a/R/type_area.R b/R/type_area.R index 4c83cc0b..66ec8343 100644 --- a/R/type_area.R +++ b/R/type_area.R @@ -1,19 +1,20 @@ #' @rdname type_ribbon #' @export type_area = function(alpha = NULL) { - out = list( - draw = NULL, - data = data_area(alpha = alpha), - name = "area" - ) - class(out) = "tinyplot_type" - return(out) + out = list( + draw = NULL, + data = data_area(alpha = alpha), + name = "area" + ) + class(out) = "tinyplot_type" + return(out) } data_area = function(alpha = alpha) { ribbon.alpha = if (is.null(alpha)) .tpar[["ribbon.alpha"]] else (alpha) - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints")], environment()) datapoints$ymax = datapoints$y datapoints$ymin = rep.int(0, nrow(datapoints)) out = list( diff --git a/R/type_glm.R b/R/type_glm.R index e2fd00bd..0329fec3 100644 --- a/R/type_glm.R +++ b/R/type_glm.R @@ -1,8 +1,8 @@ #' Generalized linear model plot type -#' +#' #' @description Type function for plotting a generalized model fit. #' Arguments are passed to \code{\link[stats]{glm}}. -#' +#' #' @param se logical. If TRUE, confidence intervals are drawn. #' @inheritParams stats::glm #' @inheritParams stats::predict.glm @@ -11,7 +11,7 @@ #' @examples #' # "glm" type convenience string #' tinyplot(am ~ mpg, data = mtcars, type = "glm") -#' +#' #' # Use `type_glm()` to pass extra arguments for customization #' tinyplot(am ~ mpg, data = mtcars, type = type_glm(family = "binomial")) #' @export @@ -28,10 +28,13 @@ type_glm = function(family = "gaussian", se = TRUE, level = 0.95, type = "respon data_glm = function(family, se, level, type, ...) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints")], environment()) dat = split(datapoints, list(datapoints$facet, datapoints$by)) dat = lapply(dat, function(x) { - if (nrow(x) == 0) return(x) + if (nrow(x) == 0) { + return(x) + } if (nrow(x) < 3) { x$y = NA return(x) @@ -47,7 +50,6 @@ data_glm = function(family, se, level, type, ...) { nd$y = p$estimate nd$ymax = p$conf.high nd$ymin = p$conf.low - } else { nd$y = predict(fit, newdata = nd, type = type) nd = ci(nd$y, nd$se, level, fit$df.residual, backtransform = stats::family(fit)$linkinv) diff --git a/R/type_lm.R b/R/type_lm.R index bcf598f7..5be5d33b 100644 --- a/R/type_lm.R +++ b/R/type_lm.R @@ -2,17 +2,17 @@ #' #' @description Type function for plotting a linear model fit. #' Arguments are passed to \code{\link[stats]{lm}}. -#' +#' #' @inheritParams type_glm #' @importFrom stats lm predict #' @examples #' # "lm" type convenience string #' tinyplot(Sepal.Width ~ Petal.Width, data = iris, type = "lm") -#' +#' #' # Grouped model fits (here: illustrating an example of Simpson's paradox) #' tinyplot(Sepal.Width ~ Petal.Width | Species, data = iris, type = "lm") #' tinyplot_add(type = "p") -#' +#' #' # Use `type_lm()` to pass extra arguments for customization #' tinyplot(Sepal.Width ~ Petal.Width, data = iris, type = type_lm(level = 0.8)) #' @export @@ -29,10 +29,13 @@ type_lm = function(se = TRUE, level = 0.95) { data_lm = function(se, level, ...) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints")], environment()) dat = split(datapoints, list(datapoints$facet, datapoints$by)) dat = lapply(dat, function(x) { - if (nrow(x) == 0) return(x) + if (nrow(x) == 0) { + return(x) + } if (nrow(x) < 3) { x$y = NA return(x) @@ -59,4 +62,3 @@ data_lm = function(se, level, ...) { } return(fun) } - From 134479a35f4ef5dc81ce483bb79d63b14098e8fe Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 12:34:08 -0400 Subject: [PATCH 07/54] more types use settings vault --- R/type_histogram.R | 68 ++++++++++++++++++++++++--------------------- R/type_hline.R | 21 +++++++------- R/type_jitter.R | 21 +++++++------- R/type_loess.R | 13 ++++----- R/type_pointrange.R | 29 +++++++++---------- R/type_points.R | 62 ++++++++++++++++++++--------------------- R/type_qq.R | 4 ++- R/type_ribbon.R | 46 +++++++++++++++--------------- R/type_ridge.R | 4 ++- R/type_spline.R | 30 ++++++++++---------- R/type_summary.R | 17 +++++++----- R/type_text.R | 4 ++- 12 files changed, 166 insertions(+), 153 deletions(-) diff --git a/R/type_histogram.R b/R/type_histogram.R index 209b1ef6..2b557a84 100644 --- a/R/type_histogram.R +++ b/R/type_histogram.R @@ -1,5 +1,5 @@ #' Histogram plot type -#' +#' #' @md #' @description Type function for histogram plots. `type_hist` is an alias for #' `type_histogram`. @@ -28,53 +28,57 @@ #' @examples #' # "histogram"/"hist" type convenience string(s) #' tinyplot(Nile, type = "histogram") -#' +#' #' # Use `type_histogram()` to pass extra arguments for customization #' tinyplot(Nile, type = type_histogram(breaks = 30)) #' tinyplot(Nile, type = type_histogram(breaks = 30, freq = FALSE)) #' # etc. -#' +#' #' # Grouped histogram example #' tinyplot( -#' ~Petal.Width | Species, +#' ~ Petal.Width | Species, #' type = "histogram", #' data = iris #' ) -#' +#' #' # Faceted version #' tinyplot( -#' ~Petal.Width, facet = ~Species, +#' ~Petal.Width, +#' facet = ~Species, #' type = "histogram", #' data = iris #' ) -#' +#' #' # For visualizing faceted histograms across varying scales, you may also wish #' # to impose free histogram breaks too (i.e., calculate breaks separately for #' # each group). Compare: -#' +#' #' # free facet scales + shared histogram breaks, versus... #' tinyplot( -#' ~Petal.Width, facet = ~Species, +#' ~Petal.Width, +#' facet = ~Species, #' facet.args = list(free = TRUE), #' type = type_histogram(), #' data = iris #' ) #' # ... free facet scales + free histogram breaks #' tinyplot( -#' ~Petal.Width, facet = ~Species, +#' ~Petal.Width, +#' facet = ~Species, #' facet.args = list(free = TRUE), #' type = type_histogram(free = TRUE), #' data = iris #' ) -#' +#' #' @export type_histogram = function(breaks = "Sturges", freq = NULL, right = TRUE, free.breaks = FALSE, drop.zeros = TRUE) { out = list( - data = data_histogram(breaks = breaks, - free.breaks = free.breaks, drop.zeros = drop.zeros, - freq = freq, right = right), + data = data_histogram( + breaks = breaks, + free.breaks = free.breaks, drop.zeros = drop.zeros, + freq = freq, right = right), draw = draw_rect(), name = "histogram" ) @@ -90,17 +94,17 @@ type_hist = type_histogram data_histogram = function(breaks = "Sturges", free.breaks = FALSE, drop.zeros = TRUE, freq = NULL, right = TRUE) { - hbreaks = breaks hfree.breaks = free.breaks hdrop.zeros = drop.zeros hfreq = freq hright = right - - fun = function(by, facet, ylab, col, bg, ribbon.alpha, datapoints, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) { - + + fun = function(settings, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) { + list2env(settings, environment()) + hbreaks = ifelse(!sapply(.breaks, is.null), .breaks, "Sturges") - + if (is.null(by) && is.null(palette)) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "lightgray" @@ -111,7 +115,7 @@ data_histogram = function(breaks = "Sturges", if (!.freebreaks) xbreaks = hist(datapoints$x, breaks = hbreaks, right = .right, plot = FALSE)$breaks datapoints = split(datapoints, list(datapoints$by, datapoints$facet)) datapoints = Filter(function(k) nrow(k) > 0, datapoints) - + datapoints = lapply(datapoints, function(k) { if (.freebreaks) xbreaks = breaks h = hist(k$x, breaks = xbreaks, right = .right, plot = FALSE) @@ -120,10 +124,10 @@ data_histogram = function(breaks = "Sturges", nzidx = which(h$counts > 0) h$density = h$density[nzidx] h$counts = h$counts[nzidx] - h$breaks = h$breaks[c(1, nzidx+1)] + h$breaks = h$breaks[c(1, nzidx + 1)] h$mids = h$mids[nzidx] } - freq = if(!is.null(.freq)) .freq else is.null(.freq) && h$equidist + freq = if (!is.null(.freq)) .freq else is.null(.freq) && h$equidist out = data.frame( by = k$by[1], # already split facet = k$facet[1], # already split @@ -136,23 +140,23 @@ data_histogram = function(breaks = "Sturges", return(out) }) datapoints = do.call(rbind, datapoints) - + if (is.null(ylab)) { ylab = ifelse(datapoints$freq[1], "Frequency", "Density") } out = list( - x = c(datapoints$xmin, datapoints$xmax), + x = c(datapoints$xmin, datapoints$xmax), y = c(datapoints$ymin, datapoints$ymax), - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xmin = datapoints$xmin, - xmax = datapoints$xmax, - ylab = ylab, - col = col, - bg = bg, + ymin = datapoints$ymin, + ymax = datapoints$ymax, + xmin = datapoints$xmin, + xmax = datapoints$xmax, + ylab = ylab, + col = col, + bg = bg, datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, + by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet ) return(out) diff --git a/R/type_hline.R b/R/type_hline.R index 5e392b09..cc17b393 100644 --- a/R/type_hline.R +++ b/R/type_hline.R @@ -4,7 +4,9 @@ #' @export type_hline = function(h = 0) { assert_numeric(h) - data_hline = function(datapoints, lwd, lty, col, ...) { + data_hline = function(settings, ...) { + list2env(settings, environment()) + if (nrow(datapoints) == 0) { msg = "`type_hline() only works on existing plots with x and y data points." stop(msg, call. = FALSE) @@ -17,24 +19,21 @@ type_hline = function(h = 0) { return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) } draw_hline = function() { - fun = function( - ifacet, iby, data_facet, icol, ilty, ilwd, - ngrps, nfacets, by_continuous, facet_by, - type_info, - ... - ) { - + fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, + ngrps, nfacets, by_continuous, facet_by, + type_info, + ...) { # flag for aesthetics by groups grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps - + if (length(h) != 1) { - if (!length(h) %in% c(ngrps, nfacets, ngrps*nfacets)) { + if (!length(h) %in% c(ngrps, nfacets, ngrps * nfacets)) { msg = "Length of 'h' must be 1, or equal to the number of facets or number of groups (or product thereof)." stop(msg, call. = FALSE) } if (!facet_by && length(h) == nfacets) { h = h[ifacet] - if (!grp_aes && type_info[["ul_col"]]!=ngrps) { + if (!grp_aes && type_info[["ul_col"]] != ngrps) { icol = 1 } else if (by_continuous) { icol = 1 diff --git a/R/type_jitter.R b/R/type_jitter.R index 57339df3..eadc7f63 100644 --- a/R/type_jitter.R +++ b/R/type_jitter.R @@ -8,23 +8,25 @@ #' @examples #' # "jitter" type convenience string #' tinyplot(Sepal.Length ~ Species, data = iris, type = "jitter") -#' +#' #' # Use `type_jitter()` to pass extra arguments for customization #' tinyplot(Sepal.Length ~ Species, data = iris, type = type_jitter(factor = 0.5)) #' @export type_jitter = function(factor = 1, amount = NULL) { - out = list( - draw = draw_points(), - data = data_jitter(factor = factor, amount = amount), - name = "p" - ) - class(out) = "tinyplot_type" - return(out) + out = list( + draw = draw_points(), + data = data_jitter(factor = factor, amount = amount), + name = "p" + ) + class(out) = "tinyplot_type" + return(out) } data_jitter = function(factor, amount) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings, environment()) + x = datapoints$x y = datapoints$y if (is.factor(x)) { @@ -59,4 +61,3 @@ data_jitter = function(factor, amount) { return(out) } } - diff --git a/R/type_loess.R b/R/type_loess.R index 3f751d31..4fd597a6 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -1,8 +1,8 @@ #' Local polynomial regression plot type -#' +#' #' @description Type function for plotting a LOESS (LOcal regrESSion) fit. #' Arguments are passed to \code{\link[stats]{loess}}. -#' +#' #' @inheritParams stats::loess #' @param se logical. If `TRUE` (the default), confidence intervals are drawn. #' @param level the confidence level required if `se = TRUE`. Default is 0.95. @@ -10,7 +10,7 @@ #' @examples #' # "loess" type convenience string #' tinyplot(dist ~ speed, data = cars, type = "loess") -#' +#' #' # Use `type_loess()` to pass extra arguments for customization #' tinyplot(dist ~ speed, data = cars, type = type_loess(span = 0.5, degree = 1)) #' @export @@ -20,8 +20,7 @@ type_loess = function( family = "gaussian", control = loess.control(), se = TRUE, - level = 0.95 - ) { + level = 0.95) { out = list( draw = draw_ribbon(), data = data_loess(span = span, degree = degree, family = family, control = control, se = se, level = level), @@ -33,7 +32,8 @@ type_loess = function( data_loess = function(span, degree, family, control, se, level, ...) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings, environment()) datapoints = split(datapoints, list(datapoints$facet, datapoints$by)) datapoints = Filter(function(k) nrow(k) > 0, datapoints) datapoints = lapply(datapoints, function(dat) { @@ -56,4 +56,3 @@ data_loess = function(span, degree, family, control, se, level, ...) { } return(fun) } - diff --git a/R/type_pointrange.R b/R/type_pointrange.R index 340d5a4b..64cfa858 100644 --- a/R/type_pointrange.R +++ b/R/type_pointrange.R @@ -16,19 +16,18 @@ type_pointrange = function(dodge = 0, fixed.pos = FALSE) { draw_pointrange = function() { fun = function( - ix, - iy, - ixmin, - iymin, - ixmax, - iymax, - icol, - ibg, - ipch, - ilwd, - icex, - ... - ) { + ix, + iy, + ixmin, + iymin, + ixmax, + iymax, + icol, + ibg, + ipch, + ilwd, + icex, + ...) { segments( x0 = ixmin, y0 = iymin, @@ -52,7 +51,9 @@ draw_pointrange = function() { data_pointrange = function(dodge, fixed.pos) { - fun = function(datapoints, xlabs, ...) { + fun = function(settings, ...) { + list2env(settings, environment()) + if (is.character(datapoints$x)) { datapoints$x = as.factor(datapoints$x) } diff --git a/R/type_points.R b/R/type_points.R index 8b18a516..529fd171 100644 --- a/R/type_points.R +++ b/R/type_points.R @@ -3,34 +3,33 @@ #' @description Type function for plotting points, i.e. a scatter plot. #' @param clim Numeric giving the lower and upper limits of the character #' expansion (`cex`) normalization for bubble charts. -#' +#' #' @examples #' # "p" type convenience character string #' tinyplot(Sepal.Length ~ Petal.Length, data = iris, type = "p") -#' +#' #' # Same result with type_points() #' tinyplot(Sepal.Length ~ Petal.Length, data = iris, type = type_points()) -#' +#' #' # Note: Specifying the type here is redundant. Like base plot, tinyplot #' # automatically produces a scatter plot if x and y are numeric #' tinyplot(Sepal.Length ~ Petal.Length, data = iris) -#' +#' #' # Grouped scatter plot example #' tinyplot(Sepal.Length ~ Petal.Length | Species, data = iris) -#' +#' #' # Continuous grouping (with gradient legend) #' tinyplot(Sepal.Length ~ Petal.Length | Sepal.Width, data = iris, pch = 19) -#' +#' #' # Bubble chart version #' tinyplot(Sepal.Length ~ Petal.Length, data = iris, cex = iris$Sepal.Width) -#' +#' #' # Fancier version with dual legends and extra customization #' tinyplot(Sepal.Length ~ Petal.Length | Species, -#' data = iris, -#' cex = iris$Sepal.Width, clim = c(1, 5), -#' pch = 21, fill = 0.3) -#' -#' +#' data = iris, +#' cex = iris$Sepal.Width, clim = c(1, 5), +#' pch = 21, fill = 0.3) +#' #' @export type_points = function(clim = c(0.5, 2.5)) { out = list( @@ -43,7 +42,9 @@ type_points = function(clim = c(0.5, 2.5)) { } data_points = function(clim = c(0.5, 2.5)) { - fun = function(datapoints, legend_args, cex = NULL, ...) { + fun = function(settings, cex = NULL, ...) { + list2env(settings, environment()) + # catch for factors (we should still be able to "force" plot these with points) if (is.factor(datapoints$x)) { xlvls = levels(datapoints$x) @@ -65,20 +66,20 @@ data_points = function(clim = c(0.5, 2.5)) { bubble = FALSE bubble_cex = 1 if (!is.null(cex) && length(cex) == nrow(datapoints)) { - bubble = TRUE + 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) + cex = rescale_num(sqrt(c(bubble_labs, cex)) / pi, to = clim) bubble_cex = cex[1:len_labs] - cex = cex[(len_labs+1):length(cex)] + cex = cex[(len_labs + 1):length(cex)] names(bubble_cex) = format(bubble_labs) if (max(clim) > 2.5) { legend_args[["x.intersp"]] = max(clim) / 2.5 legend_args[["y.intersp"]] = sapply(bubble_cex / 2.5, max, 1) } } - + out = list( datapoints = datapoints, xlabs = xlabs, @@ -93,19 +94,18 @@ data_points = function(clim = c(0.5, 2.5)) { } draw_points = function() { - fun = function(ix, iy, icol, ibg, ipch, ilwd, icex, ...) { + fun = function(ix, iy, icol, ibg, ipch, ilwd, icex, ...) { # browser() - points( - x = ix, - y = iy, - col = icol, - bg = ibg, - type = "p", - pch = ipch, - lwd = ilwd, - cex = icex - ) - } - return(fun) + points( + x = ix, + y = iy, + col = icol, + bg = ibg, + type = "p", + pch = ipch, + lwd = ilwd, + cex = icex + ) + } + return(fun) } - diff --git a/R/type_qq.R b/R/type_qq.R index 7e13f656..c32edb22 100644 --- a/R/type_qq.R +++ b/R/type_qq.R @@ -13,7 +13,9 @@ #' @export type_qq = function(distribution = qnorm) { data_qq = function(distribution) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings, environment()) + y = sort(datapoints$y) x = datapoints$x x = distribution(ppoints(x)) diff --git a/R/type_ribbon.R b/R/type_ribbon.R index 8ae70d85..6d6bf4e5 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -1,51 +1,51 @@ #' Ribbon and area plot types -#' +#' #' @param alpha numeric value between 0 and 1 specifying the opacity of ribbon shading -#' If no `alpha` value is provided, then will default to `tpar("ribbon.alpha")` -#' (i.e., probably `0.2` unless this has been overridden by the user in their global +#' If no `alpha` value is provided, then will default to `tpar("ribbon.alpha")` +#' (i.e., probably `0.2` unless this has been overridden by the user in their global #' settings.) #' -#' @description Type constructor functions for producing polygon ribbons, which +#' @description Type constructor functions for producing polygon ribbons, which #' define a `y` interval (usually spanning from `ymin` to `ymax`) for each #' `x` value. Area plots are a special case of ribbon plot where `ymin` is #' set to 0 and `ymax` is set to `y`. -#' +#' #' @examples -#' x = 1:100/10 +#' x = 1:100 / 10 #' y = sin(x) -#' +#' #' # #' ## Ribbon plots -#' +#' #' # "ribbon" convenience string -#' tinyplot(x = x, ymin = y-1, ymax = y+1, type = "ribbon") +#' tinyplot(x = x, ymin = y - 1, ymax = y + 1, type = "ribbon") #' # Same result with type_ribbon() #' tinyplot(x = x, ymin = y-1, ymax = y+1, type = type_ribbon()) -#' +#' #' # y will be added as a line if it is specified #' tinyplot(x = x, y = y, ymin = y-1, ymax = y+1, type = "ribbon") #' #' # #' ## Area plots -#' +#' #' # "area" type convenience string #' tinyplot(x, y, type = "area") -#' +#' #' # Same result with type_area() #' tinyplot(x, y, type = type_area()) -#' +#' #' # Area plots are often used for time series charts #' tinyplot(AirPassengers, type = "area") #' @export type_ribbon = function(alpha = NULL) { - out = list( - draw = draw_ribbon(), - data = data_ribbon(ribbon.alpha = alpha), - name = "ribbon" - ) - class(out) = "tinyplot_type" - return(out) + out = list( + draw = draw_ribbon(), + data = data_ribbon(ribbon.alpha = alpha), + name = "ribbon" + ) + class(out) = "tinyplot_type" + return(out) } @@ -92,10 +92,10 @@ data_ribbon = function(ribbon.alpha = NULL) { } # Reorder x, y, ymin, and ymax based on the order determined - datapoints = datapoints[xord,] + datapoints = datapoints[xord, ] - # Catch for missing ymin and ymax - if (is.null(datapoints$ymin)) datapoints$ymin = datapoints$y + # Catch for missing ymin and ymax + if (is.null(datapoints$ymin)) datapoints$ymin = datapoints$y if (is.null(datapoints$ymax)) datapoints$ymax = datapoints$y out = list( diff --git a/R/type_ridge.R b/R/type_ridge.R index aa492980..c31e6850 100644 --- a/R/type_ridge.R +++ b/R/type_ridge.R @@ -252,7 +252,9 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, col = NULL, alpha = NULL ) { - fun = function(datapoints, yaxt = NULL, null_by, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints", "yaxt", "xaxt", "null_by")], environment()) + # catch for special cases anyby = !null_by x_by = anyby && identical(datapoints$x, datapoints$by) diff --git a/R/type_spline.R b/R/type_spline.R index 332db948..7ba39dc0 100644 --- a/R/type_spline.R +++ b/R/type_spline.R @@ -1,28 +1,27 @@ #' Spline plot type -#' +#' #' @description Type function for plotting a cubic (or Hermite) spline interpolation. #' Arguments are passed to \code{\link[stats]{spline}}; see this latter function #' for default argument values. -#' +#' #' @inheritParams stats::spline #' @inherit stats::spline details #' @importFrom stats spline #' @examples #' # "spline" type convenience string #' tinyplot(dist ~ speed, data = cars, type = "spline") -#' +#' #' # Use `type_spline()` to pass extra arguments for customization -#' tinyplot(dist ~ speed, data = cars, type = type_spline(method = "natural", n = 25), +#' tinyplot(dist ~ speed, +#' data = cars, type = type_spline(method = "natural", n = 25), #' add = TRUE, lty = 2) #' @export -type_spline = function( - n = NULL, - method = "fmm", - xmin = NULL, - xmax = NULL, - xout = NULL, - ties = mean - ) { +type_spline = function(n = NULL, + method = "fmm", + xmin = NULL, + xmax = NULL, + xout = NULL, + ties = mean) { out = list( draw = draw_lines(), data = data_spline(method = method, ties = ties, n = n, xmin = xmin, xmax = xmax, xout = xout), @@ -34,10 +33,12 @@ type_spline = function( data_spline = function(n, method, xmin, xmax, xout, ties, ...) { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + list2env(settings, environment()) + datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { - if (is.null(n)) n = 3*length(dat$x) + if (is.null(n)) n = 3 * length(dat$x) if (is.null(xmax)) xmax = max(dat$x) if (is.null(xmin)) xmin = min(dat$x) if (is.null(xout)) { @@ -57,4 +58,3 @@ data_spline = function(n, method, xmin, xmax, xout, ties, ...) { } return(fun) } - diff --git a/R/type_summary.R b/R/type_summary.R index 90d9fcdf..743f2a56 100644 --- a/R/type_summary.R +++ b/R/type_summary.R @@ -16,30 +16,33 @@ #' @examples #' # Plot the mean chick weight over time #' tinyplot(weight ~ Time, data = ChickWeight, type = "summary") -#' +#' #' # Note: "mean" is the default function, so these are also equivalent: #' # tinyplot(weight ~ Time, data = ChickWeight, type = type_summary()) #' # tinyplot(weight ~ Time, data = ChickWeight, type = type_summary(mean)) -#' +#' #' # Plot the median instead #' tinyplot(weight ~ Time, data = ChickWeight, type = type_summary(median)) -#' +#' #' # Works with groups and/or facets too #' tinyplot(weight ~ Time | Diet, facet = "by", data = ChickWeight, type = "summary") #' #' # Custom/complex function example #' tinyplot( -#' weight ~ Time | Diet, facet = "by", data = ChickWeight, -#' type = type_summary(function(y) quantile(y, probs = 0.9)/max(y)) +#' weight ~ Time | Diet, +#' facet = "by", data = ChickWeight, +#' type = type_summary(function(y) quantile(y, probs = 0.9) / max(y)) #' ) -#' +#' #' @importFrom stats ave #' @export type_summary = function(fun = mean, ...) { assert_function(fun) lines_args = list(...) data_summary = function(fun) { - funky = function(datapoints, ...) { + funky = function(settings, ...) { + list2env(settings, environment()) + datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { newy = ave(dat$y, dat$x, FUN = fun) diff --git a/R/type_text.R b/R/type_text.R index 3a129393..dcf16bae 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -45,7 +45,9 @@ type_text = function(labels, adj = NULL, pos = NULL, offset = 0.5, vfont = NULL, } data_text = function(labels, clim = c(0.5, 2.5)) { - fun = function(datapoints, legend_args, cex = NULL, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints", "legend_args", "cex")], environment()) + if (length(labels) != 1 && length(labels) != nrow(datapoints)) { msg = sprintf("`labels` must be of length 1 or %s.", nrow(datapoints)) stop(msg, call. = FALSE) From ce17c173eea8c6173add0e1d58f9cb0828989cb8 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 15:41:41 -0700 Subject: [PATCH 08/54] more types --- R/tinyplot.R | 8 +++++--- R/type_function.R | 8 +++++--- R/type_vline.R | 22 ++++++++++------------ 3 files changed, 20 insertions(+), 18 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 2e63f542..c72a93f0 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -705,9 +705,11 @@ tinyplot.default = function( y = y, ymax = ymax, ymin = ymin, ylab = ylab, ylabs = NULL, # axes axes = axes, - xaxt = xaxt, - yaxt = yaxt, + xaxt = xaxt, xaxb = xaxb, xaxl = xaxl, + yaxt = yaxt, yaxb = yaxb, yaxl = yaxl, frame.plot = frame.plot, + xlim = xlim, + ylim = ylim, # flags to check user input that is useful later on null_by = is.null(by), null_xlim = is.null(xlim), @@ -716,6 +718,7 @@ tinyplot.default = function( # unevaluated expressions with side effects draw = substitute(draw), facet = facet, + facet.args = facet.args, palette = substitute(palette), legend = if (add) FALSE else substitute(legend), # aesthetics @@ -837,7 +840,6 @@ tinyplot.default = function( } - # flip -> swap x and y, except for boxplots (which has its own bespoke flip logic) assert_flag(flip) if (isTRUE(flip)) { diff --git a/R/type_function.R b/R/type_function.R index 397742e8..2c525493 100644 --- a/R/type_function.R +++ b/R/type_function.R @@ -10,7 +10,7 @@ #' @param ... Additional arguments are passed to the `lines()` function, #' ex: `type="p"`, `col="pink"`. #' @importFrom stats dnorm -#' +#' #' @examples #' # Plot the normal density (default function) #' tinyplot(x = -4:4, type = "function") @@ -26,7 +26,7 @@ #' fun = dnorm, #' col = "pink", type = "p", pch = 3 #' )) -#' +#' #' # Custom function example #' ## (Here using `function(x)`, but you could also use the shorter `\(x)` #' ## anonymous function syntax introduced in R 4.1.0) @@ -37,7 +37,9 @@ type_function = function(fun = dnorm, args = list(), n = 101, ...) { assert_function(fun) lines_args = list(...) data_function = function(args, fun) { - funky = function(xlim, ylim, datapoints, ...) { + funky = function(settings, ...) { + list2env(settings[c("xlim", "ylim", "datapoints")], environment()) + if (nrow(datapoints) == 0 || !"x" %in% names(datapoints)) { stop("Need to provide x values to plot the function.", call. = FALSE) } diff --git a/R/type_vline.R b/R/type_vline.R index aefad8f0..4458f7d3 100644 --- a/R/type_vline.R +++ b/R/type_vline.R @@ -4,7 +4,8 @@ #' @export type_vline = function(v = 0) { assert_numeric(v) - data_vline = function(datapoints, lwd, lty, col, ...) { + data_vline = function(settings, ...) { + list2env(settings[c("datapoints", "lwd", "lty", "col")], envir = environment()) if (nrow(datapoints) == 0) { msg = "`type_vline() only works on existing plots with x and y data points." stop(msg, call. = FALSE) @@ -17,24 +18,21 @@ type_vline = function(v = 0) { return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) } draw_vline = function() { - fun = function( - ifacet, iby, data_facet, icol, ilty, ilwd, - ngrps, nfacets, by_continuous, facet_by, - type_info, - ... - ) { - + fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, + ngrps, nfacets, by_continuous, facet_by, + type_info, + ...) { # flag for aesthetics by groups grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps - + if (length(v) != 1) { - if (!length(v) %in% c(ngrps, nfacets, ngrps*nfacets)) { + if (!length(v) %in% c(ngrps, nfacets, ngrps * nfacets)) { msg = "Length of 'v' must be 1, or equal to the number of facets or number of groups (or product thereof)." stop(msg, call. = FALSE) } if (!facet_by && length(v) == nfacets) { v = v[ifacet] - if (!grp_aes && type_info[["ul_col"]]!=ngrps) { + if (!grp_aes && type_info[["ul_col"]] != ngrps) { icol = 1 } else if (by_continuous) { icol = 1 @@ -47,7 +45,7 @@ type_vline = function(v = 0) { } else if (!grp_aes) { icol = 1 } - + abline(v = v, col = icol, lty = ilty, lwd = ilwd) } return(fun) From a913e12e45e593110293a663d201bdb247f94179 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 10 Sep 2025 15:43:38 -0700 Subject: [PATCH 09/54] minor tinyplot --- R/tinyplot.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index c72a93f0..a32f9d67 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -791,7 +791,6 @@ tinyplot.default = function( # combine x, y, xmax, by, facet etc. into a single `datapoints` data.frame settings = sanitize_datapoints(settings) - list2env(settings, environment()) # @@ -802,9 +801,14 @@ tinyplot.default = function( type_info = list() if (!is.null(type_data)) { - if ("settings" %in% names(formals(type_data))) { + after_refactor = "settings" %in% names(formals(type_data)) + + if (after_refactor) { list2env(type_data(settings, ...), environment()) - } else { + } + + # the next long chunk would be remove after a full refactor + if (!after_refactor) { fargs = list( datapoints = datapoints, bg = bg, From cf0a56d3a246d2fa76570c49a43953bed7f96ec9 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 20:30:13 -0400 Subject: [PATCH 10/54] type_text uses settings container --- R/type_text.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/type_text.R b/R/type_text.R index 90ca2819..4c8635d6 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -85,7 +85,8 @@ type_text = function( } data_text = function(labels = NULL, clim = c(0.5, 2.5)) { - fun = function(datapoints, legend_args, cex = NULL, ...) { + fun = function(settings, cex = NULL, ...) { + list2env(settings, envir = environment()) if (is.null(labels)) { labels = datapoints$y } From 45a24f64e44294f49f9ecb709a5c384f3fcc5921 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 20:37:18 -0400 Subject: [PATCH 11/54] type_rug uses settings container --- R/type_rug.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/type_rug.R b/R/type_rug.R index 57359fb1..3d079392 100644 --- a/R/type_rug.R +++ b/R/type_rug.R @@ -33,7 +33,8 @@ #' @importFrom graphics rug #' @export type_rug = function(ticksize = 0.03, side = 1, quiet = getOption("warn") < 0, jitter = FALSE, amount = NULL) { - data_rug = function(datapoints, ...) { + data_rug = function(settings, ...) { + list2env(settings["datapoints"], envir = environment()) if (nrow(datapoints) == 0) { msg = "`type_rug() only works on existing plots with x and y data points." stop(msg, call. = FALSE) From 6911823dd2464e3add1810a45e56e2356ccc4e2e Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 20:39:37 -0400 Subject: [PATCH 12/54] type_ribbon uses settings container --- R/type_ribbon.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/type_ribbon.R b/R/type_ribbon.R index 6d6bf4e5..90eaca84 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -66,7 +66,8 @@ draw_ribbon = function() { data_ribbon = function(ribbon.alpha = NULL) { ribbon.alpha = sanitize_ribbon.alpha(ribbon.alpha) - fun = function(datapoints, xlabs, null_by, null_facet, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints", "xlabs", "null_by", "null_facet")], environment()) # Convert x to factor if it's not already if (is.character(datapoints$x)) { datapoints$x = as.factor(datapoints$x) From fecde6653df792c984d994344294ac52bb102d70 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 20:44:38 -0400 Subject: [PATCH 13/54] type_density uses settings container --- R/type_density.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/type_density.R b/R/type_density.R index bdfe4217..cd419cb4 100644 --- a/R/type_density.R +++ b/R/type_density.R @@ -111,8 +111,8 @@ type_density = function( data_density = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, joint.bw = "none", alpha = NULL) { - fun = function(by, facet, ylab, col, bg, ribbon.alpha, datapoints, ...) { - + fun = function(settings, ...) { + list2env(settings[c("by", "bg", "facet", "ylab", "col", "ribbon.alpha", "datapoints")], environment()) ribbon.alpha = if (is.null(alpha)) .tpar[["ribbon.alpha"]] else (alpha) if (is.null(ylab)) ylab = "Density" From 289c377f0ff3face7ff92792a2cb41f579937bd2 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 21:18:17 -0400 Subject: [PATCH 14/54] type_boxplot uses settings container --- R/tinyplot.R | 2 +- R/type_boxplot.R | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 11a32e93..53d54ac6 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -789,7 +789,7 @@ tinyplot.default = function( # palette default if (is.null(settings$palette)) { - settings$palette = get_tpar("palette", default = NULL) + settings = modifyList(settings, list(palette = get_tpar("palette", default = NULL))) } # by: coerce character groups to factor diff --git a/R/type_boxplot.R b/R/type_boxplot.R index 19584370..74c75077 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -94,7 +94,8 @@ draw_boxplot = function(range, width, varwidth, notch, outline, boxwex, staplewe data_boxplot = function() { - fun = function(datapoints, bg, col, palette, null_by, null_facet, ...) { + fun = function(settings, ...) { + list2env(settings, envir = environment()) # Convert x to factor if it's not already datapoints$x = as.factor(datapoints$x) @@ -114,11 +115,13 @@ data_boxplot = function() { xord = order(datapoints$by, datapoints$facet, datapoints$x) } - if (length(unique(datapoints[["by"]])) == 1 && is.null(palette)) { + # Check if user provided palette from raw_input (before substitute) + user_palette = raw_input$palette + if (length(unique(datapoints[["by"]])) == 1 && is.null(user_palette)) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "lightgray" } else { - bg = "by" + if (is.null(bg)) bg = "by" } # Reorder x, y, ymin, and ymax based on the order determined From 90638735b4f195cfe4be86942173fc2c0471393b Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 21:20:35 -0400 Subject: [PATCH 15/54] type_splineplot uses settings container --- R/type_spineplot.R | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/R/type_spineplot.R b/R/type_spineplot.R index f28c5bd1..220bd2db 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -78,15 +78,8 @@ type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, xlevels = #' @importFrom grDevices nclass.Sturges data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels = ylevels, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) { - fun = function( - datapoints, - by = NULL, col = NULL, bg = NULL, palette = NULL, - facet = NULL, facet.args = NULL, - xlim = NULL, ylim = NULL, - axes = TRUE, xaxt = NULL, yaxt = NULL, xaxb = NULL, yaxb = NULL, - null_by, null_facet, - ... - ) { + fun = function(settings, ...) { + list2env(settings, environment()) ## process weights if (!is.null(weights)) { @@ -246,7 +239,7 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels if (isTRUE(y_by)) datapoints$by = factor(rep_len(yaxlabels, nrow(datapoints))) ## grayscale flag - grayscale = null_by && is.null(palette) && is.null(.tpar[["palette.qualitative"]]) + grayscale = null_by && is.null(raw_input$palette) && is.null(.tpar[["palette.qualitative"]]) out = list( x = c(datapoints$xmin, datapoints$xmax), From 8093b0b4048684718ccfa2f3fee9d5ca5b391b97 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 21:42:26 -0400 Subject: [PATCH 16/54] type_barplot uses settings container --- R/tinyplot.R | 1 - R/type_barplot.R | 6 +++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 53d54ac6..f758d986 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -680,7 +680,6 @@ tinyplot.default = function( # Ephemeral theme if (!is.null(theme)) { - # browser() if (is.character(theme) && length(theme) == 1) { tinytheme(theme) } else if (is.list(theme)) { diff --git a/R/type_barplot.R b/R/type_barplot.R index cea11c0d..9fd2993e 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -78,9 +78,9 @@ type_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, #' @importFrom stats aggregate data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, xlevels = NULL, xaxlabels = NULL, drop.zeros = FALSE) { - fun = function(datapoints, col, bg, lty, lwd, palette, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, xaxt = NULL, yaxl = NULL, yaxt = NULL, axes = TRUE, null_by, facet_by, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "raw_input", "col", "bg", "yaxl", "xaxt")], environment()) - ## tabulate/aggregate datapoints if (is.null(datapoints$y)) { xlab = ylab @@ -131,7 +131,7 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, ## default color palette ngrps = length(unique(datapoints$by)) - if (ngrps == 1L && is.null(palette)) { + if (ngrps == 1L && is.null(raw_input$palette)) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "grey" } else { From 166ba7307cd99659981136d6cd6f76387c0aac6b Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 21:47:44 -0400 Subject: [PATCH 17/54] all types use settings container --- R/tinyplot.R | 43 ++----------------------------------------- R/type_violin.R | 7 +++++-- 2 files changed, 7 insertions(+), 43 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index f758d986..835fd836 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -741,7 +741,7 @@ tinyplot.default = function( palette = substitute(palette), legend = if (add) FALSE else substitute(legend), # aesthetics - lty = lty, lwd = lwd, col = col, bg = bg, + lty = lty, lwd = lwd, col = col, bg = bg, log = log, fill = fill, alpha = alpha, cex = cex, pch = if (is.null(pch)) get_tpar("pch", default = NULL) else pch, # ribbon.alpha is overwritten by some type_data() functions @@ -820,46 +820,7 @@ tinyplot.default = function( type_info = list() if (!is.null(type_data)) { - after_refactor = "settings" %in% names(formals(type_data)) - - if (after_refactor) { - list2env(type_data(settings, ...), environment()) - } - - # the next long chunk would be remove after a full refactor - if (!after_refactor) { - fargs = list( - datapoints = datapoints, - bg = bg, - by = by, - col = col, - log = log, - lty = lty, - lwd = lwd, - cex = cex, - facet = facet, - facet_by = facet_by, - facet.args = facet.args, - legend_args = legend_args, - null_by = null_by, - null_facet = null_facet, - palette = palette, - ribbon.alpha = ribbon.alpha, - xaxt = xaxt, - xaxb = xaxb, - xaxl = xaxl, - xlab = xlab, - xlabs = xlabs, - xlim = xlim, - yaxt = yaxt, - yaxb = yaxb, - yaxl = yaxl, - ylab = ylab, - ylim = ylim - ) - fargs = c(fargs, dots) - list2env(do.call(type_data, fargs), environment()) - } + list2env(type_data(settings, ...), environment()) } diff --git a/R/type_violin.R b/R/type_violin.R index 30b66561..c448ae31 100644 --- a/R/type_violin.R +++ b/R/type_violin.R @@ -78,7 +78,10 @@ type_violin = function( data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, joint.bw = "none", trim = FALSE, width = 0.9) { - fun = function(datapoints, by, facet, ylab, col, bg, palette, log, null_by, null_facet, ...) { + fun = function(settings, ...) { + list2env(settings[c("datapoints", "by", "raw_input", "facet", "ylab", "col", "bg", "log", "null_by", "null_facet")], + environment()) + # Handle ordering based on by and facet variables ngrps = if (null_by) 1 else length(unique(datapoints$by)) @@ -122,7 +125,7 @@ data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, xord = order(datapoints$by, datapoints$facet, datapoints$x) } - if (length(unique(datapoints[["by"]])) == 1 && is.null(palette)) { + if (length(unique(datapoints[["by"]])) == 1 && is.null(raw_input$palette)) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "lightgray" } else if (is.null(bg)) { From 8ecb589bd4c0795f2623b798e71d3a433b6138d5 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 2 Oct 2025 22:46:41 -0400 Subject: [PATCH 18/54] type_data() returns settings containers for all types --- R/sanitize_xylab.R | 2 +- R/tinyplot.R | 10 ++++++---- R/type_abline.R | 4 +++- R/type_area.R | 1 + R/type_barplot.R | 1 + R/type_boxplot.R | 1 + R/type_density.R | 1 + R/type_function.R | 1 + R/type_glm.R | 1 + R/type_histogram.R | 3 +++ R/type_hline.R | 4 +++- R/type_jitter.R | 1 + R/type_lm.R | 1 + R/type_loess.R | 1 + R/type_pointrange.R | 1 + R/type_points.R | 1 + R/type_qq.R | 1 + R/type_ribbon.R | 1 + R/type_ridge.R | 1 + R/type_rug.R | 4 +++- R/type_spineplot.R | 1 + R/type_spline.R | 1 + R/type_summary.R | 1 + R/type_text.R | 1 + R/type_violin.R | 1 + R/type_vline.R | 5 ++++- R/utils.R | 6 ++++++ 27 files changed, 48 insertions(+), 9 deletions(-) diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index d7c43533..26e98a78 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -55,6 +55,6 @@ sanitize_xylab = function(settings) { } out = list(xlab = out_xlab, ylab = out_ylab) - settings = modifyList(settings, out, keep.null = TRUE) + settings = modify_list(settings, out) return(settings) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 835fd836..d0df040f 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -810,20 +810,22 @@ tinyplot.default = function( # combine x, y, xmax, by, facet etc. into a single `datapoints` data.frame settings = sanitize_datapoints(settings) - list2env(settings, environment()) # ## transform datapoints using type_data() ----- # # type_info: initialize a list to pass type-specific information from type_data() to type_draw() - type_info = list() + settings$type_info = list() - if (!is.null(type_data)) { - list2env(type_data(settings, ...), environment()) + if (!is.null(settings$type_data)) { + settings = settings$type_data(settings, ...) } + + list2env(settings, environment()) + # flip -> swap x and y, except for boxplots (which has its own bespoke flip logic) assert_flag(flip) if (isTRUE(flip)) { diff --git a/R/type_abline.R b/R/type_abline.R index a49e92d0..a378b984 100644 --- a/R/type_abline.R +++ b/R/type_abline.R @@ -103,7 +103,9 @@ type_abline = function(a = 0, b = 1) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) + out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + out = modify_list(settings, out) + return(out) } draw_abline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_area.R b/R/type_area.R index 66ec8343..7a8b21a1 100644 --- a/R/type_area.R +++ b/R/type_area.R @@ -24,6 +24,7 @@ data_area = function(alpha = alpha) { type = "ribbon", ribbon.alpha = ribbon.alpha ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_barplot.R b/R/type_barplot.R index 9fd2993e..4bd5cad6 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -204,6 +204,7 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, col = col, bg = bg ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_boxplot.R b/R/type_boxplot.R index 74c75077..5c8c6d50 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -141,6 +141,7 @@ data_boxplot = function() { if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_density.R b/R/type_density.R index cd419cb4..3e71fb76 100644 --- a/R/type_density.R +++ b/R/type_density.R @@ -160,6 +160,7 @@ data_density = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_function.R b/R/type_function.R index 2c525493..baef6ccd 100644 --- a/R/type_function.R +++ b/R/type_function.R @@ -55,6 +55,7 @@ type_function = function(fun = dnorm, args = list(), n = 101, ...) { ylim = c(min(tmp), max(tmp)) } out = list(xlim = xlim, ylim = ylim) + out = modify_list(settings, out) return(out) } } diff --git a/R/type_glm.R b/R/type_glm.R index 0329fec3..eba6be17 100644 --- a/R/type_glm.R +++ b/R/type_glm.R @@ -62,6 +62,7 @@ data_glm = function(family, se, level, type, ...) { datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_histogram.R b/R/type_histogram.R index 2b557a84..7ef7a32e 100644 --- a/R/type_histogram.R +++ b/R/type_histogram.R @@ -159,6 +159,9 @@ data_histogram = function(breaks = "Sturges", by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet ) + # browser() + out = modify_list(settings, out) + # out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_hline.R b/R/type_hline.R index cc17b393..5d02cc65 100644 --- a/R/type_hline.R +++ b/R/type_hline.R @@ -16,7 +16,9 @@ type_hline = function(h = 0) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) + out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + out = modify_list(settings, out) + return(out) } draw_hline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_jitter.R b/R/type_jitter.R index eadc7f63..a2ba0274 100644 --- a/R/type_jitter.R +++ b/R/type_jitter.R @@ -58,6 +58,7 @@ data_jitter = function(factor, amount) { xlabs = xlabs, ylabs = ylabs ) + out = modify_list(settings, out) return(out) } } diff --git a/R/type_lm.R b/R/type_lm.R index 5be5d33b..398672ed 100644 --- a/R/type_lm.R +++ b/R/type_lm.R @@ -58,6 +58,7 @@ data_lm = function(se, level, ...) { datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_loess.R b/R/type_loess.R index 4fd597a6..cba5f664 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -52,6 +52,7 @@ data_loess = function(span, degree, family, control, se, level, ...) { datapoints = do.call(rbind, datapoints) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_pointrange.R b/R/type_pointrange.R index 64cfa858..1f4f0b7a 100644 --- a/R/type_pointrange.R +++ b/R/type_pointrange.R @@ -98,6 +98,7 @@ data_pointrange = function(dodge, fixed.pos) { datapoints = datapoints ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_points.R b/R/type_points.R index d7adfcdc..7fad968a 100644 --- a/R/type_points.R +++ b/R/type_points.R @@ -94,6 +94,7 @@ data_points = function(clim = c(0.5, 2.5)) { bubble_cex = bubble_cex, legend_args = legend_args ) + out = modify_list(settings, out) return(out) } } diff --git a/R/type_qq.R b/R/type_qq.R index c32edb22..c063b772 100644 --- a/R/type_qq.R +++ b/R/type_qq.R @@ -22,6 +22,7 @@ type_qq = function(distribution = qnorm) { datapoints$x = x datapoints$y = y out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } } diff --git a/R/type_ribbon.R b/R/type_ribbon.R index 90eaca84..3b13546a 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -111,6 +111,7 @@ data_ribbon = function(ribbon.alpha = NULL) { if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_ridge.R b/R/type_ridge.R index c31e6850..df9ed8e4 100644 --- a/R/type_ridge.R +++ b/R/type_ridge.R @@ -410,6 +410,7 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, alpha = alpha ) ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_rug.R b/R/type_rug.R index 3d079392..a4ad31c3 100644 --- a/R/type_rug.R +++ b/R/type_rug.R @@ -39,7 +39,9 @@ type_rug = function(ticksize = 0.03, side = 1, quiet = getOption("warn") < 0, ji msg = "`type_rug() only works on existing plots with x and y data points." stop(msg, call. = FALSE) } - return(datapoints) + + out = modifyList(settings, list(datapoints = datapoints), keep.null = TRUE) + return(out) } draw_rug = function(.ticksize = ticksize, .side = side, .quiet = quiet, .jitter = jitter, .amount = amount) { fun = function(ix, iy, icol, ilwd, ...) { diff --git a/R/type_spineplot.R b/R/type_spineplot.R index 220bd2db..baf18a6b 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -280,6 +280,7 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels facet.args = facet.args ) + out = modify_list(settings, out) return(out) } diff --git a/R/type_spline.R b/R/type_spline.R index 7ba39dc0..6d8605f8 100644 --- a/R/type_spline.R +++ b/R/type_spline.R @@ -54,6 +54,7 @@ data_spline = function(n, method, xmin, xmax, xout, ties, ...) { }) datapoints = do.call(rbind, datapoints) out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_summary.R b/R/type_summary.R index 743f2a56..bab6d99c 100644 --- a/R/type_summary.R +++ b/R/type_summary.R @@ -52,6 +52,7 @@ type_summary = function(fun = mean, ...) { }) datapoints = do.call(rbind, datapoints) out = list(datapoints = datapoints) + out = modify_list(settings, out) return(out) } return(funky) diff --git a/R/type_text.R b/R/type_text.R index 4c8635d6..707e0278 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -131,6 +131,7 @@ data_text = function(labels = NULL, clim = c(0.5, 2.5)) { bubble = bubble, bubble_cex = bubble_cex ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_violin.R b/R/type_violin.R index c448ae31..a312ecc1 100644 --- a/R/type_violin.R +++ b/R/type_violin.R @@ -215,6 +215,7 @@ data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, col = col, bg = bg ) + out = modify_list(settings, out) return(out) } return(fun) diff --git a/R/type_vline.R b/R/type_vline.R index 4458f7d3..985a5f3d 100644 --- a/R/type_vline.R +++ b/R/type_vline.R @@ -15,7 +15,10 @@ type_vline = function(v = 0) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - return(list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col))) + + out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + out = modify_list(settings, out) + return(out) } draw_vline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/utils.R b/R/utils.R index 9443a7c2..b419d3ea 100644 --- a/R/utils.R +++ b/R/utils.R @@ -66,3 +66,9 @@ swap_columns = function(dp, a, b) { dp[[b]] = if (!is.null(va)) va else NULL dp } + + +modify_list = function(a, b) { + a = a[setdiff(names(a), names(b))] + c(a, b) +} From 59ffc4771f6134dd0a39756de0b6aaa9a51b520c Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 00:23:08 -0400 Subject: [PATCH 19/54] flip almost works --- R/flip.R | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ R/tinyplot.R | 30 +++++------------------------- 2 files changed, 55 insertions(+), 25 deletions(-) create mode 100644 R/flip.R diff --git a/R/flip.R b/R/flip.R new file mode 100644 index 00000000..c3fee91f --- /dev/null +++ b/R/flip.R @@ -0,0 +1,50 @@ +swap_elements = function(lst, a, b) { + if (any(!c(a, b) %in% names(lst))) { + out = lst + } else if (all(c(a, b) %in% names(lst))) { + out = modify_list(lst, setNames(lst[c(b, a)], c(a, b))) + } else if (a %in% names(lst)) { + out = modify_list(lst, setNames(list(NULL, lst[[a]]), c(a, b))) + } else if (b %in% names(lst)) { + out = modify_list(lst, setNames(list(NULL, lst[[b]]), c(b, a))) + } + return(out) +} + + +swap_columns = function(dp, a, b) { + va = dp[[a]] + vb = dp[[b]] + dp[[a]] = if (!is.null(vb)) vb else NULL + dp[[b]] = if (!is.null(va)) va else NULL + dp +} + + +flip_datapoints = function(settings) { + flip = settings$flip + assert_flag(flip) + if (isTRUE(flip)) { + if (settings$type == "boxplot") { + # boxplot: let horizontal=TRUE do most work; only swap labels + settings = swap_elements(settings, "xlab", "ylab") + } else { + datapoints = swap_columns(settings$datapoints, "xmin", "ymin") + datapoints = swap_columns(datapoints, "xmax", "ymax") + settings$datapoints = swap_columns(datapoints, "x", "y") + settings = swap_elements(settings, "x", "y") + settings = swap_elements(settings, "xaxb", "yaxb") + settings = swap_elements(settings, "xaxl", "yaxl") + settings = swap_elements(settings, "xaxs", "yaxs") + settings = swap_elements(settings, "xaxt", "yaxt") + settings = swap_elements(settings, "xlab", "ylab") + settings = swap_elements(settings, "xlabs", "ylabs") + settings = swap_elements(settings, "xlim", "ylim") + settings = swap_elements(settings, "xmax", "ymax") + settings = swap_elements(settings, "xmin", "ymin") + if (!is.null(settings$log)) settings$log = chartr("xy", "yx", settings$log) + } + } + return(settings) +} + diff --git a/R/tinyplot.R b/R/tinyplot.R index d0df040f..1cb2750b 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -724,8 +724,8 @@ tinyplot.default = function( y = y, ymax = ymax, ymin = ymin, ylab = ylab, ylabs = NULL, # axes axes = axes, - xaxt = xaxt, xaxb = xaxb, xaxl = xaxl, - yaxt = yaxt, yaxb = yaxb, yaxl = yaxl, + xaxt = xaxt, xaxb = xaxb, xaxl = xaxl, xaxs = xaxs, + yaxt = yaxt, yaxb = yaxb, yaxl = yaxl, yaxs = yaxs, frame.plot = frame.plot, xlim = xlim, ylim = ylim, @@ -748,6 +748,7 @@ tinyplot.default = function( # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots ribbon.alpha = sanitize_ribbon.alpha(NULL), # misc + flip = flip, by = by, dots = dots ) @@ -822,32 +823,11 @@ tinyplot.default = function( settings = settings$type_data(settings, ...) } - + # flip -> swap x and y after type_data, except for boxplots (which has its own bespoke flip logic) + settings = flip_datapoints(settings) list2env(settings, environment()) - # flip -> swap x and y, except for boxplots (which has its own bespoke flip logic) - assert_flag(flip) - if (isTRUE(flip)) { - if (type == "boxplot") { - # boxplot: let horizontal=TRUE do most work; only swap labels - swap_variables(environment(), c("xlab", "ylab")) - } else { - swap_variables( - environment(), - c("xlim", "ylim"), - c("xlab", "ylab"), - c("xlabs", "ylabs"), - c("xaxt", "yaxt"), - c("xaxs", "yaxs"), - c("xaxb", "yaxb"), - c("xaxl", "yaxl")) - if (!is.null(log)) log = chartr("xy", "yx", log) - datapoints = swap_columns(datapoints, "x", "y") - datapoints = swap_columns(datapoints, "xmin", "ymin") - datapoints = swap_columns(datapoints, "xmax", "ymax") - } - } # ## bubble plot ----- From a0f33427809bfebe839189abdea70457b66f8fe4 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 00:35:09 -0400 Subject: [PATCH 20/54] type_bubble.R --- R/tinyplot.R | 12 +++--------- R/type_bubble.R | 14 ++++++++++++++ 2 files changed, 17 insertions(+), 9 deletions(-) create mode 100644 R/type_bubble.R diff --git a/R/tinyplot.R b/R/tinyplot.R index 1cb2750b..f59260aa 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -826,22 +826,16 @@ tinyplot.default = function( # flip -> swap x and y after type_data, except for boxplots (which has its own bespoke flip logic) settings = flip_datapoints(settings) - list2env(settings, environment()) - # ## 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) - if (bubble) { - 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 - } + settings = prep_bubble(settings) + list2env(settings, environment()) + # ## axis breaks and limits ----- diff --git a/R/type_bubble.R b/R/type_bubble.R new file mode 100644 index 00000000..1648ce08 --- /dev/null +++ b/R/type_bubble.R @@ -0,0 +1,14 @@ +prep_bubble = function(settings) { + list2env(settings, environment()) + if (bubble) { + 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 + } + settings$datapoints = datapoints + settings$bubble_pch = if (bubble) bubble_pch else NULL + settings$bubble_alpha = if (bubble) bubble_alpha else NULL + settings$bubble_bg_alpha = if (bubble) bubble_bg_alpha else NULL + settings +} From 75b52e80dfdb9407daa0316f89da673192240a5a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 00:48:09 -0400 Subject: [PATCH 21/54] lim_args function --- R/lim.R | 25 +++++++++++++++++++------ R/tinyplot.R | 14 ++------------ 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/R/lim.R b/R/lim.R index 2448b863..764b72ab 100644 --- a/R/lim.R +++ b/R/lim.R @@ -1,11 +1,24 @@ # calculate limits of each plot lim_args = function( - datapoints, - xlim, ylim, - xaxb = NULL, yaxb = NULL, - null_xlim = FALSE, null_ylim = FALSE, - type) { + datapoints, + xlim, ylim, + xlabs, ylabs, + xaxb = NULL, yaxb = NULL, + null_xlim = FALSE, null_ylim = FALSE, + type) { + + # For cases where x/yaxb is provided and corresponding x/ylabs is not null... + # We can subset these here to provide breaks + if (!is.null(xaxb) && !is.null(xlabs)) { + xlabs = xlabs[names(xlabs) %in% xaxb] + xaxb = NULL # don't need this any more + } + if (!is.null(yaxb) && !is.null(ylabs)) { + ylabs = ylabs[names(ylabs) %in% yaxb] + yaxb = NULL # don't need this any more + } + if (is.null(xlim)) { xlim = range(c( datapoints[["x"]], datapoints[["xmin"]], @@ -24,6 +37,6 @@ lim_args = function( if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) - out = list(xlim = xlim, ylim = ylim) + out = list(xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) return(out) } diff --git a/R/tinyplot.R b/R/tinyplot.R index f59260aa..bb0883eb 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -840,26 +840,16 @@ tinyplot.default = function( # ## axis breaks and limits ----- # - - # For cases where x/yaxb is provided and corresponding x/ylabs is not null... - # We can subset these here to provide breaks - if (!is.null(xaxb) && !is.null(xlabs)) { - xlabs = xlabs[names(xlabs) %in% xaxb] - xaxb = NULL # don't need this any more - } - if (!is.null(yaxb) && !is.null(ylabs)) { - ylabs = ylabs[names(ylabs) %in% yaxb] - yaxb = NULL # don't need this any more - } # do this after computing yaxb because limits will depend on the previous calculations fargs = lim_args( datapoints = datapoints, + xlabs = xlabs, ylabs = ylabs, xlim = xlim, ylim = ylim, xaxb = xaxb, yaxb = yaxb, null_xlim = null_xlim, null_ylim = null_ylim, type = type - )[c("xlim", "ylim")] + ) list2env(fargs, environment()) From d09042c5b0813d681700459c26354506cf2d9021 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 06:43:35 -0400 Subject: [PATCH 22/54] fix barplot axes --- R/type_barplot.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/type_barplot.R b/R/type_barplot.R index 4bd5cad6..3fbde321 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -193,7 +193,6 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, ylab = ylab, xlim = xlim, ylim = ylim, - axes = FALSE, #FIXME axes = TRUE, xlabs = xlabs, frame.plot = FALSE, From d75c9f1504103feed03592d412556c5c2bf1b62c Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 06:48:00 -0400 Subject: [PATCH 23/54] lim_args uses settings container --- R/lim.R | 10 +++------- R/tinyplot.R | 12 ++---------- 2 files changed, 5 insertions(+), 17 deletions(-) diff --git a/R/lim.R b/R/lim.R index 764b72ab..e9377e9f 100644 --- a/R/lim.R +++ b/R/lim.R @@ -1,12 +1,7 @@ # calculate limits of each plot -lim_args = function( - datapoints, - xlim, ylim, - xlabs, ylabs, - xaxb = NULL, yaxb = NULL, - null_xlim = FALSE, null_ylim = FALSE, - type) { +lim_args = function(settings) { + list2env(settings, environment()) # For cases where x/yaxb is provided and corresponding x/ylabs is not null... # We can subset these here to provide breaks @@ -38,5 +33,6 @@ lim_args = function( if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) out = list(xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) + out = modify_list(settings, out) return(out) } diff --git a/R/tinyplot.R b/R/tinyplot.R index bb0883eb..1475f8b1 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -834,7 +834,6 @@ tinyplot.default = function( # grouping sanitizers (actually: will only be used for dual_legend plots but # easiest to assign/determine now) settings = prep_bubble(settings) - list2env(settings, environment()) # @@ -842,15 +841,8 @@ tinyplot.default = function( # # do this after computing yaxb because limits will depend on the previous calculations - fargs = lim_args( - datapoints = datapoints, - xlabs = xlabs, ylabs = ylabs, - xlim = xlim, ylim = ylim, - xaxb = xaxb, yaxb = yaxb, - null_xlim = null_xlim, null_ylim = null_ylim, - type = type - ) - list2env(fargs, environment()) + settings = lim_args(settings) + list2env(settings, environment()) # From 1c4044c4699eb45d5532801d0266a4e2d6d01b93 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 08:19:47 -0400 Subject: [PATCH 24/54] make check passes --- .Rbuildignore | 1 + NAMESPACE | 1 + R/flip.R | 6 +++--- R/tinyplot.R | 4 ++-- R/zzz.R | 46 +++++++++++++++++++++++++++++++++++++------ man/facet.Rd | 4 ++-- man/type_abline.Rd | 12 ++++++----- man/type_histogram.Rd | 11 +++++++---- man/type_points.Rd | 7 +++---- man/type_ribbon.Rd | 6 +++--- man/type_spline.Rd | 3 ++- man/type_summary.Rd | 5 +++-- 12 files changed, 74 insertions(+), 32 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index ae214709..a80e032c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -24,3 +24,4 @@ inst/user2025 #inst/tinytest/ Makefile ^.devcontainer +Rplots.pdf diff --git a/NAMESPACE b/NAMESPACE index 8da8515d..07e97949 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -117,6 +117,7 @@ importFrom(stats,predict) importFrom(stats,qnorm) importFrom(stats,qt) importFrom(stats,quantile) +importFrom(stats,setNames) importFrom(stats,spline) importFrom(stats,terms) importFrom(stats,weighted.mean) diff --git a/R/flip.R b/R/flip.R index c3fee91f..a753d1f9 100644 --- a/R/flip.R +++ b/R/flip.R @@ -2,11 +2,11 @@ swap_elements = function(lst, a, b) { if (any(!c(a, b) %in% names(lst))) { out = lst } else if (all(c(a, b) %in% names(lst))) { - out = modify_list(lst, setNames(lst[c(b, a)], c(a, b))) + out = modify_list(lst, stats::setNames(lst[c(b, a)], c(a, b))) } else if (a %in% names(lst)) { - out = modify_list(lst, setNames(list(NULL, lst[[a]]), c(a, b))) + out = modify_list(lst, stats::setNames(list(NULL, lst[[a]]), c(a, b))) } else if (b %in% names(lst)) { - out = modify_list(lst, setNames(list(NULL, lst[[b]]), c(b, a))) + out = modify_list(lst, stats::setNames(list(NULL, lst[[b]]), c(b, a))) } return(out) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 1475f8b1..1327ae03 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -370,7 +370,7 @@ #' @importFrom grDevices axisTicks adjustcolor cairo_pdf colorRampPalette extendrange palette palette.colors palette.pals hcl.colors hcl.pals xy.coords png jpeg pdf svg dev.off dev.new dev.list #' @importFrom graphics abline arrows axis Axis axTicks box boxplot grconvertX grconvertY hist lines mtext par plot.default plot.new plot.window points polygon polypath segments rect text title #' @importFrom utils modifyList head tail -#' @importFrom stats na.omit +#' @importFrom stats na.omit setNames #' @importFrom tools file_ext #' #' @examples @@ -752,7 +752,7 @@ tinyplot.default = function( by = by, dots = dots ) - settings[["raw_input"]] <- settings + settings[["raw_input"]] = settings # diff --git a/R/zzz.R b/R/zzz.R index e25f44c9..9071dab3 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,58 +10,92 @@ globalVariables(c( "add", + "alpha", "asp", "axes", + "bg", + "bubble", + "bubble_alpha", + "bubble_bg_alpha", + "bubble_cex", "by_continuous", + "by_dep", "by_ordered", - "bubble_cex", + "cex", + "cex_dep", "cex_fct_adj", + "data", + "datapoints", "dots", "draw", + "facet", + "facet.args", + "facet_attr", "facet_bg", "facet_border", + "facet_by", "facet_col", "facet_font", "facet_newlines", "facet_rect", "facet_text", - "facet.args", - "facet", "facets", "fill", "flip", "frame.plot", "has_legend", + "height", "iby", "ifacet", + "lty", + "lwd", "nfacet_cols", "nfacet_rows", "nfacets", "ngrps", + "null_by", + "null_facet", + "null_xlim", + "null_ylim", "oxaxis", "oyaxis", + "pch", + "raw_input", "ribbon.alpha", "split_data", "tpars", "type", + "type_info", + "was_area_type", + "width", "x", + "x_by", + "x_dep", + "xaxb", "xaxl", "xaxs", "xaxt", + "xlab", "xlabs", "xlim", - "null_ylim", - "null_xlim", "xlvls", "xmax", + "xmax_dep", "xmin", + "xmin_dep", "y", + "y_dep", + "yaxb", "yaxl", "yaxs", "yaxt", + "ygroup", + "ylab", "ylabs", "ylim", "ymax", - "ymin" + "ymax_dep", + "ymin", + "ymin_dep" )) } diff --git a/man/facet.Rd b/man/facet.Rd index 5e0bd34d..df47e7aa 100644 --- a/man/facet.Rd +++ b/man/facet.Rd @@ -29,14 +29,14 @@ draw_facet_window( oyaxis, xlabs, xlim, - xlim_user, + null_xlim, xaxt, xaxs, xaxb, xaxl, ylabs, ylim, - ylim_user, + null_ylim, yaxt, yaxs, yaxb, diff --git a/man/type_abline.Rd b/man/type_abline.Rd index 8051d9a2..e6dbcdb1 100644 --- a/man/type_abline.Rd +++ b/man/type_abline.Rd @@ -91,7 +91,7 @@ tinyplot(mpg ~ hp | cyl, facet = "by", data = mtcars, ylim = c(0, 40)) tinyplot_add(type = "hline", col = "grey") # Note that group+facet aesthetics will be inherited. We can use this to -# add customized lines (here: the mean `mpg` for each `cyl` group) +# add customized lines (here: the mean `mpg` for each `cyl` group) tinyplot_add(type = type_hline(with(mtcars, tapply(mpg, cyl, mean))), lty = 2) # Similar idea for vline @@ -107,11 +107,13 @@ tinyplot(mpg ~ wt | factor(cyl), data = mtcars, type = type_hline(h = 21:23)) tinyplot(mpg ~ wt, facet = ~am, data = mtcars, type = type_hline(h = c(20, 30))) # length(h) == no. of groups x no. of facets -tinyplot(mpg ~ wt | factor(cyl), facet = ~am, data = mtcars, - type = type_hline(h = 21:26)) +tinyplot(mpg ~ wt | factor(cyl), + facet = ~am, data = mtcars, + type = type_hline(h = 21:26)) # special adjustment case (here: lwd by group) -tinyplot(mpg ~ wt | factor(cyl), facet = ~am, data = mtcars, - type = type_hline(c(20, 30)), lwd = c(21, 14, 7)) +tinyplot(mpg ~ wt | factor(cyl), + facet = ~am, data = mtcars, + type = type_hline(c(20, 30)), lwd = c(21, 14, 7)) } diff --git a/man/type_histogram.Rd b/man/type_histogram.Rd index dc5e78f4..02115fbf 100644 --- a/man/type_histogram.Rd +++ b/man/type_histogram.Rd @@ -73,14 +73,15 @@ tinyplot(Nile, type = type_histogram(breaks = 30, freq = FALSE)) # Grouped histogram example tinyplot( - ~Petal.Width | Species, + ~ Petal.Width | Species, type = "histogram", data = iris ) # Faceted version tinyplot( - ~Petal.Width, facet = ~Species, + ~Petal.Width, + facet = ~Species, type = "histogram", data = iris ) @@ -91,14 +92,16 @@ tinyplot( # free facet scales + shared histogram breaks, versus... tinyplot( - ~Petal.Width, facet = ~Species, + ~Petal.Width, + facet = ~Species, facet.args = list(free = TRUE), type = type_histogram(), data = iris ) # ... free facet scales + free histogram breaks tinyplot( - ~Petal.Width, facet = ~Species, + ~Petal.Width, + facet = ~Species, facet.args = list(free = TRUE), type = type_histogram(free = TRUE), data = iris diff --git a/man/type_points.Rd b/man/type_points.Rd index 3e9d1745..5a93ecc0 100644 --- a/man/type_points.Rd +++ b/man/type_points.Rd @@ -35,9 +35,8 @@ tinyplot(Sepal.Length ~ Petal.Length, data = iris, cex = iris$Sepal.Width) # Fancier version with dual legends and extra customization tinyplot(Sepal.Length ~ Petal.Length | Species, - data = iris, - cex = iris$Sepal.Width, clim = c(1, 5), - pch = 21, fill = 0.3) - + data = iris, + cex = iris$Sepal.Width, clim = c(1, 5), + pch = 21, fill = 0.3) } diff --git a/man/type_ribbon.Rd b/man/type_ribbon.Rd index 412b1de8..910f2008 100644 --- a/man/type_ribbon.Rd +++ b/man/type_ribbon.Rd @@ -22,14 +22,14 @@ define a \code{y} interval (usually spanning from \code{ymin} to \code{ymax}) fo set to 0 and \code{ymax} is set to \code{y}. } \examples{ -x = 1:100/10 +x = 1:100 / 10 y = sin(x) # ## Ribbon plots # "ribbon" convenience string -tinyplot(x = x, ymin = y-1, ymax = y+1, type = "ribbon") +tinyplot(x = x, ymin = y - 1, ymax = y + 1, type = "ribbon") # Same result with type_ribbon() tinyplot(x = x, ymin = y-1, ymax = y+1, type = type_ribbon()) @@ -38,7 +38,7 @@ tinyplot(x = x, y = y, ymin = y-1, ymax = y+1, type = "ribbon") # ## Area plots - + # "area" type convenience string tinyplot(x, y, type = "area") diff --git a/man/type_spline.Rd b/man/type_spline.Rd index 7c4468c6..7055dcc0 100644 --- a/man/type_spline.Rd +++ b/man/type_spline.Rd @@ -70,6 +70,7 @@ The inputs can contain missing values which are deleted, so at least tinyplot(dist ~ speed, data = cars, type = "spline") # Use `type_spline()` to pass extra arguments for customization -tinyplot(dist ~ speed, data = cars, type = type_spline(method = "natural", n = 25), +tinyplot(dist ~ speed, + data = cars, type = type_spline(method = "natural", n = 25), add = TRUE, lty = 2) } diff --git a/man/type_summary.Rd b/man/type_summary.Rd index 3d103904..70e17e74 100644 --- a/man/type_summary.Rd +++ b/man/type_summary.Rd @@ -35,8 +35,9 @@ tinyplot(weight ~ Time | Diet, facet = "by", data = ChickWeight, type = "summary # Custom/complex function example tinyplot( - weight ~ Time | Diet, facet = "by", data = ChickWeight, - type = type_summary(function(y) quantile(y, probs = 0.9)/max(y)) + weight ~ Time | Diet, + facet = "by", data = ChickWeight, + type = type_summary(function(y) quantile(y, probs = 0.9) / max(y)) ) } From ccd199c320bbf2d30dde440dbbe9fc2834a2232a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 08:39:50 -0400 Subject: [PATCH 25/54] by_aesthetics --- R/by_aesthetics.R | 30 ++++++++++++++++++++++++++++++ R/tinyplot.R | 17 ++--------------- 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 400b9e87..2824d148 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -1,3 +1,33 @@ +by_aesthetics = function(settings) { + list2env(settings, environment()) + by_ordered = FALSE + by_continuous = !null_by && inherits(datapoints$by, c("numeric", "integer")) + if (isTRUE(by_continuous) && type %in% c("l", "b", "o", "ribbon", "polygon", "polypath", "boxplot")) { + warning("\nContinuous legends not supported for this plot type. Reverting to discrete legend.") + by_continuous = FALSE + } else if (!null_by) { + by_ordered = is.ordered(by) + } + + ngrps = if (null_by) 1L else if (is.factor(by)) nlevels(by) else if (by_continuous) 100L else length(unique(by)) + pch = by_pch(ngrps = ngrps, type = type, pch = pch) + lty = by_lty(ngrps = ngrps, type = type, lty = lty) + lwd = by_lwd(ngrps = ngrps, type = type, lwd = lwd) + cex = by_cex(ngrps = ngrps, type = type, bubble = bubble, cex = cex) + out = list( + by_continuous = by_continuous, + by_ordered = by_ordered, + ngrps = ngrps, + pch = pch, + lty = lty, + lwd = lwd, + cex = cex + ) + out = modify_list(settings, out) + return(out) +} + + by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, ordered = NULL, alpha = NULL) { if (is.null(alpha)) alpha = 1 if (is.null(ordered)) ordered = FALSE diff --git a/R/tinyplot.R b/R/tinyplot.R index 1327ae03..82956cb1 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -842,27 +842,14 @@ tinyplot.default = function( # do this after computing yaxb because limits will depend on the previous calculations settings = lim_args(settings) - list2env(settings, environment()) # ## aesthetics by group ----- # - by_ordered = FALSE - by_continuous = !null_by && inherits(datapoints$by, c("numeric", "integer")) - if (isTRUE(by_continuous) && type %in% c("l", "b", "o", "ribbon", "polygon", "polypath", "boxplot")) { - warning("\nContinuous legends not supported for this plot type. Reverting to discrete legend.") - by_continuous = FALSE - } else if (!null_by) { - by_ordered = is.ordered(by) - } - - ngrps = if (null_by) 1L else if (is.factor(by)) nlevels(by) else if (by_continuous) 100L else length(unique(by)) - pch = by_pch(ngrps = ngrps, type = type, pch = pch) - lty = by_lty(ngrps = ngrps, type = type, lty = lty) - lwd = by_lwd(ngrps = ngrps, type = type, lwd = lwd) - cex = by_cex(ngrps = ngrps, type = type, bubble = bubble, cex = cex) + settings = by_aesthetics(settings) + list2env(settings, environment()) col = by_col( ngrps = ngrps, col = col, palette = palette, From 30befef2b0df392c03e03f8a5237965f0a781482 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 08:40:35 -0400 Subject: [PATCH 26/54] consolidate legend processing --- R/tinyplot.R | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 82956cb1..7f1a01d0 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -861,6 +861,26 @@ tinyplot.default = function( ribbon.alpha = ribbon.alpha, ngrps = ngrps, type = type ) + + # + ## facets: count ----- + # + + # before legend becase it requires `cex_fct_adj` + if (length(unique(datapoints$facet)) == 1) { + datapoints[["facet"]] = NULL + } + attributes(datapoints$facet) = facet_attr ## TODO: better solution for restoring facet attributes? + fargs = facet_layout(facet = datapoints$facet, facet.args = facet.args, add = add) + fargs = fargs[c("facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")] + list2env(fargs, environment()) + + + # + ## legends ----- + # + + # legend labels ncolors = length(col) lgnd_labs = rep(NA, times = ncolors) if (isTRUE(by_continuous)) { @@ -883,25 +903,6 @@ tinyplot.default = function( lgnd_labs[pidx] = pbyvar } - - # - ## facets: count ----- - # - - # before legend becase it requires `cex_fct_adj` - if (length(unique(datapoints$facet)) == 1) { - datapoints[["facet"]] = NULL - } - attributes(datapoints$facet) = facet_attr ## TODO: better solution for restoring facet attributes? - fargs = facet_layout(facet = datapoints$facet, facet.args = facet.args, add = add) - fargs = fargs[c("facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")] - list2env(fargs, environment()) - - - # - ## legends ----- - # - # simple indicator variables for later use has_legend = FALSE dual_legend = bubble && !null_by && !isFALSE(legend) From 59c178d8879acce4b43dec89187a91d2ef3dd006 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 08:42:38 -0400 Subject: [PATCH 27/54] format settings list --- R/tinyplot.R | 122 +++++++++++++++++++++++++++++++----------------- R/type_bubble.R | 2 +- 2 files changed, 81 insertions(+), 43 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 7f1a01d0..8e0ce569 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -699,59 +699,97 @@ tinyplot.default = function( # dots = list(...) + settings = list( # save call to check user input later - call = match.call(), + call = match.call(), + # save to file & device dimensions - file = file, width = width, height = height, + file = file, + width = width, + height = height, + # deparsed input for use in labels - by_dep = deparse1(substitute(by)), - cex_dep = if (!is.null(cex)) deparse1(substitute(cex)) else NULL, - facet_dep = deparse1(substitute(facet)), - x_dep = if (is.null(x)) NULL else deparse1(substitute(x)), - xmax_dep = if (is.null(xmax)) NULL else deparse1(substitute(xmax)), - xmin_dep = if (is.null(xmin)) NULL else deparse1(substitute(xmin)), - y_dep = if (is.null(y)) NULL else deparse1(substitute(y)), - ymax_dep = if (is.null(ymax)) NULL else deparse1(substitute(ymax)), - ymin_dep = if (is.null(ymin)) NULL else deparse1(substitute(ymin)), + by_dep = deparse1(substitute(by)), + cex_dep = if (!is.null(cex)) deparse1(substitute(cex)) else NULL, + facet_dep = deparse1(substitute(facet)), + x_dep = if (is.null(x)) NULL else deparse1(substitute(x)), + xmax_dep = if (is.null(xmax)) NULL else deparse1(substitute(xmax)), + xmin_dep = if (is.null(xmin)) NULL else deparse1(substitute(xmin)), + y_dep = if (is.null(y)) NULL else deparse1(substitute(y)), + ymax_dep = if (is.null(ymax)) NULL else deparse1(substitute(ymax)), + ymin_dep = if (is.null(ymin)) NULL else deparse1(substitute(ymin)), + # types - type = type, type_data = NULL, type_draw = NULL, type_name = NULL, + type = type, + type_data = NULL, + type_draw = NULL, + type_name = NULL, + # type-specific settings - bubble = FALSE, - ygroup = NULL, # for type_ridge() + bubble = FALSE, + ygroup = NULL, # for type_ridge() + # data points and labels - x = x, xmax = xmax, xmin = xmin, xlab = xlab, xlabs = NULL, - y = y, ymax = ymax, ymin = ymin, ylab = ylab, ylabs = NULL, + x = x, + xmax = xmax, + xmin = xmin, + xlab = xlab, + xlabs = NULL, + y = y, + ymax = ymax, + ymin = ymin, + ylab = ylab, + ylabs = NULL, + # axes - axes = axes, - xaxt = xaxt, xaxb = xaxb, xaxl = xaxl, xaxs = xaxs, - yaxt = yaxt, yaxb = yaxb, yaxl = yaxl, yaxs = yaxs, - frame.plot = frame.plot, - xlim = xlim, - ylim = ylim, - # flags to check user input that is useful later on - null_by = is.null(by), - null_xlim = is.null(xlim), - null_ylim = is.null(ylim), - was_area_type = identical(type, "area"), # mostly for legend + axes = axes, + xaxt = xaxt, + xaxb = xaxb, + xaxl = xaxl, + xaxs = xaxs, + yaxt = yaxt, + yaxb = yaxb, + yaxl = yaxl, + yaxs = yaxs, + frame.plot = frame.plot, + xlim = xlim, + ylim = ylim, + + # flags to check user input (useful later on) + null_by = is.null(by), + null_xlim = is.null(xlim), + null_ylim = is.null(ylim), + was_area_type = identical(type, "area"), # mostly for legend + # unevaluated expressions with side effects - draw = substitute(draw), - facet = facet, - facet.args = facet.args, - palette = substitute(palette), - legend = if (add) FALSE else substitute(legend), + draw = substitute(draw), + facet = facet, + facet.args = facet.args, + palette = substitute(palette), + legend = if (add) FALSE else substitute(legend), + # aesthetics - lty = lty, lwd = lwd, col = col, bg = bg, log = log, - fill = fill, alpha = alpha, cex = cex, - pch = if (is.null(pch)) get_tpar("pch", default = NULL) else pch, - # ribbon.alpha is overwritten by some type_data() functions - # sanitize_ribbon.alpha: returns default alpha transparency value for ribbon-type plots - ribbon.alpha = sanitize_ribbon.alpha(NULL), + lty = lty, + lwd = lwd, + col = col, + bg = bg, + log = log, + fill = fill, + alpha = alpha, + cex = cex, + pch = if (is.null(pch)) get_tpar("pch", default = NULL) else pch, + + # ribbon.alpha overwritten by some type_data() functions + # sanitize_ribbon.alpha: returns default alpha transparency for ribbon-type plots + ribbon.alpha = sanitize_ribbon.alpha(NULL), + # misc - flip = flip, - by = by, - dots = dots + flip = flip, + by = by, + dots = dots ) + settings[["raw_input"]] = settings @@ -833,7 +871,7 @@ tinyplot.default = function( # 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) - settings = prep_bubble(settings) + settings = sanitize_bubble(settings) # diff --git a/R/type_bubble.R b/R/type_bubble.R index 1648ce08..8446bb27 100644 --- a/R/type_bubble.R +++ b/R/type_bubble.R @@ -1,4 +1,4 @@ -prep_bubble = function(settings) { +sanitize_bubble = function(settings) { list2env(settings, environment()) if (bubble) { datapoints[["cex"]] = cex From 6a41a7b6eb2455172a3fec7ccec68ae227930f0e Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 08:47:34 -0400 Subject: [PATCH 28/54] reorg --- R/facet.R | 28 ++++++++++++++++++++++++++-- R/tinyplot.R | 27 +++++++++++---------------- 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/R/facet.R b/R/facet.R index c75b293e..f98cfa02 100644 --- a/R/facet.R +++ b/R/facet.R @@ -518,7 +518,26 @@ draw_facet_window = function( #' @rdname facet #' @keywords internal -facet_layout = function(facet, add = FALSE, facet.args = list()) { +facet_layout = function(settings) { + # Extract needed variables from settings + add = settings$add + facet.args = settings$facet.args + datapoints = settings$datapoints + facet_attr = settings$facet_attr + + # Simplify facet if only one unique value + facet = datapoints$facet + if (!is.null(facet) && length(unique(facet)) == 1) { + facet = NULL + datapoints$facet = NULL + } + + # Restore facet attributes + if (!is.null(facet)) { + attributes(facet) = facet_attr + attributes(datapoints$facet) = facet_attr + } + nfacet_rows = 1 nfacet_cols = 1 if (!is.null(facet)) { @@ -565,7 +584,9 @@ facet_layout = function(facet, add = FALSE, facet.args = list()) { cex_fct_adj = 1 } - list( + # Update settings with new values + new = list( + datapoints = datapoints, facets = facets, ifacet = ifacet, nfacets = nfacets, @@ -575,6 +596,9 @@ facet_layout = function(facet, add = FALSE, facet.args = list()) { oyaxis = oyaxis, cex_fct_adj = cex_fct_adj ) + settings = modify_list(settings, new) + + return(settings) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 8e0ce569..4ba4058d 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -761,6 +761,8 @@ tinyplot.default = function( null_xlim = is.null(xlim), null_ylim = is.null(ylim), was_area_type = identical(type, "area"), # mostly for legend + x_by = identical(x, by), # for "boxplot", "spineplot" and "ridges" + # unevaluated expressions with side effects draw = substitute(draw), @@ -836,8 +838,7 @@ tinyplot.default = function( } # flag if x==by, currently only used for - # "boxplot", "spineplot" and "ridges" types) - settings$x_by = identical(settings$x, settings$by) + # # facet: parse facet formula and prepares variables when facet==by settings = sanitize_facet(settings) @@ -882,6 +883,14 @@ tinyplot.default = function( settings = lim_args(settings) + # + ## facets: count ----- + # + + # facet_layout processes facet simplification, attribute restoration, and layout + settings = facet_layout(settings) + + # ## aesthetics by group ----- # @@ -898,20 +907,6 @@ tinyplot.default = function( by_ordered = by_ordered, col = col, fill = fill, palette = substitute(palette), ribbon.alpha = ribbon.alpha, ngrps = ngrps, type = type ) - - - # - ## facets: count ----- - # - - # before legend becase it requires `cex_fct_adj` - if (length(unique(datapoints$facet)) == 1) { - datapoints[["facet"]] = NULL - } - attributes(datapoints$facet) = facet_attr ## TODO: better solution for restoring facet attributes? - fargs = facet_layout(facet = datapoints$facet, facet.args = facet.args, add = add) - fargs = fargs[c("facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")] - list2env(fargs, environment()) # From 84cac746fcb16e0554d476d163519d4bb93e567a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 09:22:20 -0400 Subject: [PATCH 29/54] docs --- R/facet.R | 1 + man/facet.Rd | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/facet.R b/R/facet.R index f98cfa02..e17cde4a 100644 --- a/R/facet.R +++ b/R/facet.R @@ -518,6 +518,7 @@ draw_facet_window = function( #' @rdname facet #' @keywords internal +#' @param settings A list of settings as created by `tinyplot()`. facet_layout = function(settings) { # Extract needed variables from settings add = settings$add diff --git a/man/facet.Rd b/man/facet.Rd index df47e7aa..0c226cb7 100644 --- a/man/facet.Rd +++ b/man/facet.Rd @@ -57,7 +57,10 @@ draw_facet_window( tpars = NULL ) -facet_layout(facet, add = FALSE, facet.args = list()) +facet_layout(settings) +} +\arguments{ +\item{settings}{A list of settings as created by \code{tinyplot()}.} } \description{ Internal functions called from \code{tinyplot} in order to draw the From 2d9b7fb56000540aac74262b2968321482bf97dc Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 09:56:51 -0400 Subject: [PATCH 30/54] fix vignette --- vignettes/types.qmd | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/vignettes/types.qmd b/vignettes/types.qmd index 4ce53173..e23879fd 100644 --- a/vignettes/types.qmd +++ b/vignettes/types.qmd @@ -178,11 +178,11 @@ custom type. The three functions that we need to define for a new type are: 1. `data_*()`: Function factory. - - Accepts a list of internal objects + - Accepts `...` and a named list called `settings` which holds many internal objects - Inputs must include `...` - - `datapoints` Is the most important object. It is a data frame with the datapoints to plot. - - Other objects that can be modified by `data_*()` include: `by`, `facet`, `ylab`, `palette` - - Returns a named list with modified versions of those objects. + - `settings$datapoints` Is the most important object. It is a data frame with the datapoints to plot. + - Other objects that can be modified by `data_*()` include: `settings$by`, `settings$facet`, `settings$ylab`, `settings$palette` + - Returns a named list with modified versions of the `settings` values. 2. `draw_*()`: Function factory. - Accepts information about data point values and aesthetics. - Inputs must include `...` @@ -202,11 +202,13 @@ plots lines. type_log = function(base = exp(1)) { data_log = function() { - fun = function(datapoints, ...) { + fun = function(settings, ...) { + datapoints = settings$datapoints datapoints$x = log(datapoints$x, base = base) datapoints$y = log(datapoints$y, base = base) datapoints = datapoints[order(datapoints$x), ] - return(list(datapoints = datapoints, ...)) + settings$datapoints = datapoints + return(settings) } return(fun) } From 4ed4063254b1cc182116fd9fa64faffaca5a427f Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 3 Oct 2025 14:55:04 -0400 Subject: [PATCH 31/54] by_col and by_bg use settings --- R/by_aesthetics.R | 38 +++++++++++++++----------------------- R/tinyplot.R | 14 +++----------- 2 files changed, 18 insertions(+), 34 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 2824d148..aa86e550 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -28,7 +28,12 @@ by_aesthetics = function(settings) { } -by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, ordered = NULL, alpha = NULL) { +by_col = function(settings) { + list2env(settings, environment()) + palette = settings$palette # not sure why we need this + ordered = by_ordered + gradient = by_continuous + if (is.null(alpha)) alpha = 1 if (is.null(ordered)) ordered = FALSE if (is.null(gradient)) gradient = FALSE @@ -457,33 +462,20 @@ by_cex = function(ngrps, type, bubble = FALSE, cex = NULL) { -by_bg = function( - adjustcolor, - alpha, - bg, - by, - by_continuous, - by_ordered, - col, - fill, - ngrps, - palette, - ribbon.alpha, - type) { - if (is.null(bg) && !is.null(fill)) bg = fill +by_bg = function(adjustcolor, settings) { + list2env(settings, environment()) + palette = settings$palette # not sure why we need this + + + if (is.null(bg) && !is.null(fill)) settings$bg = bg = fill if (!is.null(bg) && length(bg) == 1 && is.numeric(bg) && bg >= 0 && bg <= 1) { alpha = bg bg = "by" } if (!is.null(bg) && length(bg) == 1 && bg == "by") { - bg = by_col( - ngrps = ngrps, - col = NULL, - palette = palette, - gradient = by_continuous, - ordered = by_ordered, - alpha = alpha - ) + # use by_col processing, but with the bg-specific colors + bg_colors = list(col = NULL, bg = bg, alpha = alpha, palette = palette) + bg = by_col(settings = modify_list(settings, bg_colors)) } else if (length(bg) != ngrps) { bg = rep(bg, ngrps) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 4ba4058d..16416034 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -894,20 +894,12 @@ tinyplot.default = function( # ## aesthetics by group ----- # - settings = by_aesthetics(settings) - list2env(settings, environment()) - col = by_col( - ngrps = ngrps, col = col, palette = palette, - gradient = by_continuous, ordered = by_ordered, alpha = alpha - ) - bg = by_bg( - adjustcolor = adjustcolor, alpha = alpha, bg = bg, by = by, by_continuous = by_continuous, - by_ordered = by_ordered, col = col, fill = fill, palette = substitute(palette), - ribbon.alpha = ribbon.alpha, ngrps = ngrps, type = type - ) + settings$col = by_col(settings = settings) + settings$bg = by_bg(adjustcolor = adjustcolor, settings = settings) + list2env(settings, environment()) # ## legends ----- From 19dd28b206729536aeb3bb2464cf095b019d2be9 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 5 Oct 2025 16:32:52 -0400 Subject: [PATCH 32/54] by_col + by_bg -> by_aesthetics --- R/by_aesthetics.R | 5 +++++ R/tinyplot.R | 2 -- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index aa86e550..d8781d65 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -14,6 +14,7 @@ by_aesthetics = function(settings) { lty = by_lty(ngrps = ngrps, type = type, lty = lty) lwd = by_lwd(ngrps = ngrps, type = type, lwd = lwd) cex = by_cex(ngrps = ngrps, type = type, bubble = bubble, cex = cex) + out = list( by_continuous = by_continuous, by_ordered = by_ordered, @@ -24,6 +25,10 @@ by_aesthetics = function(settings) { cex = cex ) out = modify_list(settings, out) + + out$col = by_col(settings = out) + out$bg = by_bg(adjustcolor = adjustcolor, settings = out) + return(out) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 16416034..99012895 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -896,8 +896,6 @@ tinyplot.default = function( # settings = by_aesthetics(settings) - settings$col = by_col(settings = settings) - settings$bg = by_bg(adjustcolor = adjustcolor, settings = settings) list2env(settings, environment()) From fc6df932994da1ffb9dda474d7bebe5516c3ef87 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Mon, 6 Oct 2025 15:27:35 -0400 Subject: [PATCH 33/54] type_info should go in container settings --- R/tinyplot.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index 99012895..db598a81 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -789,7 +789,8 @@ tinyplot.default = function( # misc flip = flip, by = by, - dots = dots + dots = dots, + type_info = list() # pass type-specific info from type_data to type_draw ) settings[["raw_input"]] = settings @@ -855,9 +856,6 @@ tinyplot.default = function( ## transform datapoints using type_data() ----- # - # type_info: initialize a list to pass type-specific information from type_data() to type_draw() - settings$type_info = list() - if (!is.null(settings$type_data)) { settings = settings$type_data(settings, ...) } From 552b811b9252143aa17dce6b48de46320e263194 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Mon, 6 Oct 2025 15:48:58 -0400 Subject: [PATCH 34/54] modify_list -> update_settings --- R/by_aesthetics.R | 8 +++----- R/facet.R | 6 +----- R/flip.R | 8 ++++---- R/lim.R | 4 +--- R/sanitize_xylab.R | 4 +--- R/type_abline.R | 4 +--- R/type_area.R | 4 +--- R/type_barplot.R | 6 ++---- R/type_boxplot.R | 3 +-- R/type_density.R | 6 ++---- R/type_function.R | 4 +--- R/type_glm.R | 4 +--- R/type_histogram.R | 7 ++----- R/type_hline.R | 4 +--- R/type_jitter.R | 4 +--- R/type_lm.R | 4 +--- R/type_loess.R | 4 +--- R/type_pointrange.R | 5 +---- R/type_points.R | 4 +--- R/type_qq.R | 4 +--- R/type_ribbon.R | 3 +-- R/type_ridge.R | 4 +--- R/type_spineplot.R | 19 ++++++++----------- R/type_spline.R | 4 +--- R/type_summary.R | 4 +--- R/type_text.R | 4 +--- R/type_violin.R | 6 ++---- R/type_vline.R | 4 +--- R/utils.R | 7 ++++--- 29 files changed, 48 insertions(+), 104 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index d8781d65..fc9230f5 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -15,7 +15,7 @@ by_aesthetics = function(settings) { lwd = by_lwd(ngrps = ngrps, type = type, lwd = lwd) cex = by_cex(ngrps = ngrps, type = type, bubble = bubble, cex = cex) - out = list( + out = update_settings(settings, by_continuous = by_continuous, by_ordered = by_ordered, ngrps = ngrps, @@ -24,12 +24,11 @@ by_aesthetics = function(settings) { lwd = lwd, cex = cex ) - out = modify_list(settings, out) out$col = by_col(settings = out) out$bg = by_bg(adjustcolor = adjustcolor, settings = out) - return(out) + out } @@ -479,8 +478,7 @@ by_bg = function(adjustcolor, settings) { } if (!is.null(bg) && length(bg) == 1 && bg == "by") { # use by_col processing, but with the bg-specific colors - bg_colors = list(col = NULL, bg = bg, alpha = alpha, palette = palette) - bg = by_col(settings = modify_list(settings, bg_colors)) + bg = by_col(settings = update_settings(settings, col = NULL, bg = bg, alpha = alpha, palette = palette)) } else if (length(bg) != ngrps) { bg = rep(bg, ngrps) } diff --git a/R/facet.R b/R/facet.R index e17cde4a..cb9067cc 100644 --- a/R/facet.R +++ b/R/facet.R @@ -585,8 +585,7 @@ facet_layout = function(settings) { cex_fct_adj = 1 } - # Update settings with new values - new = list( + update_settings(settings, datapoints = datapoints, facets = facets, ifacet = ifacet, @@ -597,9 +596,6 @@ facet_layout = function(settings) { oyaxis = oyaxis, cex_fct_adj = cex_fct_adj ) - settings = modify_list(settings, new) - - return(settings) } diff --git a/R/flip.R b/R/flip.R index a753d1f9..146f07da 100644 --- a/R/flip.R +++ b/R/flip.R @@ -2,13 +2,13 @@ swap_elements = function(lst, a, b) { if (any(!c(a, b) %in% names(lst))) { out = lst } else if (all(c(a, b) %in% names(lst))) { - out = modify_list(lst, stats::setNames(lst[c(b, a)], c(a, b))) + out = do.call(update_settings, c(list(lst), stats::setNames(lst[c(b, a)], c(a, b)))) } else if (a %in% names(lst)) { - out = modify_list(lst, stats::setNames(list(NULL, lst[[a]]), c(a, b))) + out = do.call(update_settings, c(list(lst), stats::setNames(list(NULL, lst[[a]]), c(a, b)))) } else if (b %in% names(lst)) { - out = modify_list(lst, stats::setNames(list(NULL, lst[[b]]), c(b, a))) + out = do.call(update_settings, c(list(lst), stats::setNames(list(NULL, lst[[b]]), c(b, a)))) } - return(out) + out } diff --git a/R/lim.R b/R/lim.R index e9377e9f..0e616667 100644 --- a/R/lim.R +++ b/R/lim.R @@ -32,7 +32,5 @@ lim_args = function(settings) { if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) - out = list(xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) - out = modify_list(settings, out) - return(out) + update_settings(settings, xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) } diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index 26e98a78..2a2920f1 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -54,7 +54,5 @@ sanitize_xylab = function(settings) { out_ylab = NULL } - out = list(xlab = out_xlab, ylab = out_ylab) - settings = modify_list(settings, out) - return(settings) + update_settings(settings, xlab = out_xlab, ylab = out_ylab) } diff --git a/R/type_abline.R b/R/type_abline.R index a378b984..ff6cc1f5 100644 --- a/R/type_abline.R +++ b/R/type_abline.R @@ -103,9 +103,7 @@ type_abline = function(a = 0, b = 1) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) - out = modify_list(settings, out) - return(out) + update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) } draw_abline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_area.R b/R/type_area.R index 7a8b21a1..da72aa55 100644 --- a/R/type_area.R +++ b/R/type_area.R @@ -17,15 +17,13 @@ data_area = function(alpha = alpha) { list2env(settings[c("datapoints")], environment()) datapoints$ymax = datapoints$y datapoints$ymin = rep.int(0, nrow(datapoints)) - out = list( + update_settings(settings, datapoints = datapoints, ymax = datapoints$ymax, ymin = datapoints$ymin, type = "ribbon", ribbon.alpha = ribbon.alpha ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_barplot.R b/R/type_barplot.R index 3fbde321..26c2e95f 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -187,14 +187,14 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, } } - out = list( + update_settings(settings, datapoints = datapoints, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, axes = TRUE, - xlabs = xlabs, + xlabs = xlabs, frame.plot = FALSE, xaxs = "r", xaxt = if (xaxt == "s") "l" else xaxt, @@ -203,8 +203,6 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, col = col, bg = bg ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_boxplot.R b/R/type_boxplot.R index 5c8c6d50..80f3c9ee 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -141,8 +141,7 @@ data_boxplot = function() { if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet - out = modify_list(settings, out) - return(out) + do.call(update_settings, c(list(settings), out)) } return(fun) } diff --git a/R/type_density.R b/R/type_density.R index 3e71fb76..4d95cfc9 100644 --- a/R/type_density.R +++ b/R/type_density.R @@ -151,17 +151,15 @@ data_density = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, dtype = if (!is.null(bg)) "ribbon" else "l" dwas_area_type = !is.null(bg) - out = list( + update_settings(settings, ylab = ylab, type = dtype, was_area_type = dwas_area_type, ribbon.alpha = ribbon.alpha, datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, + by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_function.R b/R/type_function.R index baef6ccd..80b73b88 100644 --- a/R/type_function.R +++ b/R/type_function.R @@ -54,9 +54,7 @@ type_function = function(fun = dnorm, args = list(), n = 101, ...) { tmp = do.call(fun, tmp) ylim = c(min(tmp), max(tmp)) } - out = list(xlim = xlim, ylim = ylim) - out = modify_list(settings, out) - return(out) + update_settings(settings, xlim = xlim, ylim = ylim) } } draw_function = function() { diff --git a/R/type_glm.R b/R/type_glm.R index eba6be17..e952f0a5 100644 --- a/R/type_glm.R +++ b/R/type_glm.R @@ -61,9 +61,7 @@ data_glm = function(family, se, level, type, ...) { }) datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } return(fun) } diff --git a/R/type_histogram.R b/R/type_histogram.R index 7ef7a32e..9eb6dd73 100644 --- a/R/type_histogram.R +++ b/R/type_histogram.R @@ -145,7 +145,8 @@ data_histogram = function(breaks = "Sturges", ylab = ifelse(datapoints$freq[1], "Frequency", "Density") } - out = list( + # browser() + update_settings(settings, x = c(datapoints$xmin, datapoints$xmax), y = c(datapoints$ymin, datapoints$ymax), ymin = datapoints$ymin, @@ -159,10 +160,6 @@ data_histogram = function(breaks = "Sturges", by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet ) - # browser() - out = modify_list(settings, out) - # out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_hline.R b/R/type_hline.R index 5d02cc65..86765990 100644 --- a/R/type_hline.R +++ b/R/type_hline.R @@ -16,9 +16,7 @@ type_hline = function(h = 0) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) - out = modify_list(settings, out) - return(out) + update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) } draw_hline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_jitter.R b/R/type_jitter.R index a2ba0274..bda31414 100644 --- a/R/type_jitter.R +++ b/R/type_jitter.R @@ -51,14 +51,12 @@ data_jitter = function(factor, amount) { datapoints$x = x datapoints$y = y - out = list( + update_settings(settings, datapoints = datapoints, x = x, y = y, xlabs = xlabs, ylabs = ylabs ) - out = modify_list(settings, out) - return(out) } } diff --git a/R/type_lm.R b/R/type_lm.R index 398672ed..13ba1080 100644 --- a/R/type_lm.R +++ b/R/type_lm.R @@ -57,9 +57,7 @@ data_lm = function(se, level, ...) { }) datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } return(fun) } diff --git a/R/type_loess.R b/R/type_loess.R index cba5f664..beacbc0a 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -51,9 +51,7 @@ data_loess = function(span, degree, family, control, se, level, ...) { }) datapoints = do.call(rbind, datapoints) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } return(fun) } diff --git a/R/type_pointrange.R b/R/type_pointrange.R index 1f4f0b7a..4a90e605 100644 --- a/R/type_pointrange.R +++ b/R/type_pointrange.R @@ -92,14 +92,11 @@ data_pointrange = function(dodge, fixed.pos) { } } - out = list( + update_settings(settings, x = datapoints$x, xlabs = xlabs, datapoints = datapoints ) - - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_points.R b/R/type_points.R index 7fad968a..d6f38af5 100644 --- a/R/type_points.R +++ b/R/type_points.R @@ -85,7 +85,7 @@ data_points = function(clim = c(0.5, 2.5)) { } } - out = list( + update_settings(settings, datapoints = datapoints, xlabs = xlabs, ylabs = ylabs, @@ -94,8 +94,6 @@ data_points = function(clim = c(0.5, 2.5)) { bubble_cex = bubble_cex, legend_args = legend_args ) - out = modify_list(settings, out) - return(out) } } diff --git a/R/type_qq.R b/R/type_qq.R index c063b772..a4067dda 100644 --- a/R/type_qq.R +++ b/R/type_qq.R @@ -21,9 +21,7 @@ type_qq = function(distribution = qnorm) { x = distribution(ppoints(x)) datapoints$x = x datapoints$y = y - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } } diff --git a/R/type_ribbon.R b/R/type_ribbon.R index 3b13546a..eb24ea8b 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -111,8 +111,7 @@ data_ribbon = function(ribbon.alpha = NULL) { if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet - out = modify_list(settings, out) - return(out) + do.call(update_settings, c(list(settings), out)) } return(fun) } diff --git a/R/type_ridge.R b/R/type_ridge.R index df9ed8e4..4ebb91f2 100644 --- a/R/type_ridge.R +++ b/R/type_ridge.R @@ -391,7 +391,7 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, if (is.null(col) && (!anyby || x_by)) col = "black" - out = list( + update_settings(settings, datapoints = datapoints, yaxt = "n", ylim = c(min(datapoints$ymin), max(datapoints$ymax)), @@ -410,8 +410,6 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, alpha = alpha ) ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_spineplot.R b/R/type_spineplot.R index baf18a6b..72f592cc 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -241,17 +241,17 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels ## grayscale flag grayscale = null_by && is.null(raw_input$palette) && is.null(.tpar[["palette.qualitative"]]) - out = list( - x = c(datapoints$xmin, datapoints$xmax), + update_settings(settings, + x = c(datapoints$xmin, datapoints$xmax), y = c(datapoints$ymin, datapoints$ymax), - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xmin = datapoints$xmin, - xmax = datapoints$xmax, + ymin = datapoints$ymin, + ymax = datapoints$ymax, + xmin = datapoints$xmin, + xmax = datapoints$xmax, col = col, bg = bg, datapoints = datapoints, - by = if (null_by) by else datapoints$by, + by = if (null_by) by else datapoints$by, facet = if (null_facet) facet else datapoints$facet, axes = FALSE, frame.plot = FALSE, @@ -271,7 +271,7 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels yaxlabels = yaxlabels, breaks = breaks, axes = axes, - xaxt = xaxt, + xaxt = xaxt, yaxt = yaxt, grayscale = grayscale, x_by = x_by, @@ -280,9 +280,6 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels facet.args = facet.args ) - out = modify_list(settings, out) - return(out) - } return(fun) } diff --git a/R/type_spline.R b/R/type_spline.R index 6d8605f8..04a82dd5 100644 --- a/R/type_spline.R +++ b/R/type_spline.R @@ -53,9 +53,7 @@ data_spline = function(n, method, xmin, xmax, xout, ties, ...) { return(fit) }) datapoints = do.call(rbind, datapoints) - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } return(fun) } diff --git a/R/type_summary.R b/R/type_summary.R index bab6d99c..c946f827 100644 --- a/R/type_summary.R +++ b/R/type_summary.R @@ -51,9 +51,7 @@ type_summary = function(fun = mean, ...) { return(dat) }) datapoints = do.call(rbind, datapoints) - out = list(datapoints = datapoints) - out = modify_list(settings, out) - return(out) + update_settings(settings, datapoints = datapoints) } return(funky) } diff --git a/R/type_text.R b/R/type_text.R index 707e0278..eaca50a3 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -125,14 +125,12 @@ data_text = function(labels = NULL, clim = c(0.5, 2.5)) { } } - out = list( + update_settings(settings, datapoints = datapoints, cex = cex, bubble = bubble, bubble_cex = bubble_cex ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_violin.R b/R/type_violin.R index a312ecc1..3472340d 100644 --- a/R/type_violin.R +++ b/R/type_violin.R @@ -206,17 +206,15 @@ data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, datapoints = do.call(rbind, datapoints) datapoints = datapoints[1:(nrow(datapoints)-1), ] - out = list( + update_settings(settings, datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, + by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet, ylab = ylab, xlabs = xlabs, col = col, bg = bg ) - out = modify_list(settings, out) - return(out) } return(fun) } diff --git a/R/type_vline.R b/R/type_vline.R index 985a5f3d..d676b9f6 100644 --- a/R/type_vline.R +++ b/R/type_vline.R @@ -16,9 +16,7 @@ type_vline = function(v = 0) { ul_lty = length(unique(lty)) ul_col = length(unique(col)) - out = list(type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) - out = modify_list(settings, out) - return(out) + update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) } draw_vline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/utils.R b/R/utils.R index b419d3ea..454372e7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -68,7 +68,8 @@ swap_columns = function(dp, a, b) { } -modify_list = function(a, b) { - a = a[setdiff(names(a), names(b))] - c(a, b) +update_settings = function(settings, ...) { + new = list(...) + settings = settings[setdiff(names(settings), names(new))] + c(settings, new) } From 813e59c7f74775a5194ee469e28ced6297d7c733 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Mon, 6 Oct 2025 15:54:35 -0400 Subject: [PATCH 35/54] by_aesthetics() treats by_col and by_bg in the same way as others --- R/by_aesthetics.R | 71 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 52 insertions(+), 19 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index fc9230f5..3e74813f 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -9,32 +9,61 @@ by_aesthetics = function(settings) { by_ordered = is.ordered(by) } - ngrps = if (null_by) 1L else if (is.factor(by)) nlevels(by) else if (by_continuous) 100L else length(unique(by)) + if (null_by) { + ngrps = 1L + } else if (is.factor(by)) { + ngrps = nlevels(by) + } else if (by_continuous) { + ngrps = 100L + } else { + ngrps = length(unique(by)) + } + pch = by_pch(ngrps = ngrps, type = type, pch = pch) lty = by_lty(ngrps = ngrps, type = type, lty = lty) lwd = by_lwd(ngrps = ngrps, type = type, lwd = lwd) cex = by_cex(ngrps = ngrps, type = type, bubble = bubble, cex = cex) - out = update_settings(settings, + col = by_col( + col = col, + palette = settings$palette, # must use unevaluated palette + alpha = alpha, + by_ordered = by_ordered, + by_continuous = by_continuous, + ngrps = ngrps, + adjustcolor = adjustcolor + ) + + bg = by_bg( + bg = bg, + fill = fill, + col = col, + palette = settings$palette, # must use unevaluated palette + alpha = alpha, + by_ordered = by_ordered, + by_continuous = by_continuous, + ngrps = ngrps, + type = type, + by = by, + ribbon.alpha = ribbon.alpha, + adjustcolor = adjustcolor + ) + + update_settings(settings, by_continuous = by_continuous, by_ordered = by_ordered, ngrps = ngrps, pch = pch, lty = lty, lwd = lwd, - cex = cex + cex = cex, + col = col, + bg = bg ) - - out$col = by_col(settings = out) - out$bg = by_bg(adjustcolor = adjustcolor, settings = out) - - out } -by_col = function(settings) { - list2env(settings, environment()) - palette = settings$palette # not sure why we need this +by_col = function(col, palette, alpha, by_ordered, by_continuous, ngrps, adjustcolor) { ordered = by_ordered gradient = by_continuous @@ -466,19 +495,23 @@ by_cex = function(ngrps, type, bubble = FALSE, cex = NULL) { -by_bg = function(adjustcolor, settings) { - list2env(settings, environment()) - palette = settings$palette # not sure why we need this - - - if (is.null(bg) && !is.null(fill)) settings$bg = bg = fill +by_bg = function(bg, fill, col, palette, alpha, by_ordered, by_continuous, ngrps, type, by, ribbon.alpha, adjustcolor) { + if (is.null(bg) && !is.null(fill)) bg = fill if (!is.null(bg) && length(bg) == 1 && is.numeric(bg) && bg >= 0 && bg <= 1) { alpha = bg bg = "by" } if (!is.null(bg) && length(bg) == 1 && bg == "by") { # use by_col processing, but with the bg-specific colors - bg = by_col(settings = update_settings(settings, col = NULL, bg = bg, alpha = alpha, palette = palette)) + bg = by_col( + col = NULL, + palette = palette, + alpha = alpha, + by_ordered = by_ordered, + by_continuous = by_continuous, + ngrps = ngrps, + adjustcolor = adjustcolor + ) } else if (length(bg) != ngrps) { bg = rep(bg, ngrps) } @@ -490,5 +523,5 @@ by_bg = function(adjustcolor, settings) { } } - return(bg) + bg } From 612133f1f5a50b407af87e4b675c2904acbb31b2 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 13:18:50 -0500 Subject: [PATCH 36/54] stats::setNames is already imported --- R/draw_legend.R | 4 ++-- R/flip.R | 7 +++---- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/draw_legend.R b/R/draw_legend.R index 7269f835..b8ddee0e 100644 --- a/R/draw_legend.R +++ b/R/draw_legend.R @@ -707,10 +707,10 @@ sanitize_legend = function(legend, legend_args) { lnms = names(largs) # check second position b/c first will be a symbol if (is.null(lnms)) { - largs = stats::setNames(largs, c("", "x")) + largs = setNames(largs, c("", "x")) } else if (length(largs) >= 2 && lnms[2] == "") { lnms[2] = "x" - largs = stats::setNames(largs, lnms) + largs = setNames(largs, lnms) } else { largs[["x"]] = "right!" } diff --git a/R/flip.R b/R/flip.R index 146f07da..f4de2ec7 100644 --- a/R/flip.R +++ b/R/flip.R @@ -2,11 +2,11 @@ swap_elements = function(lst, a, b) { if (any(!c(a, b) %in% names(lst))) { out = lst } else if (all(c(a, b) %in% names(lst))) { - out = do.call(update_settings, c(list(lst), stats::setNames(lst[c(b, a)], c(a, b)))) + out = do.call(update_settings, c(list(lst), setNames(lst[c(b, a)], c(a, b)))) } else if (a %in% names(lst)) { - out = do.call(update_settings, c(list(lst), stats::setNames(list(NULL, lst[[a]]), c(a, b)))) + out = do.call(update_settings, c(list(lst), setNames(list(NULL, lst[[a]]), c(a, b)))) } else if (b %in% names(lst)) { - out = do.call(update_settings, c(list(lst), stats::setNames(list(NULL, lst[[b]]), c(b, a)))) + out = do.call(update_settings, c(list(lst), setNames(list(NULL, lst[[b]]), c(b, a)))) } out } @@ -47,4 +47,3 @@ flip_datapoints = function(settings) { } return(settings) } - From c52555e565c3618605ecc6b99aeb9eec657fcb7e Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 20:15:56 -0500 Subject: [PATCH 37/54] raw_input is not necessary --- R/tinyplot.R | 4 ++-- R/type_barplot.R | 4 ++-- R/type_boxplot.R | 5 ++--- R/type_spineplot.R | 2 +- R/type_violin.R | 4 ++-- R/zzz.R | 1 - 6 files changed, 9 insertions(+), 11 deletions(-) diff --git a/R/tinyplot.R b/R/tinyplot.R index db598a81..8e8d1bc3 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -760,6 +760,8 @@ tinyplot.default = function( null_by = is.null(by), null_xlim = is.null(xlim), 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" @@ -793,8 +795,6 @@ tinyplot.default = function( type_info = list() # pass type-specific info from type_data to type_draw ) - settings[["raw_input"]] = settings - # ## devices and files ----- diff --git a/R/type_barplot.R b/R/type_barplot.R index 26c2e95f..ac1ef299 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -79,7 +79,7 @@ type_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, #' @importFrom stats aggregate data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, xlevels = NULL, xaxlabels = NULL, drop.zeros = FALSE) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "raw_input", "col", "bg", "yaxl", "xaxt")], environment()) + list2env(settings[c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "null_palette", "col", "bg", "yaxl", "xaxt")], environment()) ## tabulate/aggregate datapoints if (is.null(datapoints$y)) { @@ -131,7 +131,7 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, ## default color palette ngrps = length(unique(datapoints$by)) - if (ngrps == 1L && is.null(raw_input$palette)) { + if (ngrps == 1L && null_palette) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "grey" } else { diff --git a/R/type_boxplot.R b/R/type_boxplot.R index 80f3c9ee..c18e7260 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -115,9 +115,8 @@ data_boxplot = function() { xord = order(datapoints$by, datapoints$facet, datapoints$x) } - # Check if user provided palette from raw_input (before substitute) - user_palette = raw_input$palette - if (length(unique(datapoints[["by"]])) == 1 && is.null(user_palette)) { + # Check if user provided palette before substitute) + if (length(unique(datapoints[["by"]])) == 1 && null_palette) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "lightgray" } else { diff --git a/R/type_spineplot.R b/R/type_spineplot.R index 72f592cc..0505d25c 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -239,7 +239,7 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels if (isTRUE(y_by)) datapoints$by = factor(rep_len(yaxlabels, nrow(datapoints))) ## grayscale flag - grayscale = null_by && is.null(raw_input$palette) && is.null(.tpar[["palette.qualitative"]]) + grayscale = null_by && null_palette && is.null(.tpar[["palette.qualitative"]]) update_settings(settings, x = c(datapoints$xmin, datapoints$xmax), diff --git a/R/type_violin.R b/R/type_violin.R index 3472340d..605d511c 100644 --- a/R/type_violin.R +++ b/R/type_violin.R @@ -79,7 +79,7 @@ type_violin = function( data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, joint.bw = "none", trim = FALSE, width = 0.9) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "by", "raw_input", "facet", "ylab", "col", "bg", "log", "null_by", "null_facet")], + list2env(settings[c("datapoints", "by", "null_palette", "facet", "ylab", "col", "bg", "log", "null_by", "null_facet")], environment()) @@ -125,7 +125,7 @@ data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, xord = order(datapoints$by, datapoints$facet, datapoints$x) } - if (length(unique(datapoints[["by"]])) == 1 && is.null(raw_input$palette)) { + if (length(unique(datapoints[["by"]])) == 1 && null_palette) { if (is.null(col)) col = par("fg") if (is.null(bg)) bg = "lightgray" } else if (is.null(bg)) { diff --git a/R/zzz.R b/R/zzz.R index 9071dab3..6e3856cf 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -60,7 +60,6 @@ "oxaxis", "oyaxis", "pch", - "raw_input", "ribbon.alpha", "split_data", "tpars", From 1fdef88979ce9e88a07ab037adb53811526d5484 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 20:21:32 -0500 Subject: [PATCH 38/54] comments and reorder by_aesthetics.R --- R/by_aesthetics.R | 70 +++++++++++++++++++++++++++-------------------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 3e74813f..cbf1c3eb 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -1,3 +1,7 @@ +# +## orchestration function ----- +# + by_aesthetics = function(settings) { list2env(settings, environment()) by_ordered = FALSE @@ -63,6 +67,10 @@ by_aesthetics = function(settings) { } +# +## subsidiary functions ----- +# + by_col = function(col, palette, alpha, by_ordered, by_continuous, ngrps, adjustcolor) { ordered = by_ordered gradient = by_continuous @@ -339,6 +347,38 @@ gen_pal_fun = function(pal, gradient = FALSE, alpha = NULL, n = NULL) { } +by_bg = function(bg, fill, col, palette, alpha, by_ordered, by_continuous, ngrps, type, by, ribbon.alpha, adjustcolor) { + if (is.null(bg) && !is.null(fill)) bg = fill + if (!is.null(bg) && length(bg) == 1 && is.numeric(bg) && bg >= 0 && bg <= 1) { + alpha = bg + bg = "by" + } + if (!is.null(bg) && length(bg) == 1 && bg == "by") { + # use by_col processing, but with the bg-specific colors + bg = by_col( + col = NULL, + palette = palette, + alpha = alpha, + by_ordered = by_ordered, + by_continuous = by_continuous, + ngrps = ngrps, + adjustcolor = adjustcolor + ) + } else if (length(bg) != ngrps) { + bg = rep(bg, ngrps) + } + if (type == "ribbon" || (type == "boxplot" && !is.null(by))) { + if (!is.null(bg)) { + bg = adjustcolor(bg, ribbon.alpha) + } else if (!is.null(col)) { + bg = adjustcolor(col, ribbon.alpha) + } + } + + bg +} + + by_pch = function(ngrps, type, pch = NULL) { no_pch = FALSE if (identical(type, "text")) { @@ -495,33 +535,3 @@ by_cex = function(ngrps, type, bubble = FALSE, cex = NULL) { -by_bg = function(bg, fill, col, palette, alpha, by_ordered, by_continuous, ngrps, type, by, ribbon.alpha, adjustcolor) { - if (is.null(bg) && !is.null(fill)) bg = fill - if (!is.null(bg) && length(bg) == 1 && is.numeric(bg) && bg >= 0 && bg <= 1) { - alpha = bg - bg = "by" - } - if (!is.null(bg) && length(bg) == 1 && bg == "by") { - # use by_col processing, but with the bg-specific colors - bg = by_col( - col = NULL, - palette = palette, - alpha = alpha, - by_ordered = by_ordered, - by_continuous = by_continuous, - ngrps = ngrps, - adjustcolor = adjustcolor - ) - } else if (length(bg) != ngrps) { - bg = rep(bg, ngrps) - } - if (type == "ribbon" || (type == "boxplot" && !is.null(by))) { - if (!is.null(bg)) { - bg = adjustcolor(bg, ribbon.alpha) - } else if (!is.null(col)) { - bg = adjustcolor(col, ribbon.alpha) - } - } - - bg -} From b0a1e07f43df0a55f0ae635ffda532e4e0422bbd Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 20:38:49 -0500 Subject: [PATCH 39/54] update_settings everywhere except 1 --- R/sanitize_axes.R | 3 +-- R/sanitize_datapoints.R | 3 +-- R/sanitize_facet.R | 3 +-- R/sanitize_type.R | 8 ++++---- R/type_rug.R | 2 +- 5 files changed, 8 insertions(+), 11 deletions(-) diff --git a/R/sanitize_axes.R b/R/sanitize_axes.R index ab3f52ce..f4355dc1 100644 --- a/R/sanitize_axes.R +++ b/R/sanitize_axes.R @@ -24,7 +24,6 @@ sanitize_axes = function(settings) { if (is.null(frame.plot) || !is.logical(frame.plot)) frame.plot = all(c(xaxt, yaxt) %in% c("s", "a")) - new = list(axes = axes, xaxt = xaxt, yaxt = yaxt, frame.plot = frame.plot) - settings = modifyList(settings, new, keep.null = TRUE) + settings = update_settings(settings, axes = axes, xaxt = xaxt, yaxt = yaxt, frame.plot = frame.plot) return(settings) } diff --git a/R/sanitize_datapoints.R b/R/sanitize_datapoints.R index 9312818b..af6d385b 100644 --- a/R/sanitize_datapoints.R +++ b/R/sanitize_datapoints.R @@ -42,7 +42,6 @@ sanitize_datapoints = function(settings) { } # potentially modified variables - new = list(x = x, y = y, xaxt = xaxt, datapoints = datapoints) - settings = modifyList(settings, new, keep.null = TRUE) + settings = update_settings(settings, x = x, y = y, xaxt = xaxt, datapoints = datapoints) return(settings) } diff --git a/R/sanitize_facet.R b/R/sanitize_facet.R index d03ab296..71b6900b 100644 --- a/R/sanitize_facet.R +++ b/R/sanitize_facet.R @@ -15,12 +15,11 @@ sanitize_facet = function(settings) { } facet_attr = attributes(facet) # TODO: better way to restore facet attributes? null_facet = is.null(facet) - new = list( + settings = update_settings(settings, facet = facet, null_facet = null_facet, facet_attr = facet_attr, facet_by = facet_by, by = by) - settings = modifyList(settings, new, keep.null = TRUE) return(settings) } diff --git a/R/sanitize_type.R b/R/sanitize_type.R index 727c2bc7..b43459ac 100644 --- a/R/sanitize_type.R +++ b/R/sanitize_type.R @@ -2,11 +2,11 @@ sanitize_type = function(settings) { list2env(settings, environment()) if (inherits(type, "tinyplot_type")) { - settings = modifyList(settings, list( + settings = update_settings(settings, type = type$name, type_draw = type$draw, type_data = type$data - ), keep.null = TRUE) + ) return(settings) } @@ -106,11 +106,11 @@ sanitize_type = function(settings) { } if (inherits(type, "tinyplot_type")) { - settings = modifyList(settings, list( + settings = update_settings(settings, type = type$name, type_draw = type$draw, type_data = type$data - ), keep.null = TRUE) + ) } return(settings) diff --git a/R/type_rug.R b/R/type_rug.R index a4ad31c3..69ae1fd1 100644 --- a/R/type_rug.R +++ b/R/type_rug.R @@ -40,7 +40,7 @@ type_rug = function(ticksize = 0.03, side = 1, quiet = getOption("warn") < 0, ji stop(msg, call. = FALSE) } - out = modifyList(settings, list(datapoints = datapoints), keep.null = TRUE) + out = update_settings(settings, datapoints = datapoints) return(out) } draw_rug = function(.ticksize = ticksize, .side = side, .quiet = quiet, .jitter = jitter, .amount = amount) { From 033c55e0adccc1c2da294ef9a5154fb9e9d546fb Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 21:42:22 -0500 Subject: [PATCH 40/54] settings list2env subset --- R/by_aesthetics.R | 2 +- R/lim.R | 2 +- R/sanitize_facet.R | 2 +- R/sanitize_type.R | 2 +- R/sanitize_xylab.R | 8 +------- R/type_boxplot.R | 2 +- R/type_bubble.R | 2 +- R/type_histogram.R | 2 +- R/type_hline.R | 2 +- R/type_jitter.R | 2 +- R/type_loess.R | 2 +- R/type_pointrange.R | 2 +- R/type_points.R | 2 +- R/type_qq.R | 2 +- R/type_spineplot.R | 2 +- R/type_spline.R | 2 +- R/type_summary.R | 2 +- R/type_text.R | 2 +- 18 files changed, 18 insertions(+), 24 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index cbf1c3eb..6a7b5ef6 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -3,7 +3,7 @@ # by_aesthetics = function(settings) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "by", "type", "null_by", "pch", "bg", "lty", "lwd", "bubble", "cex", "alpha", "col", "fill", "ribbon.alpha")], environment()) by_ordered = FALSE by_continuous = !null_by && inherits(datapoints$by, c("numeric", "integer")) if (isTRUE(by_continuous) && type %in% c("l", "b", "o", "ribbon", "polygon", "polypath", "boxplot")) { diff --git a/R/lim.R b/R/lim.R index 0e616667..dcb65bc9 100644 --- a/R/lim.R +++ b/R/lim.R @@ -1,7 +1,7 @@ # calculate limits of each plot lim_args = function(settings) { - list2env(settings, environment()) + list2env(settings[c("xaxb", "xlabs", "yaxb", "ylabs", "xlim", "ylim", "datapoints", "type", "null_xlim", "null_ylim")], environment()) # For cases where x/yaxb is provided and corresponding x/ylabs is not null... # We can subset these here to provide breaks diff --git a/R/sanitize_facet.R b/R/sanitize_facet.R index 71b6900b..1edd6883 100644 --- a/R/sanitize_facet.R +++ b/R/sanitize_facet.R @@ -1,5 +1,5 @@ sanitize_facet = function(settings) { - list2env(settings, environment()) + list2env(settings[c("facet", "by", "null_facet", "facet_attr", "facet_by")], environment()) # flag if facet=="by" (i.e., facet matches the grouping variable) facet_by = FALSE diff --git a/R/sanitize_type.R b/R/sanitize_type.R index b43459ac..d8722ed5 100644 --- a/R/sanitize_type.R +++ b/R/sanitize_type.R @@ -1,5 +1,5 @@ sanitize_type = function(settings) { - list2env(settings, environment()) + list2env(settings[c("type", "dots", "x", "y")], environment()) if (inherits(type, "tinyplot_type")) { settings = update_settings(settings, diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index 2a2920f1..4aaf55c5 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -1,11 +1,5 @@ sanitize_xylab = function(settings) { - list2env(settings[ - c( - "type", - "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", - "y", "ylab", "y_dep", "ymin_dep", "ymax_dep" - ) - ], environment()) + list2env(settings[c("type", "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", "y", "ylab", "y_dep", "ymin_dep", "ymax_dep")], environment()) out_xlab = NULL out_ylab = NULL diff --git a/R/type_boxplot.R b/R/type_boxplot.R index c18e7260..afa2564d 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -95,7 +95,7 @@ draw_boxplot = function(range, width, varwidth, notch, outline, boxwex, staplewe data_boxplot = function() { fun = function(settings, ...) { - list2env(settings, envir = environment()) + list2env(settings[c("datapoints", "by", "facet", "null_facet", "null_palette", "x", "col", "bg", "null_by")], envir = environment()) # Convert x to factor if it's not already datapoints$x = as.factor(datapoints$x) diff --git a/R/type_bubble.R b/R/type_bubble.R index 8446bb27..d8ab2d80 100644 --- a/R/type_bubble.R +++ b/R/type_bubble.R @@ -1,5 +1,5 @@ sanitize_bubble = function(settings) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "pch", "alpha", "bg", "cex", "bubble")], environment()) if (bubble) { datapoints[["cex"]] = cex bubble_pch = if (!is.null(pch) && length(pch)==1) pch else par("pch") diff --git a/R/type_histogram.R b/R/type_histogram.R index 9eb6dd73..65e32f89 100644 --- a/R/type_histogram.R +++ b/R/type_histogram.R @@ -101,7 +101,7 @@ data_histogram = function(breaks = "Sturges", hright = right fun = function(settings, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) { - list2env(settings, environment()) + list2env(settings[c("palette", "bg", "col", "plot", "datapoints", "ymin", "ymax", "xmin", "xmax", "freq", "ylab", "xlab", "facet", "ribbon.alpha")], environment()) hbreaks = ifelse(!sapply(.breaks, is.null), .breaks, "Sturges") diff --git a/R/type_hline.R b/R/type_hline.R index 86765990..a1227ac3 100644 --- a/R/type_hline.R +++ b/R/type_hline.R @@ -5,7 +5,7 @@ type_hline = function(h = 0) { assert_numeric(h) data_hline = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("lwd", "lty", "col", "datapoints")], environment()) if (nrow(datapoints) == 0) { msg = "`type_hline() only works on existing plots with x and y data points." diff --git a/R/type_jitter.R b/R/type_jitter.R index bda31414..be952a21 100644 --- a/R/type_jitter.R +++ b/R/type_jitter.R @@ -25,7 +25,7 @@ type_jitter = function(factor = 1, amount = NULL) { data_jitter = function(factor, amount) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings["datapoints"], environment()) x = datapoints$x y = datapoints$y diff --git a/R/type_loess.R b/R/type_loess.R index beacbc0a..1aeed0df 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -33,7 +33,7 @@ type_loess = function( data_loess = function(span, degree, family, control, se, level, ...) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints")], environment()) datapoints = split(datapoints, list(datapoints$facet, datapoints$by)) datapoints = Filter(function(k) nrow(k) > 0, datapoints) datapoints = lapply(datapoints, function(dat) { diff --git a/R/type_pointrange.R b/R/type_pointrange.R index 4a90e605..f9f7be5a 100644 --- a/R/type_pointrange.R +++ b/R/type_pointrange.R @@ -52,7 +52,7 @@ draw_pointrange = function() { data_pointrange = function(dodge, fixed.pos) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "xlabs")], environment()) if (is.character(datapoints$x)) { datapoints$x = as.factor(datapoints$x) diff --git a/R/type_points.R b/R/type_points.R index d6f38af5..9dd6151d 100644 --- a/R/type_points.R +++ b/R/type_points.R @@ -43,7 +43,7 @@ type_points = function(clim = c(0.5, 2.5)) { data_points = function(clim = c(0.5, 2.5)) { fun = function(settings, cex = NULL, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "cex", "legend_args")], environment()) # catch for factors (we should still be able to "force" plot these with points) if (is.factor(datapoints$x)) { diff --git a/R/type_qq.R b/R/type_qq.R index a4067dda..4fe4fc70 100644 --- a/R/type_qq.R +++ b/R/type_qq.R @@ -14,7 +14,7 @@ type_qq = function(distribution = qnorm) { data_qq = function(distribution) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints")], environment()) y = sort(datapoints$y) x = datapoints$x diff --git a/R/type_spineplot.R b/R/type_spineplot.R index 0505d25c..26faf2f6 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -79,7 +79,7 @@ type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, xlevels = #' @importFrom grDevices nclass.Sturges data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels = ylevels, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "xlim", "ylim", "facet", "facet.args", "by", "xaxb", "yaxb", "null_by", "null_facet", "null_palette", ".tpar", "col", "bg", "axes", "xaxt", "yaxt")], environment()) ## process weights if (!is.null(weights)) { diff --git a/R/type_spline.R b/R/type_spline.R index 04a82dd5..bb295bdf 100644 --- a/R/type_spline.R +++ b/R/type_spline.R @@ -34,7 +34,7 @@ type_spline = function(n = NULL, data_spline = function(n, method, xmin, xmax, xout, ties, ...) { fun = function(settings, ...) { - list2env(settings, environment()) + list2env(settings["datapoints"], environment()) datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { diff --git a/R/type_summary.R b/R/type_summary.R index c946f827..d9e57b3a 100644 --- a/R/type_summary.R +++ b/R/type_summary.R @@ -41,7 +41,7 @@ type_summary = function(fun = mean, ...) { lines_args = list(...) data_summary = function(fun) { funky = function(settings, ...) { - list2env(settings, environment()) + list2env(settings[c("datapoints", "by", "facet")], environment()) datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { diff --git a/R/type_text.R b/R/type_text.R index eaca50a3..f4deef18 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -86,7 +86,7 @@ type_text = function( data_text = function(labels = NULL, clim = c(0.5, 2.5)) { fun = function(settings, cex = NULL, ...) { - list2env(settings, envir = environment()) + list2env(settings[c("datapoints")], envir = environment()) if (is.null(labels)) { labels = datapoints$y } From e3b4ee754166d5a3379f215d9f3026a228c39939 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 21:48:39 -0500 Subject: [PATCH 41/54] avoid do.call in type_boxplot --- R/type_boxplot.R | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/R/type_boxplot.R b/R/type_boxplot.R index afa2564d..7157cf9c 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -127,7 +127,7 @@ data_boxplot = function() { datapoints = datapoints[xord,] # Return the result as a list called 'out' - out = list( + update_settings(settings, x = datapoints$x, y = datapoints$y, ymin = datapoints$ymin, @@ -135,12 +135,9 @@ data_boxplot = function() { xlabs = xlabs, datapoints = datapoints, col = col, - bg = bg) - - if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by - if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet - - do.call(update_settings, c(list(settings), out)) + bg = bg, + by = if (length(unique(datapoints$by)) > 1) datapoints$by else by, + by = if (length(unique(datapoints$facet)) > 1) datapoints$facet else facet) } return(fun) } From 9747199de2cea4fd96bbfd36f8f5d852e509ea8c Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 18 Nov 2025 21:51:20 -0500 Subject: [PATCH 42/54] sanitize_ribbon_alpha --- R/sanitize.R | 2 +- R/tinyplot.R | 4 ++-- R/type_ribbon.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/sanitize.R b/R/sanitize.R index 02285dc8..7bc273e8 100644 --- a/R/sanitize.R +++ b/R/sanitize.R @@ -1,4 +1,4 @@ -sanitize_ribbon.alpha = function(ribbon.alpha) { +sanitize_ribbon_alpha = function(ribbon.alpha) { assert_numeric(ribbon.alpha, len = 1, lower = 0, upper = 1, null.ok = TRUE) if (is.null(ribbon.alpha)) ribbon.alpha = .tpar[["ribbon.alpha"]] return(ribbon.alpha) diff --git a/R/tinyplot.R b/R/tinyplot.R index 8e8d1bc3..d1462755 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -785,8 +785,8 @@ tinyplot.default = function( pch = if (is.null(pch)) get_tpar("pch", default = NULL) else pch, # ribbon.alpha overwritten by some type_data() functions - # sanitize_ribbon.alpha: returns default alpha transparency for ribbon-type plots - ribbon.alpha = sanitize_ribbon.alpha(NULL), + # sanitize_ribbon_alpha: returns default alpha transparency for ribbon-type plots + ribbon.alpha = sanitize_ribbon_alpha(NULL), # misc flip = flip, diff --git a/R/type_ribbon.R b/R/type_ribbon.R index eb24ea8b..6de5fbd9 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -65,7 +65,7 @@ draw_ribbon = function() { data_ribbon = function(ribbon.alpha = NULL) { - ribbon.alpha = sanitize_ribbon.alpha(ribbon.alpha) + ribbon.alpha = sanitize_ribbon_alpha(ribbon.alpha) fun = function(settings, ...) { list2env(settings[c("datapoints", "xlabs", "null_by", "null_facet")], environment()) # Convert x to factor if it's not already From f33a6fd5c58f11565f92179d7b6bb4aa56f85edf Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 08:46:07 -0500 Subject: [PATCH 43/54] settings: list -> env --- R/by_aesthetics.R | 15 ++------ R/facet.R | 16 +++----- R/lim.R | 4 +- R/sanitize_axes.R | 5 +-- R/sanitize_datapoints.R | 7 +--- R/sanitize_facet.R | 10 +---- R/sanitize_type.R | 22 ++++------- R/sanitize_xylab.R | 5 ++- R/settings.R | 13 +++++++ R/setup_device.R | 2 +- R/tinyplot.R | 20 ++++++---- R/type_abline.R | 5 ++- R/type_area.R | 19 ++++++---- R/type_barplot.R | 41 +++++++++++--------- R/type_boxplot.R | 30 +++++++++------ R/type_bubble.R | 9 +++-- R/type_density.R | 26 +++++++------ R/type_function.R | 4 +- R/type_glm.R | 4 +- R/type_histogram.R | 38 +++++++++++-------- R/type_hline.R | 5 ++- R/type_jitter.R | 16 ++++---- R/type_lm.R | 4 +- R/type_loess.R | 4 +- R/type_pointrange.R | 13 ++++--- R/type_points.R | 20 +++++----- R/type_qq.R | 4 +- R/type_ribbon.R | 26 +++++++------ R/type_ridge.R | 43 +++++++++++---------- R/type_rug.R | 5 +-- R/type_spineplot.R | 83 ++++++++++++++++++++++------------------- R/type_spline.R | 4 +- R/type_summary.R | 4 +- R/type_text.R | 14 +++---- R/type_violin.R | 25 +++++++------ R/type_vline.R | 5 ++- 36 files changed, 302 insertions(+), 268 deletions(-) create mode 100644 R/settings.R diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 6a7b5ef6..ec52c8c7 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -53,17 +53,10 @@ by_aesthetics = function(settings) { adjustcolor = adjustcolor ) - update_settings(settings, - by_continuous = by_continuous, - by_ordered = by_ordered, - ngrps = ngrps, - pch = pch, - lty = lty, - lwd = lwd, - cex = cex, - col = col, - bg = bg - ) + settings[c("by_continuous", "by_ordered", "ngrps", "pch", "lty", "lwd", "cex", "col", "bg")] = + list(by_continuous = by_continuous, by_ordered = by_ordered, ngrps = ngrps, + pch = pch, lty = lty, lwd = lwd, cex = cex, col = col, bg = bg) + settings } diff --git a/R/facet.R b/R/facet.R index cb9067cc..1899bb02 100644 --- a/R/facet.R +++ b/R/facet.R @@ -585,17 +585,11 @@ facet_layout = function(settings) { cex_fct_adj = 1 } - update_settings(settings, - datapoints = datapoints, - facets = facets, - ifacet = ifacet, - nfacets = nfacets, - nfacet_rows = nfacet_rows, - nfacet_cols = nfacet_cols, - oxaxis = oxaxis, - oyaxis = oyaxis, - cex_fct_adj = cex_fct_adj - ) + settings[c("datapoints", "facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")] = + list(datapoints = datapoints, facets = facets, ifacet = ifacet, nfacets = nfacets, + nfacet_rows = nfacet_rows, nfacet_cols = nfacet_cols, oxaxis = oxaxis, + oyaxis = oyaxis, cex_fct_adj = cex_fct_adj) + settings } diff --git a/R/lim.R b/R/lim.R index dcb65bc9..3f3ef24c 100644 --- a/R/lim.R +++ b/R/lim.R @@ -32,5 +32,7 @@ lim_args = function(settings) { if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) - update_settings(settings, xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) + settings[c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb")] = + list(xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) + settings } diff --git a/R/sanitize_axes.R b/R/sanitize_axes.R index f4355dc1..a04dceff 100644 --- a/R/sanitize_axes.R +++ b/R/sanitize_axes.R @@ -1,5 +1,5 @@ sanitize_axes = function(settings) { - list2env(settings[c("axes", "xaxt", "yaxt", "frame.plot")], environment()) + env2env(settings, environment(), c("axes", "xaxt", "yaxt", "frame.plot")) ## handle defaults of axes, xaxt, yaxt, frame.plot ## - convert axes to character if necessary ## - set defaults of xaxt/yaxt (if these are NULL) based on axes @@ -24,6 +24,5 @@ sanitize_axes = function(settings) { if (is.null(frame.plot) || !is.logical(frame.plot)) frame.plot = all(c(xaxt, yaxt) %in% c("s", "a")) - settings = update_settings(settings, axes = axes, xaxt = xaxt, yaxt = yaxt, frame.plot = frame.plot) - return(settings) + env2env(environment(), settings, c("axes", "xaxt", "yaxt", "frame.plot")) } diff --git a/R/sanitize_datapoints.R b/R/sanitize_datapoints.R index af6d385b..c8f0e425 100644 --- a/R/sanitize_datapoints.R +++ b/R/sanitize_datapoints.R @@ -1,8 +1,6 @@ sanitize_datapoints = function(settings) { # potentially useful variables - list2env( - settings[c("x", "xmin", "xmax", "xaxt", "y", "ymin", "ymax", "ygroup", "facet", "null_by", "by", "type")], - environment()) + env2env(settings, environment(), c("x", "xmin", "xmax", "xaxt", "y", "ymin", "ymax", "ygroup", "facet", "null_by", "by", "type")) ## coerce character variables to factors if (!is.null(x) && is.character(x)) x = factor(x) @@ -42,6 +40,5 @@ sanitize_datapoints = function(settings) { } # potentially modified variables - settings = update_settings(settings, x = x, y = y, xaxt = xaxt, datapoints = datapoints) - return(settings) + env2env(environment(), settings, c("x", "y", "xaxt", "datapoints")) } diff --git a/R/sanitize_facet.R b/R/sanitize_facet.R index 1edd6883..12122b42 100644 --- a/R/sanitize_facet.R +++ b/R/sanitize_facet.R @@ -1,5 +1,5 @@ sanitize_facet = function(settings) { - list2env(settings[c("facet", "by", "null_facet", "facet_attr", "facet_by")], environment()) + env2env(settings, environment(), c("facet", "by", "null_facet", "facet_attr", "facet_by")) # flag if facet=="by" (i.e., facet matches the grouping variable) facet_by = FALSE @@ -15,11 +15,5 @@ sanitize_facet = function(settings) { } facet_attr = attributes(facet) # TODO: better way to restore facet attributes? null_facet = is.null(facet) - settings = update_settings(settings, - facet = facet, - null_facet = null_facet, - facet_attr = facet_attr, - facet_by = facet_by, - by = by) - return(settings) + env2env(environment(), settings, c("facet", "null_facet", "facet_attr", "facet_by", "by")) } diff --git a/R/sanitize_type.R b/R/sanitize_type.R index d8722ed5..c9c7377b 100644 --- a/R/sanitize_type.R +++ b/R/sanitize_type.R @@ -1,13 +1,11 @@ sanitize_type = function(settings) { - list2env(settings[c("type", "dots", "x", "y")], environment()) + env2env(settings, environment(), c("type", "dots", "x", "y")) if (inherits(type, "tinyplot_type")) { - settings = update_settings(settings, - type = type$name, - type_draw = type$draw, - type_data = type$data - ) - return(settings) + settings$type = type$name + settings$type_draw = type$draw + settings$type_data = type$data + return(invisible(NULL)) } known_types = c( @@ -106,12 +104,8 @@ sanitize_type = function(settings) { } if (inherits(type, "tinyplot_type")) { - settings = update_settings(settings, - type = type$name, - type_draw = type$draw, - type_data = type$data - ) + settings$type = type$name + settings$type_draw = type$draw + settings$type_data = type$data } - - return(settings) } diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index 4aaf55c5..7e6109e6 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -1,5 +1,5 @@ sanitize_xylab = function(settings) { - list2env(settings[c("type", "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", "y", "ylab", "y_dep", "ymin_dep", "ymax_dep")], environment()) + env2env(settings, environment(), c("type", "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", "y", "ylab", "y_dep", "ymin_dep", "ymax_dep")) out_xlab = NULL out_ylab = NULL @@ -48,5 +48,6 @@ sanitize_xylab = function(settings) { out_ylab = NULL } - update_settings(settings, xlab = out_xlab, ylab = out_ylab) + settings$xlab = out_xlab + settings$ylab = out_ylab } diff --git a/R/settings.R b/R/settings.R new file mode 100644 index 00000000..1dfcf09c --- /dev/null +++ b/R/settings.R @@ -0,0 +1,13 @@ +get_settings <- function(settings, keys) { + mget(keys, settings) +} + + +env2env <- function(source_env, target_env, keys = NULL) { + if (is.null(keys)) { + keys <- ls(source_env, all.names = TRUE) + } + for (nm in keys) { + assign(nm, source_env[[nm]], envir = target_env) + } +} diff --git a/R/setup_device.R b/R/setup_device.R index 286682b8..76441fca 100644 --- a/R/setup_device.R +++ b/R/setup_device.R @@ -1,5 +1,5 @@ setup_device = function(settings) { - list2env(settings[c("file", "width", "height")], environment()) + env2env(settings, environment(), c("file", "width", "height")) # write to file if (!is.null(file)) { diff --git a/R/tinyplot.R b/R/tinyplot.R index d1462755..f06c5d30 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -700,7 +700,7 @@ tinyplot.default = function( dots = list(...) - settings = list( + settings_list = list( # save call to check user input later call = match.call(), @@ -795,6 +795,8 @@ tinyplot.default = function( type_info = list() # pass type-specific info from type_data to type_draw ) + settings = new.env() + list2env(settings_list, settings) # ## devices and files ----- @@ -820,17 +822,17 @@ tinyplot.default = function( if (is.null(bg) && !is.null(fill)) settings$bg = fill # validate types and returns a list with name, data, and draw components - settings = sanitize_type(settings) + sanitize_type(settings) # standardize axis arguments and returns consistent axes, xaxt, yaxt, frame.plot - settings = sanitize_axes(settings) + sanitize_axes(settings) # generate appropriate axis labels based on input data and plot type - settings = sanitize_xylab(settings) + sanitize_xylab(settings) # palette default if (is.null(settings$palette)) { - settings = modifyList(settings, list(palette = get_tpar("palette", default = NULL))) + settings$palette = get_tpar("palette", default = NULL) } # by: coerce character groups to factor @@ -841,15 +843,16 @@ tinyplot.default = function( # flag if x==by, currently only used for # + # facet: parse facet formula and prepares variables when facet==by - settings = sanitize_facet(settings) + sanitize_facet(settings) # x / y processing # convert characters to factors # set x automatically when omitted (ex: rect) # set y automatically when omitted (ex: boxplots) # combine x, y, xmax, by, facet etc. into a single `datapoints` data.frame - settings = sanitize_datapoints(settings) + sanitize_datapoints(settings) # @@ -857,9 +860,10 @@ tinyplot.default = function( # if (!is.null(settings$type_data)) { - settings = settings$type_data(settings, ...) + settings$type_data(settings, ...) } + settings = as.list(settings, all.names = TRUE) # flip -> swap x and y after type_data, except for boxplots (which has its own bespoke flip logic) settings = flip_datapoints(settings) diff --git a/R/type_abline.R b/R/type_abline.R index ff6cc1f5..0e4a4c27 100644 --- a/R/type_abline.R +++ b/R/type_abline.R @@ -93,7 +93,7 @@ #' @export type_abline = function(a = 0, b = 1) { data_abline = function(settings, ...) { - list2env(settings[c("datapoints", "lwd", "lty", "col")], environment()) + env2env(settings, environment(), c("datapoints", "lwd", "lty", "col")) if (nrow(datapoints) == 0) { msg = "`type_abline() only works on existing plots with x and y data points." stop(msg, call. = FALSE) @@ -103,7 +103,8 @@ type_abline = function(a = 0, b = 1) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col) + env2env(environment(), settings, "type_info") } draw_abline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_area.R b/R/type_area.R index da72aa55..71ddcb3e 100644 --- a/R/type_area.R +++ b/R/type_area.R @@ -14,16 +14,19 @@ type_area = function(alpha = NULL) { data_area = function(alpha = alpha) { ribbon.alpha = if (is.null(alpha)) .tpar[["ribbon.alpha"]] else (alpha) fun = function(settings, ...) { - list2env(settings[c("datapoints")], environment()) + env2env(settings, environment(), "datapoints") datapoints$ymax = datapoints$y datapoints$ymin = rep.int(0, nrow(datapoints)) - update_settings(settings, - datapoints = datapoints, - ymax = datapoints$ymax, - ymin = datapoints$ymin, - type = "ribbon", - ribbon.alpha = ribbon.alpha - ) + ymax = datapoints$ymax + ymin = datapoints$ymin + type = "ribbon" + env2env(environment(), settings, c( + "datapoints", + "ymax", + "ymin", + "type", + "ribbon.alpha" + )) } return(fun) } diff --git a/R/type_barplot.R b/R/type_barplot.R index ac1ef299..adf53dbc 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -79,7 +79,7 @@ type_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, #' @importFrom stats aggregate data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, xlevels = NULL, xaxlabels = NULL, drop.zeros = FALSE) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "null_palette", "col", "bg", "yaxl", "xaxt")], environment()) + env2env(settings, environment(), c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "null_palette", "col", "bg", "yaxl", "xaxt")) ## tabulate/aggregate datapoints if (is.null(datapoints$y)) { @@ -186,23 +186,28 @@ data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, yaxl = paste0("abs_", yaxl) } } - - update_settings(settings, - datapoints = datapoints, - xlab = xlab, - ylab = ylab, - xlim = xlim, - ylim = ylim, - axes = TRUE, - xlabs = xlabs, - frame.plot = FALSE, - xaxs = "r", - xaxt = if (xaxt == "s") "l" else xaxt, - yaxl = yaxl, - yaxs = "i", - col = col, - bg = bg - ) + + axes = TRUE + frame.plot = FALSE + xaxs = "r" + xaxt = if (xaxt == "s") "l" else xaxt + yaxs = "i" + env2env(environment(), settings, c( + "datapoints", + "xlab", + "ylab", + "xlim", + "ylim", + "axes", + "xlabs", + "frame.plot", + "xaxs", + "xaxt", + "yaxl", + "yaxs", + "col", + "bg" + )) } return(fun) } diff --git a/R/type_boxplot.R b/R/type_boxplot.R index 7157cf9c..898858a0 100644 --- a/R/type_boxplot.R +++ b/R/type_boxplot.R @@ -95,7 +95,7 @@ draw_boxplot = function(range, width, varwidth, notch, outline, boxwex, staplewe data_boxplot = function() { fun = function(settings, ...) { - list2env(settings[c("datapoints", "by", "facet", "null_facet", "null_palette", "x", "col", "bg", "null_by")], envir = environment()) + env2env(settings, environment(), c("datapoints", "by", "facet", "null_facet", "null_palette", "x", "col", "bg", "null_by")) # Convert x to factor if it's not already datapoints$x = as.factor(datapoints$x) @@ -127,17 +127,23 @@ data_boxplot = function() { datapoints = datapoints[xord,] # Return the result as a list called 'out' - update_settings(settings, - x = datapoints$x, - y = datapoints$y, - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xlabs = xlabs, - datapoints = datapoints, - col = col, - bg = bg, - by = if (length(unique(datapoints$by)) > 1) datapoints$by else by, - by = if (length(unique(datapoints$facet)) > 1) datapoints$facet else facet) + x = datapoints$x + y = datapoints$y + ymin = datapoints$ymin + 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 + env2env(environment(), settings, c( + "x", + "y", + "ymin", + "ymax", + "xlabs", + "datapoints", + "col", + "bg", + "by", + "facet")) } return(fun) } diff --git a/R/type_bubble.R b/R/type_bubble.R index d8ab2d80..97982654 100644 --- a/R/type_bubble.R +++ b/R/type_bubble.R @@ -6,9 +6,10 @@ sanitize_bubble = function(settings) { 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 } - settings$datapoints = datapoints - settings$bubble_pch = if (bubble) bubble_pch else NULL - settings$bubble_alpha = if (bubble) bubble_alpha else NULL - settings$bubble_bg_alpha = if (bubble) bubble_bg_alpha else NULL + settings[c("datapoints", "bubble_pch", "bubble_alpha", "bubble_bg_alpha")] = + list(datapoints = datapoints, + bubble_pch = if (bubble) bubble_pch else NULL, + bubble_alpha = if (bubble) bubble_alpha else NULL, + bubble_bg_alpha = if (bubble) bubble_bg_alpha else NULL) settings } diff --git a/R/type_density.R b/R/type_density.R index 4d95cfc9..d4bd9b23 100644 --- a/R/type_density.R +++ b/R/type_density.R @@ -112,7 +112,7 @@ type_density = function( data_density = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, joint.bw = "none", alpha = NULL) { fun = function(settings, ...) { - list2env(settings[c("by", "bg", "facet", "ylab", "col", "ribbon.alpha", "datapoints")], environment()) + env2env(settings, environment(), c("by", "bg", "facet", "ylab", "col", "ribbon.alpha", "datapoints")) ribbon.alpha = if (is.null(alpha)) .tpar[["ribbon.alpha"]] else (alpha) if (is.null(ylab)) ylab = "Density" @@ -150,16 +150,20 @@ 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) - - update_settings(settings, - ylab = ylab, - type = dtype, - was_area_type = dwas_area_type, - ribbon.alpha = ribbon.alpha, - datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, - facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet - ) + + 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 + env2env(environment(), settings, c( + "ylab", + "type", + "was_area_type", + "ribbon.alpha", + "datapoints", + "by", + "facet" + )) } return(fun) } diff --git a/R/type_function.R b/R/type_function.R index 80b73b88..408e74fa 100644 --- a/R/type_function.R +++ b/R/type_function.R @@ -38,7 +38,7 @@ type_function = function(fun = dnorm, args = list(), n = 101, ...) { lines_args = list(...) data_function = function(args, fun) { funky = function(settings, ...) { - list2env(settings[c("xlim", "ylim", "datapoints")], environment()) + env2env(settings, environment(), c("xlim", "ylim", "datapoints")) if (nrow(datapoints) == 0 || !"x" %in% names(datapoints)) { stop("Need to provide x values to plot the function.", call. = FALSE) @@ -54,7 +54,7 @@ type_function = function(fun = dnorm, args = list(), n = 101, ...) { tmp = do.call(fun, tmp) ylim = c(min(tmp), max(tmp)) } - update_settings(settings, xlim = xlim, ylim = ylim) + env2env(environment(), settings, c("xlim", "ylim")) } } draw_function = function() { diff --git a/R/type_glm.R b/R/type_glm.R index e952f0a5..579e3681 100644 --- a/R/type_glm.R +++ b/R/type_glm.R @@ -29,7 +29,7 @@ type_glm = function(family = "gaussian", se = TRUE, level = 0.95, type = "respon data_glm = function(family, se, level, type, ...) { fun = function(settings, ...) { - list2env(settings[c("datapoints")], environment()) + env2env(settings, environment(), "datapoints") dat = split(datapoints, list(datapoints$facet, datapoints$by)) dat = lapply(dat, function(x) { if (nrow(x) == 0) { @@ -61,7 +61,7 @@ data_glm = function(family, se, level, type, ...) { }) datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } return(fun) } diff --git a/R/type_histogram.R b/R/type_histogram.R index 65e32f89..52adf080 100644 --- a/R/type_histogram.R +++ b/R/type_histogram.R @@ -101,7 +101,7 @@ data_histogram = function(breaks = "Sturges", hright = right fun = function(settings, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) { - list2env(settings[c("palette", "bg", "col", "plot", "datapoints", "ymin", "ymax", "xmin", "xmax", "freq", "ylab", "xlab", "facet", "ribbon.alpha")], environment()) + env2env(settings, environment(), c("palette", "bg", "col", "plot", "datapoints", "ymin", "ymax", "xmin", "xmax", "freq", "ylab", "xlab", "facet", "ribbon.alpha")) hbreaks = ifelse(!sapply(.breaks, is.null), .breaks, "Sturges") @@ -146,20 +146,28 @@ data_histogram = function(breaks = "Sturges", } # browser() - update_settings(settings, - x = c(datapoints$xmin, datapoints$xmax), - y = c(datapoints$ymin, datapoints$ymax), - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xmin = datapoints$xmin, - xmax = datapoints$xmax, - ylab = ylab, - col = col, - bg = bg, - datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, - facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet - ) + x = c(datapoints$xmin, datapoints$xmax) + y = c(datapoints$ymin, datapoints$ymax) + ymin = datapoints$ymin + ymax = datapoints$ymax + xmin = datapoints$xmin + 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 + env2env(environment(), settings, c( + "x", + "y", + "ymin", + "ymax", + "xmin", + "xmax", + "ylab", + "col", + "bg", + "datapoints", + "by", + "facet" + )) } return(fun) } diff --git a/R/type_hline.R b/R/type_hline.R index a1227ac3..3ac9bece 100644 --- a/R/type_hline.R +++ b/R/type_hline.R @@ -5,7 +5,7 @@ type_hline = function(h = 0) { assert_numeric(h) data_hline = function(settings, ...) { - list2env(settings[c("lwd", "lty", "col", "datapoints")], environment()) + env2env(settings, environment(), c("lwd", "lty", "col", "datapoints")) if (nrow(datapoints) == 0) { msg = "`type_hline() only works on existing plots with x and y data points." @@ -16,7 +16,8 @@ type_hline = function(h = 0) { ul_lwd = length(unique(lwd)) ul_lty = length(unique(lty)) ul_col = length(unique(col)) - update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col) + env2env(environment(), settings, "type_info") } draw_hline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, diff --git a/R/type_jitter.R b/R/type_jitter.R index be952a21..85b870e7 100644 --- a/R/type_jitter.R +++ b/R/type_jitter.R @@ -25,7 +25,7 @@ type_jitter = function(factor = 1, amount = NULL) { data_jitter = function(factor, amount) { fun = function(settings, ...) { - list2env(settings["datapoints"], environment()) + env2env(settings, environment(), "datapoints") x = datapoints$x y = datapoints$y @@ -51,12 +51,12 @@ data_jitter = function(factor, amount) { datapoints$x = x datapoints$y = y - update_settings(settings, - datapoints = datapoints, - x = x, - y = y, - xlabs = xlabs, - ylabs = ylabs - ) + env2env(environment(), settings, c( + "datapoints", + "x", + "y", + "xlabs", + "ylabs" + )) } } diff --git a/R/type_lm.R b/R/type_lm.R index 13ba1080..9bf4a627 100644 --- a/R/type_lm.R +++ b/R/type_lm.R @@ -30,7 +30,7 @@ type_lm = function(se = TRUE, level = 0.95) { data_lm = function(se, level, ...) { fun = function(settings, ...) { - list2env(settings[c("datapoints")], environment()) + env2env(settings, environment(), "datapoints") dat = split(datapoints, list(datapoints$facet, datapoints$by)) dat = lapply(dat, function(x) { if (nrow(x) == 0) { @@ -57,7 +57,7 @@ data_lm = function(se, level, ...) { }) datapoints = do.call(rbind, dat) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } return(fun) } diff --git a/R/type_loess.R b/R/type_loess.R index 1aeed0df..eea85e6b 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -33,7 +33,7 @@ type_loess = function( data_loess = function(span, degree, family, control, se, level, ...) { fun = function(settings, ...) { - list2env(settings[c("datapoints")], environment()) + env2env(settings, environment(), "datapoints") datapoints = split(datapoints, list(datapoints$facet, datapoints$by)) datapoints = Filter(function(k) nrow(k) > 0, datapoints) datapoints = lapply(datapoints, function(dat) { @@ -51,7 +51,7 @@ data_loess = function(span, degree, family, control, se, level, ...) { }) datapoints = do.call(rbind, datapoints) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } return(fun) } diff --git a/R/type_pointrange.R b/R/type_pointrange.R index f9f7be5a..49be5874 100644 --- a/R/type_pointrange.R +++ b/R/type_pointrange.R @@ -52,7 +52,7 @@ draw_pointrange = function() { data_pointrange = function(dodge, fixed.pos) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "xlabs")], environment()) + env2env(settings, environment(), c("datapoints", "xlabs")) if (is.character(datapoints$x)) { datapoints$x = as.factor(datapoints$x) @@ -92,11 +92,12 @@ data_pointrange = function(dodge, fixed.pos) { } } - update_settings(settings, - x = datapoints$x, - xlabs = xlabs, - datapoints = datapoints - ) + x = datapoints$x + env2env(environment(), settings, c( + "x", + "xlabs", + "datapoints" + )) } return(fun) } diff --git a/R/type_points.R b/R/type_points.R index 9dd6151d..53e868e2 100644 --- a/R/type_points.R +++ b/R/type_points.R @@ -43,7 +43,7 @@ type_points = function(clim = c(0.5, 2.5)) { data_points = function(clim = c(0.5, 2.5)) { fun = function(settings, cex = NULL, ...) { - list2env(settings[c("datapoints", "cex", "legend_args")], environment()) + env2env(settings, environment(), c("datapoints", "cex", "legend_args")) # catch for factors (we should still be able to "force" plot these with points) if (is.factor(datapoints$x)) { @@ -85,15 +85,15 @@ data_points = function(clim = c(0.5, 2.5)) { } } - update_settings(settings, - datapoints = datapoints, - xlabs = xlabs, - ylabs = ylabs, - cex = cex, - bubble = bubble, - bubble_cex = bubble_cex, - legend_args = legend_args - ) + env2env(environment(), settings, c( + "datapoints", + "xlabs", + "ylabs", + "cex", + "bubble", + "bubble_cex", + "legend_args" + )) } } diff --git a/R/type_qq.R b/R/type_qq.R index 4fe4fc70..8b2536d2 100644 --- a/R/type_qq.R +++ b/R/type_qq.R @@ -14,14 +14,14 @@ type_qq = function(distribution = qnorm) { data_qq = function(distribution) { fun = function(settings, ...) { - list2env(settings[c("datapoints")], environment()) + env2env(settings, environment(), "datapoints") y = sort(datapoints$y) x = datapoints$x x = distribution(ppoints(x)) datapoints$x = x datapoints$y = y - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } } diff --git a/R/type_ribbon.R b/R/type_ribbon.R index 6de5fbd9..b3028447 100644 --- a/R/type_ribbon.R +++ b/R/type_ribbon.R @@ -67,7 +67,7 @@ draw_ribbon = function() { data_ribbon = function(ribbon.alpha = NULL) { ribbon.alpha = sanitize_ribbon_alpha(ribbon.alpha) fun = function(settings, ...) { - list2env(settings[c("datapoints", "xlabs", "null_by", "null_facet")], environment()) + env2env(settings, environment(), c("datapoints", "xlabs", "null_by", "null_facet")) # Convert x to factor if it's not already if (is.character(datapoints$x)) { datapoints$x = as.factor(datapoints$x) @@ -99,19 +99,21 @@ data_ribbon = function(ribbon.alpha = NULL) { if (is.null(datapoints$ymin)) datapoints$ymin = datapoints$y if (is.null(datapoints$ymax)) datapoints$ymax = datapoints$y - out = list( - x = datapoints$x, - y = datapoints$y, - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xlabs = xlabs, - datapoints = datapoints, - ribbon.alpha = ribbon.alpha) + x = datapoints$x + y = datapoints$y + ymin = datapoints$ymin + ymax = datapoints$ymax + by = if (length(unique(datapoints$by)) > 1) datapoints$by else NULL + facet = if (length(unique(datapoints$facet)) > 1) datapoints$facet else NULL - if (length(unique(datapoints$by)) > 1) out[["by"]] = datapoints$by - if (length(unique(datapoints$facet)) > 1) out[["facet"]] = datapoints$facet + # ribbon.alpha comes from parent scope, so assign it locally + ribbon.alpha = ribbon.alpha - do.call(update_settings, c(list(settings), out)) + vars_to_copy = c("x", "y", "ymin", "ymax", "xlabs", "datapoints", "ribbon.alpha") + if (!is.null(by)) vars_to_copy = c(vars_to_copy, "by") + if (!is.null(facet)) vars_to_copy = c(vars_to_copy, "facet") + + env2env(environment(), settings, vars_to_copy) } return(fun) } diff --git a/R/type_ridge.R b/R/type_ridge.R index 4ebb91f2..c8a171b1 100644 --- a/R/type_ridge.R +++ b/R/type_ridge.R @@ -253,7 +253,7 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, alpha = NULL ) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "yaxt", "xaxt", "null_by")], environment()) + env2env(settings, environment(), c("datapoints", "yaxt", "xaxt", "null_by")) # catch for special cases anyby = !null_by @@ -391,25 +391,30 @@ data_ridge = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, if (is.null(col) && (!anyby || x_by)) col = "black" - update_settings(settings, - datapoints = datapoints, - yaxt = "n", - ylim = c(min(datapoints$ymin), max(datapoints$ymax)), - type_info = list( - gradient = gradient, - palette = palette, - breaks = breaks, - probs = probs, - manbreaks = manbreaks, - yaxt = yaxt, - raster = raster, - x_by = x_by, - y_by = y_by, - fill_by = fill_by, - col = col, - alpha = alpha - ) + # Save original yaxt for type_info before overwriting + yaxt_orig = yaxt + yaxt = "n" + ylim = c(min(datapoints$ymin), max(datapoints$ymax)) + type_info = list( + gradient = gradient, + palette = palette, + breaks = breaks, + probs = probs, + manbreaks = manbreaks, + yaxt = yaxt_orig, + raster = raster, + x_by = x_by, + y_by = y_by, + fill_by = fill_by, + col = col, + alpha = alpha ) + env2env(environment(), settings, c( + "datapoints", + "yaxt", + "ylim", + "type_info" + )) } return(fun) } diff --git a/R/type_rug.R b/R/type_rug.R index 69ae1fd1..85d7ee93 100644 --- a/R/type_rug.R +++ b/R/type_rug.R @@ -34,14 +34,13 @@ #' @export type_rug = function(ticksize = 0.03, side = 1, quiet = getOption("warn") < 0, jitter = FALSE, amount = NULL) { data_rug = function(settings, ...) { - list2env(settings["datapoints"], envir = environment()) + env2env(settings, environment(), "datapoints") if (nrow(datapoints) == 0) { msg = "`type_rug() only works on existing plots with x and y data points." stop(msg, call. = FALSE) } - out = update_settings(settings, datapoints = datapoints) - return(out) + env2env(environment(), settings, "datapoints") } draw_rug = function(.ticksize = ticksize, .side = side, .quiet = quiet, .jitter = jitter, .amount = amount) { fun = function(ix, iy, icol, ilwd, ...) { diff --git a/R/type_spineplot.R b/R/type_spineplot.R index 26faf2f6..7edcb192 100644 --- a/R/type_spineplot.R +++ b/R/type_spineplot.R @@ -79,7 +79,7 @@ type_spineplot = function(breaks = NULL, tol.ylab = 0.05, off = NULL, xlevels = #' @importFrom grDevices nclass.Sturges data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels = ylevels, xaxlabels = NULL, yaxlabels = NULL, weights = NULL) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "xlim", "ylim", "facet", "facet.args", "by", "xaxb", "yaxb", "null_by", "null_facet", "null_palette", ".tpar", "col", "bg", "axes", "xaxt", "yaxt")], environment()) + env2env(settings, environment(), c("datapoints", "xlim", "ylim", "facet", "facet.args", "by", "xaxb", "yaxb", "null_by", "null_facet", "null_palette", "col", "bg", "axes", "xaxt", "yaxt")) ## process weights if (!is.null(weights)) { @@ -240,45 +240,50 @@ data_spineplot = function(off = NULL, breaks = NULL, xlevels = xlevels, ylevels ## grayscale flag grayscale = null_by && null_palette && is.null(.tpar[["palette.qualitative"]]) - - update_settings(settings, - x = c(datapoints$xmin, datapoints$xmax), - y = c(datapoints$ymin, datapoints$ymax), - ymin = datapoints$ymin, - ymax = datapoints$ymax, - xmin = datapoints$xmin, - xmax = datapoints$xmax, - col = col, - bg = bg, - datapoints = datapoints, - by = if (null_by) by else datapoints$by, - facet = if (null_facet) facet else datapoints$facet, - axes = FALSE, - frame.plot = FALSE, - xaxt = "n", - yaxt = "n", - xaxs = "i", - yaxs = "i", - ylabs = yaxlabels, - type_info = list( - off = off, - x.categorical = x.categorical, - nx = nx, - ny = ny, - xat = xat, - yat = yat, - xaxlabels = xaxlabels, - yaxlabels = yaxlabels, - breaks = breaks, - axes = axes, - xaxt = xaxt, - yaxt = yaxt, - grayscale = grayscale, - x_by = x_by, - y_by = y_by - ), - facet.args = facet.args + + x = c(datapoints$xmin, datapoints$xmax) + y = c(datapoints$ymin, datapoints$ymax) + ymin = datapoints$ymin + ymax = datapoints$ymax + xmin = datapoints$xmin + xmax = datapoints$xmax + by = if (null_by) by else datapoints$by + facet = if (null_facet) facet else datapoints$facet + + # Save original values for type_info before overwriting + axes_orig = axes + xaxt_orig = xaxt + yaxt_orig = yaxt + + axes = FALSE + frame.plot = FALSE + xaxt = "n" + yaxt = "n" + xaxs = "i" + yaxs = "i" + ylabs = yaxlabels + type_info = list( + off = off, + x.categorical = x.categorical, + nx = nx, + ny = ny, + xat = xat, + yat = yat, + xaxlabels = xaxlabels, + yaxlabels = yaxlabels, + breaks = breaks, + axes = axes_orig, + xaxt = xaxt_orig, + yaxt = yaxt_orig, + grayscale = grayscale, + x_by = x_by, + y_by = y_by ) + env2env(environment(), settings, c( + "x", "y", "ymin", "ymax", "xmin", "xmax", "col", "bg", "datapoints", + "by", "facet", "axes", "frame.plot", "xaxt", "yaxt", "xaxs", "yaxs", + "ylabs", "type_info", "facet.args" + )) } return(fun) diff --git a/R/type_spline.R b/R/type_spline.R index bb295bdf..b1527ea0 100644 --- a/R/type_spline.R +++ b/R/type_spline.R @@ -34,7 +34,7 @@ type_spline = function(n = NULL, data_spline = function(n, method, xmin, xmax, xout, ties, ...) { fun = function(settings, ...) { - list2env(settings["datapoints"], environment()) + env2env(settings, environment(), "datapoints") datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { @@ -53,7 +53,7 @@ data_spline = function(n, method, xmin, xmax, xout, ties, ...) { return(fit) }) datapoints = do.call(rbind, datapoints) - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } return(fun) } diff --git a/R/type_summary.R b/R/type_summary.R index d9e57b3a..059609f9 100644 --- a/R/type_summary.R +++ b/R/type_summary.R @@ -41,7 +41,7 @@ type_summary = function(fun = mean, ...) { lines_args = list(...) data_summary = function(fun) { funky = function(settings, ...) { - list2env(settings[c("datapoints", "by", "facet")], environment()) + env2env(settings, environment(), c("datapoints", "by", "facet")) datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE) datapoints = lapply(datapoints, function(dat) { @@ -51,7 +51,7 @@ type_summary = function(fun = mean, ...) { return(dat) }) datapoints = do.call(rbind, datapoints) - update_settings(settings, datapoints = datapoints) + env2env(environment(), settings, "datapoints") } return(funky) } diff --git a/R/type_text.R b/R/type_text.R index f4deef18..425bf81e 100644 --- a/R/type_text.R +++ b/R/type_text.R @@ -86,7 +86,7 @@ type_text = function( data_text = function(labels = NULL, clim = c(0.5, 2.5)) { fun = function(settings, cex = NULL, ...) { - list2env(settings[c("datapoints")], envir = environment()) + env2env(settings, environment(), "datapoints") if (is.null(labels)) { labels = datapoints$y } @@ -125,12 +125,12 @@ data_text = function(labels = NULL, clim = c(0.5, 2.5)) { } } - update_settings(settings, - datapoints = datapoints, - cex = cex, - bubble = bubble, - bubble_cex = bubble_cex - ) + env2env(environment(), settings, c( + "datapoints", + "cex", + "bubble", + "bubble_cex" + )) } return(fun) } diff --git a/R/type_violin.R b/R/type_violin.R index 605d511c..d9e3db2a 100644 --- a/R/type_violin.R +++ b/R/type_violin.R @@ -79,8 +79,7 @@ type_violin = function( data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, joint.bw = "none", trim = FALSE, width = 0.9) { fun = function(settings, ...) { - list2env(settings[c("datapoints", "by", "null_palette", "facet", "ylab", "col", "bg", "log", "null_by", "null_facet")], - environment()) + env2env(settings, environment(), c("datapoints", "by", "null_palette", "facet", "ylab", "col", "bg", "log", "null_by", "null_facet")) # Handle ordering based on by and facet variables @@ -205,16 +204,18 @@ data_violin = function(bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, }) datapoints = do.call(rbind, datapoints) datapoints = datapoints[1:(nrow(datapoints)-1), ] - - update_settings(settings, - datapoints = datapoints, - by = if (length(unique(datapoints$by)) == 1) by else datapoints$by, - facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet, - ylab = ylab, - xlabs = xlabs, - col = col, - bg = bg - ) + + by = if (length(unique(datapoints$by)) == 1) by else datapoints$by + facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet + env2env(environment(), settings, c( + "datapoints", + "by", + "facet", + "ylab", + "xlabs", + "col", + "bg" + )) } return(fun) } diff --git a/R/type_vline.R b/R/type_vline.R index d676b9f6..25748211 100644 --- a/R/type_vline.R +++ b/R/type_vline.R @@ -5,7 +5,7 @@ type_vline = function(v = 0) { assert_numeric(v) data_vline = function(settings, ...) { - list2env(settings[c("datapoints", "lwd", "lty", "col")], envir = environment()) + env2env(settings, environment(), c("datapoints", "lwd", "lty", "col")) if (nrow(datapoints) == 0) { msg = "`type_vline() only works on existing plots with x and y data points." stop(msg, call. = FALSE) @@ -16,7 +16,8 @@ type_vline = function(v = 0) { ul_lty = length(unique(lty)) ul_col = length(unique(col)) - update_settings(settings, type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)) + type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col) + env2env(environment(), settings, "type_info") } draw_vline = function() { fun = function(ifacet, iby, data_facet, icol, ilty, ilwd, From c47e62487cfaa48604ad5aa104bc255f0a3a4c89 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 08:59:08 -0500 Subject: [PATCH 44/54] settings: list -> env --- R/flip.R | 61 ++++++++++++++++++++++++++----------------------- R/tinyplot.R | 6 ++--- R/type_bubble.R | 14 ++++++------ 3 files changed, 43 insertions(+), 38 deletions(-) diff --git a/R/flip.R b/R/flip.R index f4de2ec7..c1787c47 100644 --- a/R/flip.R +++ b/R/flip.R @@ -1,14 +1,10 @@ -swap_elements = function(lst, a, b) { - if (any(!c(a, b) %in% names(lst))) { - out = lst - } else if (all(c(a, b) %in% names(lst))) { - out = do.call(update_settings, c(list(lst), setNames(lst[c(b, a)], c(a, b)))) - } else if (a %in% names(lst)) { - out = do.call(update_settings, c(list(lst), setNames(list(NULL, lst[[a]]), c(a, b)))) - } else if (b %in% names(lst)) { - out = do.call(update_settings, c(list(lst), setNames(list(NULL, lst[[b]]), c(b, a)))) - } - out +swap_elements = function(env, a, b) { + # Swap two elements in an environment + val_a = if (exists(a, envir = env, inherits = FALSE)) env[[a]] else NULL + val_b = if (exists(b, envir = env, inherits = FALSE)) env[[b]] else NULL + + assign(a, val_b, envir = env) + assign(b, val_a, envir = env) } @@ -22,28 +18,37 @@ swap_columns = function(dp, a, b) { flip_datapoints = function(settings) { - flip = settings$flip + env2env(settings, environment(), c("flip", "type", "datapoints", "log")) + assert_flag(flip) if (isTRUE(flip)) { - if (settings$type == "boxplot") { + if (type == "boxplot") { # boxplot: let horizontal=TRUE do most work; only swap labels - settings = swap_elements(settings, "xlab", "ylab") + swap_elements(settings, "xlab", "ylab") } else { - datapoints = swap_columns(settings$datapoints, "xmin", "ymin") + datapoints = swap_columns(datapoints, "xmin", "ymin") datapoints = swap_columns(datapoints, "xmax", "ymax") - settings$datapoints = swap_columns(datapoints, "x", "y") - settings = swap_elements(settings, "x", "y") - settings = swap_elements(settings, "xaxb", "yaxb") - settings = swap_elements(settings, "xaxl", "yaxl") - settings = swap_elements(settings, "xaxs", "yaxs") - settings = swap_elements(settings, "xaxt", "yaxt") - settings = swap_elements(settings, "xlab", "ylab") - settings = swap_elements(settings, "xlabs", "ylabs") - settings = swap_elements(settings, "xlim", "ylim") - settings = swap_elements(settings, "xmax", "ymax") - settings = swap_elements(settings, "xmin", "ymin") - if (!is.null(settings$log)) settings$log = chartr("xy", "yx", settings$log) + datapoints = swap_columns(datapoints, "x", "y") + + # Swap all the x/y settings in the environment + swap_elements(settings, "x", "y") + swap_elements(settings, "xaxb", "yaxb") + swap_elements(settings, "xaxl", "yaxl") + swap_elements(settings, "xaxs", "yaxs") + swap_elements(settings, "xaxt", "yaxt") + swap_elements(settings, "xlab", "ylab") + swap_elements(settings, "xlabs", "ylabs") + swap_elements(settings, "xlim", "ylim") + swap_elements(settings, "xmax", "ymax") + swap_elements(settings, "xmin", "ymin") + + if (!is.null(log)) { + log = chartr("xy", "yx", log) + assign("log", log, envir = settings) + } + + # Copy modified datapoints back + assign("datapoints", datapoints, envir = settings) } } - return(settings) } diff --git a/R/tinyplot.R b/R/tinyplot.R index f06c5d30..28103a7a 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -863,9 +863,8 @@ tinyplot.default = function( settings$type_data(settings, ...) } - settings = as.list(settings, all.names = TRUE) # flip -> swap x and y after type_data, except for boxplots (which has its own bespoke flip logic) - settings = flip_datapoints(settings) + flip_datapoints(settings) # @@ -874,8 +873,9 @@ tinyplot.default = function( # 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) - settings = sanitize_bubble(settings) + sanitize_bubble(settings) + settings = as.list(settings, all.names = TRUE) # ## axis breaks and limits ----- diff --git a/R/type_bubble.R b/R/type_bubble.R index 97982654..53e3977e 100644 --- a/R/type_bubble.R +++ b/R/type_bubble.R @@ -1,15 +1,15 @@ sanitize_bubble = function(settings) { - list2env(settings[c("datapoints", "pch", "alpha", "bg", "cex", "bubble")], environment()) + env2env(settings, environment(), c("datapoints", "pch", "alpha", "bg", "cex", "bubble")) if (bubble) { 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 } - settings[c("datapoints", "bubble_pch", "bubble_alpha", "bubble_bg_alpha")] = - list(datapoints = datapoints, - bubble_pch = if (bubble) bubble_pch else NULL, - bubble_alpha = if (bubble) bubble_alpha else NULL, - bubble_bg_alpha = if (bubble) bubble_bg_alpha else NULL) - settings + + bubble_pch = if (bubble) bubble_pch else NULL + bubble_alpha = if (bubble) bubble_alpha else NULL + bubble_bg_alpha = if (bubble) bubble_bg_alpha else NULL + + env2env(environment(), settings, c("datapoints", "bubble_pch", "bubble_alpha", "bubble_bg_alpha")) } From cd54e7eb593704c4db145d931f925d34e2381b47 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 09:05:19 -0500 Subject: [PATCH 45/54] settings: list -> env --- R/facet.R | 6 +----- R/lim.R | 6 ++---- R/tinyplot.R | 6 +++--- 3 files changed, 6 insertions(+), 12 deletions(-) diff --git a/R/facet.R b/R/facet.R index 1899bb02..b5b799e9 100644 --- a/R/facet.R +++ b/R/facet.R @@ -585,11 +585,7 @@ facet_layout = function(settings) { cex_fct_adj = 1 } - settings[c("datapoints", "facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")] = - list(datapoints = datapoints, facets = facets, ifacet = ifacet, nfacets = nfacets, - nfacet_rows = nfacet_rows, nfacet_cols = nfacet_cols, oxaxis = oxaxis, - oyaxis = oyaxis, cex_fct_adj = cex_fct_adj) - settings + env2env(environment(), settings, c("datapoints", "facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")) } diff --git a/R/lim.R b/R/lim.R index 3f3ef24c..48fc0c6b 100644 --- a/R/lim.R +++ b/R/lim.R @@ -1,7 +1,7 @@ # calculate limits of each plot lim_args = function(settings) { - list2env(settings[c("xaxb", "xlabs", "yaxb", "ylabs", "xlim", "ylim", "datapoints", "type", "null_xlim", "null_ylim")], environment()) + env2env(settings, environment(), c("xaxb", "xlabs", "yaxb", "ylabs", "xlim", "ylim", "datapoints", "type", "null_xlim", "null_ylim")) # For cases where x/yaxb is provided and corresponding x/ylabs is not null... # We can subset these here to provide breaks @@ -32,7 +32,5 @@ lim_args = function(settings) { if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) - settings[c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb")] = - list(xlim = xlim, ylim = ylim, xlabs = xlabs, ylabs = ylabs, xaxb = xaxb, yaxb = yaxb) - settings + env2env(environment(), settings, c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb")) } diff --git a/R/tinyplot.R b/R/tinyplot.R index 28103a7a..dc58aa44 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -875,14 +875,13 @@ tinyplot.default = function( # easiest to assign/determine now) sanitize_bubble(settings) - settings = as.list(settings, all.names = TRUE) # ## axis breaks and limits ----- # # do this after computing yaxb because limits will depend on the previous calculations - settings = lim_args(settings) + lim_args(settings) # @@ -890,8 +889,9 @@ tinyplot.default = function( # # facet_layout processes facet simplification, attribute restoration, and layout - settings = facet_layout(settings) + facet_layout(settings) + settings = as.list(settings, all.names = TRUE) # ## aesthetics by group ----- From 0674e2e20c95922df033ba281d74e5f1b95a2411 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 09:16:31 -0500 Subject: [PATCH 46/54] settings: list -> env --- R/by_aesthetics.R | 8 +++---- R/tinyplot.R | 9 +++++--- vignettes/types.qmd | 53 +++++++++++++++++++++++++++++++++++++++------ 3 files changed, 55 insertions(+), 15 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index ec52c8c7..43a2f032 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -3,7 +3,8 @@ # by_aesthetics = function(settings) { - list2env(settings[c("datapoints", "by", "type", "null_by", "pch", "bg", "lty", "lwd", "bubble", "cex", "alpha", "col", "fill", "ribbon.alpha")], environment()) + env2env(settings, environment(), c("datapoints", "by", "type", "null_by", "pch", "bg", "lty", "lwd", "bubble", "cex", "alpha", "col", "fill", "ribbon.alpha")) + by_ordered = FALSE by_continuous = !null_by && inherits(datapoints$by, c("numeric", "integer")) if (isTRUE(by_continuous) && type %in% c("l", "b", "o", "ribbon", "polygon", "polypath", "boxplot")) { @@ -53,10 +54,7 @@ by_aesthetics = function(settings) { adjustcolor = adjustcolor ) - settings[c("by_continuous", "by_ordered", "ngrps", "pch", "lty", "lwd", "cex", "col", "bg")] = - list(by_continuous = by_continuous, by_ordered = by_ordered, ngrps = ngrps, - pch = pch, lty = lty, lwd = lwd, cex = cex, col = col, bg = bg) - settings + env2env(environment(), settings, c("by_continuous", "by_ordered", "ngrps", "pch", "lty", "lwd", "cex", "col", "bg")) } diff --git a/R/tinyplot.R b/R/tinyplot.R index dc58aa44..4906d4df 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -891,15 +891,18 @@ tinyplot.default = function( # facet_layout processes facet simplification, attribute restoration, and layout facet_layout(settings) - settings = as.list(settings, all.names = TRUE) # ## aesthetics by group ----- # - settings = by_aesthetics(settings) + by_aesthetics(settings) - list2env(settings, environment()) + # + ## make settings available in the environment directly ----- + # + env2env(settings, environment()) + # ## legends ----- diff --git a/vignettes/types.qmd b/vignettes/types.qmd index e23879fd..0229ed45 100644 --- a/vignettes/types.qmd +++ b/vignettes/types.qmd @@ -178,13 +178,13 @@ custom type. The three functions that we need to define for a new type are: 1. `data_*()`: Function factory. - - Accepts `...` and a named list called `settings` which holds many internal objects + - Accepts `...` and an environment called `settings` which holds many internal parameters - Inputs must include `...` - - `settings$datapoints` Is the most important object. It is a data frame with the datapoints to plot. - - Other objects that can be modified by `data_*()` include: `settings$by`, `settings$facet`, `settings$ylab`, `settings$palette` - - Returns a named list with modified versions of the `settings` values. + - `settings` is an R environment containing many useful parameters that can be read or modified + - Key parameters include: `datapoints` (data frame), `by`, `facet`, `xlab`, `ylab`, `xlim`, `ylim`, `palette`, and many more + - Modifies the `settings` environment in-place; does not need to return anything 2. `draw_*()`: Function factory. - - Accepts information about data point values and aesthetics. + - Accepts information about data point values and aesthetics. - Inputs must include `...` - The `i` prefix in argument names indicates that we are operating on a subgroup of the data, identified by `facet` or using the `|` operator in a formula. - Available arguments are: `ibg`, `icol`, `ilty`, `ilwd`, `ipch`, `ix`, `ixmax`, `ixmin`, `iy`, `iymax`, `iymin`, `cex`, `dots`, `type`, `x_by`, `i`, `facet_by`, `by_data`, `facet_data`, `flip` @@ -194,8 +194,11 @@ The three functions that we need to define for a new type are: - `data` - `name` +### A minimal example + Here is a minimalist example of a custom type that logs both `x` and `y` and -plots lines. +plots points. Note how we use `env2env()` to extract variables from the `settings` +environment, modify them, and copy the modified values back: ```{r} #| layout-ncol: 2 @@ -203,12 +206,16 @@ type_log = function(base = exp(1)) { data_log = function() { fun = function(settings, ...) { + # Extract datapoints from settings environment datapoints = settings$datapoints + + # Transform the data datapoints$x = log(datapoints$x, base = base) datapoints$y = log(datapoints$y, base = base) datapoints = datapoints[order(datapoints$x), ] + + # Copy modified datapoints back to settings settings$datapoints = datapoints - return(settings) } return(fun) } @@ -240,6 +247,8 @@ tinyplot(mpg ~ wt | factor(am), data = mtcars, type = type_log(base = 10), main = "Log 10") ``` +### More examples + To underscore what we said above, the **tinyplot** [source code](https://github.com/grantmcdermott/tinyplot/tree/main/R) contains many examples of type constructor functions that should provide a @@ -248,3 +257,33 @@ team are always happy to help guide users on how to create their own types and re-purpose existing **tinyplot** code. Just let us know by [raising an issue](https://github.com/grantmcdermott/tinyplot/issues) on our GitHub repo. + + +### Available settings + +To see what parameters are available in the `settings` environment, we can create +a simple `type_error()` that stops with the names of all available settings: + +```{r} +#| error: true +type_error = function() { + data_error = function() { + fun = function(settings, ...) { + stop(paste(names(settings), collapse = ", ")) + } + return(fun) + } + + out = list( + data = data_error() + ) + class(out) = "tinyplot_type" + return(out) +} + +tinyplot(mpg ~ wt, data = mtcars, type = type_error()) +``` + +As we can see, the `settings` environment contains many parameters that custom +types can use as inputs or modify as needed. + From b355c2cd514bba50f3f05d4f4f4dd612cebe6430 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 09:25:16 -0500 Subject: [PATCH 47/54] cruft --- R/settings.R | 13 ------------- R/utils.R | 12 ++++++++---- 2 files changed, 8 insertions(+), 17 deletions(-) delete mode 100644 R/settings.R diff --git a/R/settings.R b/R/settings.R deleted file mode 100644 index 1dfcf09c..00000000 --- a/R/settings.R +++ /dev/null @@ -1,13 +0,0 @@ -get_settings <- function(settings, keys) { - mget(keys, settings) -} - - -env2env <- function(source_env, target_env, keys = NULL) { - if (is.null(keys)) { - keys <- ls(source_env, all.names = TRUE) - } - for (nm in keys) { - assign(nm, source_env[[nm]], envir = target_env) - } -} diff --git a/R/utils.R b/R/utils.R index 454372e7..70677fe8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -59,6 +59,7 @@ swap_variables = function(env, ...) { } } + swap_columns = function(dp, a, b) { va = dp[[a]] vb = dp[[b]] @@ -68,8 +69,11 @@ swap_columns = function(dp, a, b) { } -update_settings = function(settings, ...) { - new = list(...) - settings = settings[setdiff(names(settings), names(new))] - c(settings, new) +env2env <- function(source_env, target_env, keys = NULL) { + if (is.null(keys)) { + keys <- ls(source_env, all.names = TRUE) + } + for (nm in keys) { + assign(nm, source_env[[nm]], envir = target_env) + } } From e58461687a98981a7459cca2b6e128ca21e5526f Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 09:38:16 -0500 Subject: [PATCH 48/54] fix R check --- R/type_area.R | 4 ++++ R/zzz.R | 1 + 2 files changed, 5 insertions(+) diff --git a/R/type_area.R b/R/type_area.R index 71ddcb3e..c9ba59fb 100644 --- a/R/type_area.R +++ b/R/type_area.R @@ -20,6 +20,10 @@ data_area = function(alpha = alpha) { ymax = datapoints$ymax ymin = datapoints$ymin type = "ribbon" + + # ribbon.alpha comes from parent scope, so assign it locally + ribbon.alpha = ribbon.alpha + env2env(environment(), settings, c( "datapoints", "ymax", diff --git a/R/zzz.R b/R/zzz.R index 6e3856cf..fa359b63 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -55,6 +55,7 @@ "ngrps", "null_by", "null_facet", + "null_palette", "null_xlim", "null_ylim", "oxaxis", From 656c32cf3142af9e2cbe639527030a7d42dcad2f Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 19 Nov 2025 08:39:25 -0800 Subject: [PATCH 49/54] rename --- R/{sanitize.R => sanitize_ribbon_alpha.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename R/{sanitize.R => sanitize_ribbon_alpha.R} (100%) diff --git a/R/sanitize.R b/R/sanitize_ribbon_alpha.R similarity index 100% rename from R/sanitize.R rename to R/sanitize_ribbon_alpha.R From 6d27eb30480bdc368f03add329fa53768f01d95d Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 19 Nov 2025 08:53:02 -0800 Subject: [PATCH 50/54] tweak order and add comments --- R/utils.R | 70 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 33 deletions(-) diff --git a/R/utils.R b/R/utils.R index 70677fe8..371efe95 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,9 +1,35 @@ -rescale_num = function(x, from = NULL, to = NULL) { - if (is.null(from)) from = range(x) - if (is.null(to)) to = c(0, 1) - (x - from[1]) / diff(from) * diff(to) + to[1] +## Null coalescing operator +if (getRversion() <= "4.4.0") { + `%||%` = function(x, y) if (is.null(x)) y else x } + +## Function that computes an appropriate bandwidth kernel based on a string +## input +bw_fun = function(kernel, x) { + kernel = tolower(kernel) + switch(kernel, + nrd0 = bw.nrd0(x), + nrd = bw.nrd(x), + ucv = bw.ucv(x), + bcv = bw.bcv(x), + sj = bw.SJ(x), + stop("Invalid `bw` string. Choose from 'nrd0', 'nrd', 'ucv', 'bcv', or 'SJ'.") + ) +} + + +# Assign (inject) elements from one environment into another +env2env = function(source_env, target_env, keys = NULL) { + if (is.null(keys)) { + keys = ls(source_env, all.names = TRUE) + } + for (nm in keys) { + assign(nm, source_env[[nm]], envir = target_env) + } +} + + ## Function for efficiently checking whether a vector has more than n unique ## values (uses a hash set approach for large vectors to check sequentially) more_than_n_unique = function(x, n, small_vec_len = 1e3L) { @@ -29,27 +55,15 @@ more_than_n_unique = function(x, n, small_vec_len = 1e3L) { } -## Null coalescing operator -if (getRversion() <= "4.4.0") { - `%||%` = function(x, y) if (is.null(x)) y else x -} - - -## Function that computes an appropriate bandwidth kernel based on a string -## input -bw_fun = function(kernel, x) { - kernel = tolower(kernel) - switch(kernel, - nrd0 = bw.nrd0(x), - nrd = bw.nrd(x), - ucv = bw.ucv(x), - bcv = bw.bcv(x), - sj = bw.SJ(x), - stop("Invalid `bw` string. Choose from 'nrd0', 'nrd', 'ucv', 'bcv', or 'SJ'.") - ) +# Rescale numeric (used for continuous legends, etc.) +rescale_num = function(x, from = NULL, to = NULL) { + if (is.null(from)) from = range(x) + if (is.null(to)) to = c(0, 1) + (x - from[1]) / diff(from) * diff(to) + to[1] } +# Convenience function for swapping variables (e.g., use in flipped plots) swap_variables = function(env, ...) { pairs = list(...) for (p in pairs) { @@ -59,7 +73,7 @@ swap_variables = function(env, ...) { } } - +# Convenience function for swapping columns (e.g., use in flipped plots) swap_columns = function(dp, a, b) { va = dp[[a]] vb = dp[[b]] @@ -67,13 +81,3 @@ swap_columns = function(dp, a, b) { dp[[b]] = if (!is.null(va)) va else NULL dp } - - -env2env <- function(source_env, target_env, keys = NULL) { - if (is.null(keys)) { - keys <- ls(source_env, all.names = TRUE) - } - for (nm in keys) { - assign(nm, source_env[[nm]], envir = target_env) - } -} From 221f82527734b3107ca8267199b34c0158dbd567 Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 19 Nov 2025 09:13:36 -0800 Subject: [PATCH 51/54] tweak vignette wording --- vignettes/types.qmd | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/vignettes/types.qmd b/vignettes/types.qmd index 0229ed45..a248e9c1 100644 --- a/vignettes/types.qmd +++ b/vignettes/types.qmd @@ -166,8 +166,8 @@ tinyplot(Temp ~ Wind | Month, data = aq, facet = "by", type = "lm") It is easy to add custom types to **tinyplot**. Users who need highly customized plots, or developers who want to add support to their package or functions, only -need to define three simple functions: `data_typename()`, `draw_typename()`, and -`type_typename()`. +need to define three simple functions: `data_()`, `draw_()`, and +`type_()`. In this section, we explain the role of each of these functions and present a minimalist example of a custom type. Interested readers may refer to @@ -177,26 +177,25 @@ custom type. The three functions that we need to define for a new type are: -1. `data_*()`: Function factory. - - Accepts `...` and an environment called `settings` which holds many internal parameters - - Inputs must include `...` - - `settings` is an R environment containing many useful parameters that can be read or modified - - Key parameters include: `datapoints` (data frame), `by`, `facet`, `xlab`, `ylab`, `xlim`, `ylim`, `palette`, and many more - - Modifies the `settings` environment in-place; does not need to return anything -2. `draw_*()`: Function factory. +1. `data_()`: Data function factory. + - Must take two arguments: + - `settings` is a special internal environment containing useful parameters that can be read or modified by `tinyplot` functions, including `datapoints`, `by`, `facet`, `xlab`, `ylab`, `xlim`, `ylim`, `palette`, and many more (see below) + - `...` + - Defines the data that will be passed on to the plotting functions (including any necessary transformations). Note that this function should modify the `settings` environment in-place; it does not need to return anything +2. `draw_()`: Drawing function factory. - Accepts information about data point values and aesthetics. - Inputs must include `...` - The `i` prefix in argument names indicates that we are operating on a subgroup of the data, identified by `facet` or using the `|` operator in a formula. - Available arguments are: `ibg`, `icol`, `ilty`, `ilwd`, `ipch`, `ix`, `ixmax`, `ixmin`, `iy`, `iymax`, `iymin`, `cex`, `dots`, `type`, `x_by`, `i`, `facet_by`, `by_data`, `facet_data`, `flip` - Returns a function which can call base R to draw the plot. -3. `type_*()`: A wrapper function that returns a named list with three elements: +3. `type_()`: A wrapper function that returns a named list with three elements: - `draw` - `data` - `name` ### A minimal example -Here is a minimalist example of a custom type that logs both `x` and `y` and +Here is a minimal example of a custom type that logs both `x` and `y` and plots points. Note how we use `env2env()` to extract variables from the `settings` environment, modify them, and copy the modified values back: @@ -214,7 +213,7 @@ type_log = function(base = exp(1)) { datapoints$y = log(datapoints$y, base = base) datapoints = datapoints[order(datapoints$x), ] - # Copy modified datapoints back to settings + # Assign (inject) modified datapoints back to settings settings$datapoints = datapoints } return(fun) @@ -249,7 +248,7 @@ tinyplot(mpg ~ wt | factor(am), data = mtcars, ### More examples -To underscore what we said above, the **tinyplot** +The **tinyplot** [source code](https://github.com/grantmcdermott/tinyplot/tree/main/R) contains many examples of type constructor functions that should provide a helpful starting point for custom plot types. Failing that, the **tinyplot** From 4686c0ec7edc4bbe690dc41c973457481d4e1178 Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 19 Nov 2025 09:28:03 -0800 Subject: [PATCH 52/54] tweaks --- R/by_aesthetics.R | 16 ++++++++++++++-- R/facet.R | 7 ++++++- R/lim.R | 17 +++++++++++++++-- R/sanitize_facet.R | 14 ++++++++++++-- R/sanitize_xylab.R | 10 +++++++++- R/type_barplot.R | 10 +++++++++- 6 files changed, 65 insertions(+), 9 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 43a2f032..9216bd26 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -3,7 +3,14 @@ # by_aesthetics = function(settings) { - env2env(settings, environment(), c("datapoints", "by", "type", "null_by", "pch", "bg", "lty", "lwd", "bubble", "cex", "alpha", "col", "fill", "ribbon.alpha")) + env2env( + settings, + environment(), + c( + "datapoints", "by", "type", "null_by", "pch", "bg", "lty", "lwd", + "bubble", "cex", "alpha", "col", "fill", "ribbon.alpha" + ) + ) by_ordered = FALSE by_continuous = !null_by && inherits(datapoints$by, c("numeric", "integer")) @@ -54,7 +61,12 @@ by_aesthetics = function(settings) { adjustcolor = adjustcolor ) - env2env(environment(), settings, c("by_continuous", "by_ordered", "ngrps", "pch", "lty", "lwd", "cex", "col", "bg")) + # update settings + env2env( + environment(), + settings, + c("by_continuous", "by_ordered", "ngrps", "pch", "lty", "lwd", "cex", "col", "bg") + ) } diff --git a/R/facet.R b/R/facet.R index b5b799e9..0a1a1fcb 100644 --- a/R/facet.R +++ b/R/facet.R @@ -585,7 +585,12 @@ facet_layout = function(settings) { cex_fct_adj = 1 } - env2env(environment(), settings, c("datapoints", "facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj")) + # update settings + env2env( + environment(), + settings, + c("datapoints", "facets", "ifacet", "nfacets", "nfacet_rows", "nfacet_cols", "oxaxis", "oyaxis", "cex_fct_adj") + ) } diff --git a/R/lim.R b/R/lim.R index 48fc0c6b..46d9c0e4 100644 --- a/R/lim.R +++ b/R/lim.R @@ -1,7 +1,15 @@ # calculate limits of each plot lim_args = function(settings) { - env2env(settings, environment(), c("xaxb", "xlabs", "yaxb", "ylabs", "xlim", "ylim", "datapoints", "type", "null_xlim", "null_ylim")) + env2env( + settings, + environment(), + c( + "xaxb", "xlabs", "xlim", "null_xlim", + "yaxb", "ylabs", "ylim", "null_ylim", + "datapoints", "type" + ) + ) # For cases where x/yaxb is provided and corresponding x/ylabs is not null... # We can subset these here to provide breaks @@ -32,5 +40,10 @@ lim_args = function(settings) { if (null_xlim && !is.null(xaxb) && type != "spineplot") xlim = range(c(xlim, xaxb)) if (null_ylim && !is.null(yaxb) && type != "spineplot") ylim = range(c(ylim, yaxb)) - env2env(environment(), settings, c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb")) + # update settings + env2env( + environment(), + settings, + c("xlim", "ylim", "xlabs", "ylabs", "xaxb", "yaxb") + ) } diff --git a/R/sanitize_facet.R b/R/sanitize_facet.R index 12122b42..baddd8a5 100644 --- a/R/sanitize_facet.R +++ b/R/sanitize_facet.R @@ -1,5 +1,9 @@ sanitize_facet = function(settings) { - env2env(settings, environment(), c("facet", "by", "null_facet", "facet_attr", "facet_by")) + env2env( + settings, + environment(), + c("facet", "by", "null_facet", "facet_attr", "facet_by") + ) # flag if facet=="by" (i.e., facet matches the grouping variable) facet_by = FALSE @@ -15,5 +19,11 @@ sanitize_facet = function(settings) { } facet_attr = attributes(facet) # TODO: better way to restore facet attributes? null_facet = is.null(facet) - env2env(environment(), settings, c("facet", "null_facet", "facet_attr", "facet_by", "by")) + + # update settings + env2env( + environment(), + settings, + c("facet", "null_facet", "facet_attr", "facet_by", "by") + ) } diff --git a/R/sanitize_xylab.R b/R/sanitize_xylab.R index 7e6109e6..6ea3a3af 100644 --- a/R/sanitize_xylab.R +++ b/R/sanitize_xylab.R @@ -1,5 +1,13 @@ sanitize_xylab = function(settings) { - env2env(settings, environment(), c("type", "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", "y", "ylab", "y_dep", "ymin_dep", "ymax_dep")) + env2env( + settings, + environment(), + c( + "type", + "x", "xlab", "x_dep", "xmin_dep", "xmax_dep", + "y", "ylab", "y_dep", "ymin_dep", "ymax_dep" + ) + ) out_xlab = NULL out_ylab = NULL diff --git a/R/type_barplot.R b/R/type_barplot.R index adf53dbc..df8de8a0 100644 --- a/R/type_barplot.R +++ b/R/type_barplot.R @@ -79,7 +79,15 @@ type_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, #' @importFrom stats aggregate data_barplot = function(width = 5/6, beside = FALSE, center = FALSE, FUN = NULL, xlevels = NULL, xaxlabels = NULL, drop.zeros = FALSE) { fun = function(settings, ...) { - env2env(settings, environment(), c("datapoints", "xlab", "ylab", "null_by", "facet_by", "xlim", "ylim", "null_palette", "col", "bg", "yaxl", "xaxt")) + env2env( + settings, + environment(), + c( + "datapoints", "null_by", "facet_by", + "xlab", "ylab", "xlim", "ylim", "yaxl", "xaxt", + "null_palette", "col", "bg" + ) + ) ## tabulate/aggregate datapoints if (is.null(datapoints$y)) { From 819e0a71a994c90b794a2ab5e627da4ff8f227a6 Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 19 Nov 2025 09:36:22 -0800 Subject: [PATCH 53/54] tweak --- vignettes/introduction.qmd | 1 + 1 file changed, 1 insertion(+) diff --git a/vignettes/introduction.qmd b/vignettes/introduction.qmd index 11f3bfe7..9fdaf403 100644 --- a/vignettes/introduction.qmd +++ b/vignettes/introduction.qmd @@ -478,6 +478,7 @@ keystrokes by typing `plt_add()` instead of `tinyplot_add()`: #| eval: false plt_add(type = "lm") ``` + ::: A related---but distinct---concept to adding plot layers is _drawing_ on a plot. From c7016992ca2d2ee71d12fdcbba1b848f3ad91dca Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 19 Nov 2025 12:47:09 -0500 Subject: [PATCH 54/54] news item --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index d1863e24..1d76a7f8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,10 @@ where the formatting is also better._ ## Dev version +### Breaking change + +- Internal settings and parameters are now stored in an environment called `settings`, which can be accessed and modified by type-specific functions. This may require changes to users' custom type functions that previously accessed settings as passed arguments. This change was necessary to improve the modularity and maintainability of the codebase, and to add flexibility. (#473 @vincentarelbundock and @grantmcdermott) + ### New features - `type_text()` gains a `family` argument for controlling the font family,