diff --git a/NEWS.md b/NEWS.md index 45dcb16e..2efdb0e4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,7 +37,10 @@ where the formatting is also better._ the report. (#512 @grantmcdermott) - Axis limits are now correctly calculated for factor (and character) variables, by coercing to numeric first. We also avoid the redundancy of re-calculating - axis limits for secondary plot layers. (#513 @grantmcdermott) + axis limits for secondary plot layers. (#513 @grantmcdermott) +- Fixed lazy evaluation bug where `legend` passed as a symbol through S3 methods + (e.g., `tinyplot.foo`) would fail. (#515 @grantmcdermott) + ### Documentation diff --git a/R/draw_legend.R b/R/draw_legend.R index b8ddee0e..d97ccc45 100644 --- a/R/draw_legend.R +++ b/R/draw_legend.R @@ -692,32 +692,3 @@ gradient_legend = function( } } - -# sanitize legend (helper function) ---- - -sanitize_legend = function(legend, legend_args) { - if (is.null(legend_args[["x"]])) { - if (is.null(legend)) { - legend_args[["x"]] = "right!" - } else if (is.character(legend)) { - legend_args = utils::modifyList(legend_args, list(x = legend)) - } else if (class(legend) %in% c("call", "name")) { - largs = as.list(legend) - if (is.null(largs[["x"]])) { - lnms = names(largs) - # check second position b/c first will be a symbol - if (is.null(lnms)) { - largs = setNames(largs, c("", "x")) - } else if (length(largs) >= 2 && lnms[2] == "") { - lnms[2] = "x" - largs = setNames(largs, lnms) - } else { - largs[["x"]] = "right!" - } - } - # Finally, combine with any pre-existing legend args (e.g., title from the by label) - legend_args = utils::modifyList(legend_args, largs, keep.null = TRUE) - } - } - return(legend_args) -} diff --git a/R/sanitize_legend.R b/R/sanitize_legend.R new file mode 100644 index 00000000..d7951951 --- /dev/null +++ b/R/sanitize_legend.R @@ -0,0 +1,35 @@ +sanitize_legend = function(legend, legend_args) { + if (is.null(legend_args[["x"]])) { + + # Normalize legend to a list + largs = if (is.null(legend)) { + list(x = "right!") + } else if (is.character(legend)) { + list(x = legend) + } else if (is.list(legend)) { + # Handle unnamed first element as position + if (length(legend) >= 1 && is.character(legend[[1]]) && + (is.null(names(legend)) || names(legend)[1] == "")) { + names(legend)[1] = "x" + } + legend + } else if (inherits(legend, c("call", "name"))) { + # Convert call to list and handle unnamed first arg as position + new_legend = as.list(legend)[-1] # Remove function name + if (length(new_legend) >= 1 && (is.null(names(new_legend)) || names(new_legend)[1] == "")) { + names(new_legend)[1] = "x" + } + new_legend + } else { + list(x = "right!") # Fallback + } + + # Ensure position exists + if (is.null(largs[["x"]])) largs[["x"]] = "right!" + + # Merge + legend_args = modifyList(legend_args, largs, keep.null = TRUE) + } + + legend_args +} diff --git a/R/tinyplot.R b/R/tinyplot.R index 72fd8b12..7785bcdc 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -641,11 +641,15 @@ tinyplot.default = function( theme = NULL, ...) { + # Force evaluation of legend if it's a symbol to avoid downstream promise + # issues. Let sanitize_legend handle it + if (!missing(legend) && is.symbol(substitute(legend))) { + legend = legend + } # ## save parameters and calls ----- # - par_first = get_saved_par("first") if (is.null(par_first)) set_saved_par("first", par()) @@ -909,6 +913,7 @@ tinyplot.default = function( # ## legends ----- # + # browser() # legend labels ncolors = length(col) @@ -943,30 +948,23 @@ tinyplot.default = function( } else if (isTRUE(legend)) { legend = NULL } - if (!is.null(legend) && legend == "none") { + if (!is.null(legend) && is.character(legend) && legend == "none") { legend_args[["x"]] = "none" dual_legend = FALSE } if (null_by) { - if (is.null(legend)) { - # special case: bubble legend, no by legend - if (bubble && !dual_legend) { - legend_args[["title"]] = cex_dep ## rather by_dep? - lgnd_labs = names(bubble_cex) - lgnd_cex = bubble_cex * cex_fct_adj - } else { - legend = "none" - legend_args[["x"]] = "none" - } - } else if (bubble && !dual_legend) { - legend_args[["title"]] = cex_dep ## rather by_dep? - lgnd_labs = names(bubble_cex) - lgnd_cex = bubble_cex * cex_fct_adj + if (bubble && !dual_legend) { + legend_args[["title"]] = cex_dep + lgnd_labs = names(bubble_cex) + lgnd_cex = bubble_cex * cex_fct_adj + } else if (is.null(legend)) { + legend = "none" + legend_args[["x"]] = "none" } } - if ((is.null(legend) || legend != "none" || bubble) && !add) { + if ((is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !add) { if (isFALSE(by_continuous) && (!bubble || dual_legend)) { if (ngrps > 1) { lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) @@ -1399,6 +1397,7 @@ tinyplot.formula = function( ## placeholder for legend title legend_args = list(x = NULL) + # browser() ## turn facet into a formula if it does not evaluate successfully if (inherits(try(facet, silent = TRUE), "try-error")) { diff --git a/R/title.R b/R/title.R index 29b57208..74311d05 100644 --- a/R/title.R +++ b/R/title.R @@ -9,7 +9,7 @@ draw_title = function(main, sub, xlab, ylab, legend, legend_args, opar) { legend_eval = tryCatch(paste0(legend)[[2]], error = function(e) NULL) } - adj_title = !is.null(legend) && (legend == "top!" || (!is.null(legend_args[["x"]]) && legend_args[["x"]] == "top!") || (is.list(legend_eval) && legend_eval[[1]] == "top!")) + adj_title = !is.null(legend) && ((is.character(legend) && legend == "top!") || (!is.null(legend_args[["x"]]) && legend_args[["x"]] == "top!") || (is.list(legend_eval) && legend_eval[[1]] == "top!")) # For the "top!" legend case, bump main title up to make space for the # legend beneath it: Take the normal main title line gap (i.e., 1.7 lines) diff --git a/inst/tinytest/_tinysnapshot/legend_custom_s3.svg b/inst/tinytest/_tinysnapshot/legend_custom_s3.svg new file mode 100644 index 00000000..142e259f --- /dev/null +++ b/inst/tinytest/_tinysnapshot/legend_custom_s3.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + +New Title +A +B + + + + + + + +x +y + + + + + + + + + +1.0 +1.2 +1.4 +1.6 +1.8 +2.0 + + + + + + + +1.0 +1.2 +1.4 +1.6 +1.8 +2.0 + + + + + + + + + + + + + diff --git a/inst/tinytest/_tinysnapshot/pointrange_with_hline.svg b/inst/tinytest/_tinysnapshot/pointrange_with_hline.svg new file mode 100644 index 00000000..d96fa8ae --- /dev/null +++ b/inst/tinytest/_tinysnapshot/pointrange_with_hline.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + +x +y + + + + + +(Intercept) +hp +factor(cyl)6 +factor(cyl)8 + + + + + + +-10 +0 +10 +20 +30 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/inst/tinytest/test-legend.R b/inst/tinytest/test-legend.R index cf72ece3..3818e7ce 100644 --- a/inst/tinytest/test-legend.R +++ b/inst/tinytest/test-legend.R @@ -175,3 +175,16 @@ expect_snapshot_plot(f, label = "legend_lmar_top") # reset par par(op) + + +# custom legend for new tinyplot.foo s3 method +f = function() { + foo = data.frame(x = 1:2, y = 1:2, grp = c("A", "B")) + class(foo) = c("foo", "data.frame") + tinyplot.foo = function(x, ...) { + legend = list(title = 'New Title') + plt(y ~ x | grp, data = x, legend = legend, ...) + } + plt(foo) +} +expect_snapshot_plot(f, label = "legend_custom_s3") \ No newline at end of file diff --git a/inst/tinytest/test-type_pointrange.R b/inst/tinytest/test-type_pointrange.R index ddc22b8a..dad8f77e 100644 --- a/inst/tinytest/test-type_pointrange.R +++ b/inst/tinytest/test-type_pointrange.R @@ -34,8 +34,19 @@ fun = function() { } expect_snapshot_plot(fun, label = "pointrange_errorbar") +# issue 511: adding hline to coefplot +fun = function() { + tinyplot( + y ~ x, ymin = ymin, ymax = ymax, + data = coefs, + type = "pointrange", + theme = "basic" + ) + tinyplot_add(type = "hline", lty = 2) +} +expect_snapshot_plot(fun, label = "pointrange_with_hline") -# Issue #406: dodge pointrage and errorbar +# Issue #406: dodge pointrange and errorbar models = list( "Model A" = lm(mpg ~ wt + cyl, data = mtcars), "Model B" = lm(mpg ~ wt + hp + cyl, data = mtcars),