diff --git a/R/facet-.R b/R/facet-.R index 6e8c96f277..57240f4b01 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -892,7 +892,7 @@ map_facet_data <- function(data, layout, params) { return(vec_cbind(data %|W|% NULL, PANEL = integer(0))) } - vars <- params$facet %||% c(params$rows, params$cols) + vars <- params$facets %||% c(params$rows, params$cols) if (length(vars) == 0) { data$PANEL <- layout$PANEL @@ -911,7 +911,7 @@ map_facet_data <- function(data, layout, params) { # Compute faceting values facet_vals <- eval_facets(vars, data, params$.possible_columns) - include_margins <- !isFALSE(params$margin %||% FALSE) && + include_margins <- !isFALSE(params$margins %||% FALSE) && nrow(facet_vals) == nrow(data) && grid_layout if (include_margins) { # Margins are computed on evaluated faceting values (#1864). diff --git a/R/geom-smooth.R b/R/geom-smooth.R index c386504fa8..2432a7f491 100644 --- a/R/geom-smooth.R +++ b/R/geom-smooth.R @@ -102,7 +102,7 @@ geom_smooth <- function(mapping = NULL, data = NULL, ... ) if (identical(stat, "smooth")) { - params$method <- method + params[["method"]] <- method params$formula <- formula } diff --git a/R/labels.R b/R/labels.R index 27c1e96de6..95a54720eb 100644 --- a/R/labels.R +++ b/R/labels.R @@ -351,7 +351,7 @@ get_alt_text.gtable <- function(p, ...) { #' generate_alt_text <- function(p) { # Combine titles - if (!is.null(p$label$title %||% p$labels$subtitle)) { + if (!is.null(p$labels$title %||% p$labels$subtitle)) { title <- sub("\\.?$", "", c(p$labels$title, p$labels$subtitle)) if (length(title) == 2) { title <- paste0(title[1], ": ", title[2]) diff --git a/R/legend-draw.R b/R/legend-draw.R index 04276dd471..25aedae0f7 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -207,11 +207,11 @@ draw_key_path <- function(data, params, size) { lty = data$linetype %||% 1, lineend = params$lineend %||% "butt" ), - arrow = params$arrow + arrow = params[["arrow"]] ) - if (!is.null(params$arrow)) { - angle <- deg2rad(params$arrow$angle) - length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE) + if (!is.null(params[["arrow"]])) { + angle <- deg2rad(params[["arrow"]]$angle) + length <- convertUnit(params[["arrow"]]$length, "cm", valueOnly = TRUE) attr(grob, "width") <- cos(angle) * length * 1.25 attr(grob, "height") <- sin(angle) * length * 2 } @@ -228,11 +228,11 @@ draw_key_vpath <- function(data, params, size) { lty = data$linetype %||% 1, lineend = params$lineend %||% "butt" ), - arrow = params$arrow + arrow = params[["arrow"]] ) - if (!is.null(params$arrow)) { - angle <- deg2rad(params$arrow$angle) - length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE) + if (!is.null(params[["arrow"]])) { + angle <- deg2rad(params[["arrow"]]$angle) + length <- convertUnit(params[["arrow"]]$length, "cm", valueOnly = TRUE) attr(grob, "width") <- sin(angle) * length * 2 attr(grob, "height") <- cos(angle) * length * 1.25 } diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index 74a5539bdb..c712a8989d 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -197,7 +197,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, df$group <- data$group[1] df$ndensity <- df$density / max(df$density, na.rm = TRUE) df$count <- nx * df$density - df$n <- nx + df[["n"]] <- nx df$level <- 1 df$piece <- 1 df diff --git a/R/stat-manual.R b/R/stat-manual.R index 994c8d622e..aa8351b570 100644 --- a/R/stat-manual.R +++ b/R/stat-manual.R @@ -120,8 +120,8 @@ StatManual <- ggproto( "StatManual", Stat, setup_params = function(data, params) { - params$fun <- allow_lambda(params$fun) - check_function(params$fun, arg = "fun") + params[["fun"]] <- allow_lambda(params[["fun"]]) + check_function(params[["fun"]], arg = "fun") params }, diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 147bd06e41..4416d69482 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -95,7 +95,7 @@ StatSmooth <- ggproto("StatSmooth", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) msg <- character() - method <- params$method + method <- params[["method"]] if (is.null(method) || identical(method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for # larger. Based on size of the _largest_ group to avoid bad memory @@ -144,14 +144,14 @@ StatSmooth <- ggproto("StatSmooth", Stat, } # If gam and gam's method is not specified by the user then use REML if (identical(method, gam_method())) { - params$method.args$method <- params$method.args$method %||% "REML" + params$method.args[["method"]] <- params$method.args[["method"]] %||% "REML" } if (length(msg) > 0) { cli::cli_inform("{.fn geom_smooth} using {msg}") } - params$method <- method + params[["method"]] <- method params }, diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index e3db18b102..6afba776f0 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -68,8 +68,8 @@ StatSummaryBin <- ggproto("StatSummaryBin", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params) - params$fun <- make_summary_fun( - params$fun.data, params$fun, + params[["fun"]] <- make_summary_fun( + params$fun.data, params[["fun"]], params$fun.max, params$fun.min, params$fun.args %||% list() ) diff --git a/R/stat-summary.R b/R/stat-summary.R index a32eda8ca0..0be47a4e39 100644 --- a/R/stat-summary.R +++ b/R/stat-summary.R @@ -185,8 +185,8 @@ StatSummary <- ggproto("StatSummary", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params) - params$fun <- make_summary_fun( - params$fun.data, params$fun, + params[["fun"]] <- make_summary_fun( + params$fun.data, params[["fun"]], params$fun.max, params$fun.min, params$fun.args %||% list() ) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 6b0e4f0ff8..a84836d7b0 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -170,7 +170,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, trim = trim, na.rm = na.rm, drop = drop, bounds = bounds, quantiles = quantiles ) - if (!drop && any(data$n < 2)) { + if (!drop && any(data[["n"]] < 2)) { cli::cli_warn( "Cannot compute density for groups with fewer than two datapoints." ) @@ -184,7 +184,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, # count: use the original densities scaled to a maximum of 1 (as above) # and then scale them according to the number of observations count = data$density / max(data$density, na.rm = TRUE) * - data$n / max(data$n), + data[["n"]] / max(data[["n"]]), # width: constant width (density scaled to a maximum of 1) width = data$scaled ) diff --git a/R/theme-elements.R b/R/theme-elements.R index a16302b6db..19d88262a2 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -381,10 +381,10 @@ element_grob.element_line <- function(element, x = 0:1, y = 0:1, linewidth <- size } - arrow <- if (is.logical(element$arrow) && !element$arrow) { + arrow <- if (is.logical(element[["arrow"]]) && !element[["arrow"]]) { NULL } else { - element$arrow + element[["arrow"]] } if (is.null(arrow)) { arrow.fill <- colour diff --git a/tests/testthat/_snaps/function-args.md b/tests/testthat/_snaps/function-args.md new file mode 100644 index 0000000000..32101d9cb9 --- /dev/null +++ b/tests/testthat/_snaps/function-args.md @@ -0,0 +1,31 @@ +# GeomXxx$parameters() does not contain partial matches + + Code + problems + Output + [1] "GeomBoxplot : `notch` with `notchwidth`" + [2] "GeomContour : `arrow` with `arrow.fill`" + [3] "GeomCurve : `arrow` with `arrow.fill`" + [4] "GeomDensity2d: `arrow` with `arrow.fill`" + [5] "GeomFunction : `arrow` with `arrow.fill`" + [6] "GeomLine : `arrow` with `arrow.fill`" + [7] "GeomPath : `arrow` with `arrow.fill`" + [8] "GeomQuantile : `arrow` with `arrow.fill`" + [9] "GeomSegment : `arrow` with `arrow.fill`" + [10] "GeomSf : `arrow` with `arrow.fill`" + [11] "GeomSpoke : `arrow` with `arrow.fill`" + [12] "GeomStep : `arrow` with `arrow.fill`" + +# StatXxx$parameters() does not contain partial matches + + Code + problems + Output + [1] "StatDensity : `n` with `na.rm`" + [2] "StatDensity2d : `na.rm` with `n`" + [3] "StatDensity2dFilled: `na.rm` with `n`" + [4] "StatQuantile : `method` with `method.args`" + [5] "StatSmooth : `method` with `method.args`, `n` with `na.rm`" + [6] "StatSummary2d : `fun` with `fun.args`" + [7] "StatSummaryHex : `fun` with `fun.args`" + diff --git a/tests/testthat/test-function-args.R b/tests/testthat/test-function-args.R index cb4586c5d7..c5e4e56907 100644 --- a/tests/testthat/test-function-args.R +++ b/tests/testthat/test-function-args.R @@ -4,6 +4,23 @@ filter_args <- function(x) { x[all_names] } +find_partial_match_pairs <- function(args) { + if (length(args) < 2) { + return(NULL) + } + combinations <- combn(args, 2L) + contains <- startsWith(combinations[1, ], combinations[2, ]) | + startsWith(combinations[2, ], combinations[1, ]) + + if (!any(contains)) { + return(NULL) + } + + problem <- combinations[, contains, drop = FALSE] + paste0("`", problem[1, ], "` with `", problem[2, ], "`") +} + + test_that("geom_xxx and GeomXxx$draw arg defaults match", { ggplot2_ns <- asNamespace("ggplot2") objs <- ls(ggplot2_ns) @@ -73,3 +90,53 @@ test_that("stat_xxx and StatXxx$compute_panel arg defaults match", { ) }) }) + +# If the following tests fail, you may have introduced a potential partial match +# in argument names. The code should be double checked that is doesn't +# accidentally use `list$arg` when `list$arg_name` also exists. If that doesn't +# occur, the snapshot can be updated. + +test_that("GeomXxx$parameters() does not contain partial matches", { + ggplot2_ns <- asNamespace("ggplot2") + objs <- ls(ggplot2_ns) + geom_class_names <- grep("^Geom", objs, value = TRUE) + geom_class_names <- setdiff(geom_class_names, c("Geom")) + + problems <- list() + + for (geom_class_name in geom_class_names) { + geom_obj <- ggplot2_ns[[geom_class_name]] + params <- geom_obj$parameters() + issues <- find_partial_match_pairs(params) + if (length(issues) == 0) { + next + } + problems[[geom_class_name]] <- issues + } + + problems <- vapply(problems, paste0, character(1), collapse = ", ") + problems <- paste0(format(names(problems)), ": ", problems) + expect_snapshot(problems) +}) + +test_that("StatXxx$parameters() does not contain partial matches", { + ggplot2_ns <- asNamespace("ggplot2") + objs <- ls(ggplot2_ns) + stat_class_names <- grep("^Stat", objs, value = TRUE) + stat_class_names <- setdiff(stat_class_names, c("Stat")) + + problems <- list() + + for (stat_class_name in stat_class_names) { + stat_obj <- ggplot2_ns[[stat_class_name]] + params <- stat_obj$parameters() + issues <- find_partial_match_pairs(params) + if (length(issues) == 0) { + next + } + problems[[stat_class_name]] <- issues + } + problems <- vapply(problems, paste0, character(1), collapse = ", ") + problems <- paste0(format(names(problems)), ": ", problems) + expect_snapshot(problems) +}) diff --git a/tests/testthat/test-legend-draw.R b/tests/testthat/test-legend-draw.R index 5f4cc01032..b0c0505b2a 100644 --- a/tests/testthat/test-legend-draw.R +++ b/tests/testthat/test-legend-draw.R @@ -36,7 +36,7 @@ test_that("all keys can be drawn without 'params'", { expect_in(nse, names(keys)) # Add title to every key - template <- gtable(width = unit(size, "mm"), heights = unit(c(1, size), c("lines", "mm"))) + template <- gtable(widths = unit(size, "mm"), heights = unit(c(1, size), c("lines", "mm"))) keys <- Map( function(key, name) { text <- textGrob(name, gp = gpar(fontsize = 8))