From b8f7924f628cd01dd040ad3de6ffa8d7ecef2c86 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Thu, 15 May 2025 16:20:13 -0400 Subject: [PATCH 1/7] add curly braces --- R/coord-.R | 20 +++++++++++++++----- R/coord-cartesian-.R | 9 +++++++-- R/coord-fixed.R | 4 +++- R/coord-polar.R | 8 ++++++-- R/coord-radial.R | 4 +++- R/coord-sf.R | 12 +++++++++--- R/coord-transform.R | 6 +++++- R/facet-.R | 6 ++++-- R/geom-.R | 8 ++++++-- R/geom-blank.R | 8 ++++++-- R/scale-.R | 16 ++++++++++++---- R/scale-view.R | 28 +++++++++++++++++++++------- R/stat-unique.R | 4 +++- 13 files changed, 100 insertions(+), 33 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 2b560292c4..05a86318cb 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -62,7 +62,9 @@ Coord <- ggproto("Coord", # Should any of the scales be reversed? reverse = "none", - aspect = function(ranges) NULL, + aspect = function(ranges) { + NULL + }, labels = function(self, labels, panel_params) { labels @@ -177,15 +179,23 @@ Coord <- ggproto("Coord", panel_params }, - transform = function(data, range) NULL, + transform = function(data, range) { + NULL + }, - distance = function(x, y, panel_params) NULL, + distance = function(x, y, panel_params) { + NULL + }, - is_linear = function() FALSE, + is_linear = function() { + FALSE + }, # Does the coordinate system support free scaling of axes in a faceted plot? # Will generally have to return FALSE for coordinate systems that enforce a fixed aspect ratio. - is_free = function() FALSE, + is_free = function() { + FALSE + }, setup_params = function(self, data) { list(expand = parse_coord_expand(self$expand %||% TRUE)) diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 350e9bfd86..0ccbe0beb5 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -86,8 +86,13 @@ coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE, #' @export CoordCartesian <- ggproto("CoordCartesian", Coord, - is_linear = function() TRUE, - is_free = function() TRUE, + is_linear = function() { + TRUE + }, + + is_free = function() { + TRUE + }, distance = function(x, y, panel_params) { max_dist <- dist_euclidean(panel_params$x$dimension(), panel_params$y$dimension()) diff --git a/R/coord-fixed.R b/R/coord-fixed.R index d48824cfc4..f611a3b162 100644 --- a/R/coord-fixed.R +++ b/R/coord-fixed.R @@ -46,7 +46,9 @@ coord_equal <- coord_fixed #' @usage NULL #' @export CoordFixed <- ggproto("CoordFixed", CoordCartesian, - is_free = function() FALSE, + is_free = function() { + FALSE + }, aspect = function(self, ranges) { diff(ranges$y.range) / diff(ranges$x.range) * self$ratio diff --git a/R/coord-polar.R b/R/coord-polar.R index b8855f52b9..9ba27957fa 100644 --- a/R/coord-polar.R +++ b/R/coord-polar.R @@ -80,9 +80,13 @@ coord_polar <- function(theta = "x", start = 0, direction = 1, clip = "on") { #' @export CoordPolar <- ggproto("CoordPolar", Coord, - aspect = function(details) 1, + aspect = function(details) { + 1 + }, - is_free = function() TRUE, + is_free = function() { + TRUE + }, distance = function(self, x, y, details, boost = 0.75) { arc <- self$start + c(0, 2 * pi) diff --git a/R/coord-radial.R b/R/coord-radial.R index 3cef9c2b5b..e23dbf9a1a 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -140,7 +140,9 @@ CoordRadial <- ggproto("CoordRadial", Coord, diff(details$bbox$y) / diff(details$bbox$x) }, - is_free = function() TRUE, + is_free = function() { + TRUE + }, distance = function(self, x, y, details, boost = 0.75) { arc <- details$arc %||% c(0, 2 * pi) diff --git a/R/coord-sf.R b/R/coord-sf.R index d603d57de7..cc15a2ef27 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -302,11 +302,15 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, }, # CoordSf enforces a fixed aspect ratio -> axes cannot be changed freely under faceting - is_free = function() FALSE, + is_free = function() { + FALSE + }, # for regular geoms (such as geom_path, geom_polygon, etc.), CoordSf is non-linear # if the default_crs option is being used, i.e., not set to NULL - is_linear = function(self) is.null(self$get_default_crs()), + is_linear = function(self) { + is.null(self$get_default_crs()) + }, distance = function(self, x, y, panel_params) { d <- self$backtransform_range(panel_params) @@ -327,7 +331,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, diff(panel_params$y_range) / diff(panel_params$x_range) / ratio }, - labels = function(labels, panel_params) labels, + labels = function(labels, panel_params) { + labels + }, render_bg = function(self, panel_params, theme) { el <- calc_element("panel.grid.major", theme) diff --git a/R/coord-transform.R b/R/coord-transform.R index 18230a1742..d9ca49a182 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -111,7 +111,11 @@ coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL #' @usage NULL #' @export CoordTrans <- ggproto("CoordTrans", Coord, - is_free = function() TRUE, + + is_free = function() { + TRUE + }, + distance = function(self, x, y, panel_params) { max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range) dist_euclidean(self$trans$x$transform(x), self$trans$y$transform(y)) / max_dist diff --git a/R/facet-.R b/R/facet-.R index 94b75148ee..c9b26f2fc3 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -98,7 +98,9 @@ Facet <- ggproto("Facet", NULL, map_data = function(data, layout, params) { cli::cli_abort("Not implemented.") }, - setup_panel_params = function(self, panel_params, coord, ...) panel_params, + setup_panel_params = function(self, panel_params, coord, ...) { + panel_params + }, init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) { scales <- list() if (!is.null(x_scale)) { @@ -161,7 +163,7 @@ Facet <- ggproto("Facet", NULL, params ) - # Draw individual panels, then call `$draw_panels()` method to + # Draw individual panels, then call `$draw_panels()` method to # assemble into gtable lapply(seq_along(panels[[1]]), function(i) { panel <- lapply(panels, `[[`, i) diff --git a/R/geom-.R b/R/geom-.R index e2d8806b35..fba42ca072 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -109,9 +109,13 @@ Geom <- ggproto("Geom", cli::cli_abort("{.fn {snake_class(self)}}, has not implemented a {.fn draw_group} method") }, - setup_params = function(data, params) params, + setup_params = function(data, params) { + params + }, - setup_data = function(data, params) data, + setup_data = function(data, params) { + data + }, # Combine data with defaults and set aesthetics from parameters use_defaults = function(self, data, params = list(), modifiers = aes(), diff --git a/R/geom-blank.R b/R/geom-blank.R index e1d6986081..1240d1cf9e 100644 --- a/R/geom-blank.R +++ b/R/geom-blank.R @@ -35,7 +35,11 @@ geom_blank <- function(mapping = NULL, data = NULL, #' @export GeomBlank <- ggproto("GeomBlank", Geom, default_aes = aes(), - handle_na = function(data, params) data, + handle_na = function(data, params) { + data + }, check_constant_aes = FALSE, - draw_panel = function(...) nullGrob() + draw_panel = function(...) { + nullGrob() + } ) diff --git a/R/scale-.R b/R/scale-.R index fa37bf5571..b379f51fbb 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -678,7 +678,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, n.breaks = NULL, trans = transform_identity(), - is_discrete = function() FALSE, + is_discrete = function() { + FALSE + }, train = function(self, x) { if (length(x) == 0) { @@ -958,7 +960,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, n.breaks.cache = NULL, palette.cache = NULL, - is_discrete = function() TRUE, + is_discrete = function() { + TRUE + }, train = function(self, x) { if (length(x) == 0) { @@ -1193,7 +1197,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, after.stat = FALSE, show.limits = FALSE, - is_discrete = function() FALSE, + is_discrete = function() { + FALSE + }, train = function(self, x) { if (!is.numeric(x)) { @@ -1353,7 +1359,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, transformation$transform(breaks) }, - get_breaks_minor = function(...) NULL, + get_breaks_minor = function(...) { + NULL + }, get_labels = function(self, breaks = self$get_breaks()) { if (is.null(breaks)) return(NULL) diff --git a/R/scale-view.R b/R/scale-view.R index a926084cd8..b4f07e9f0a 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -107,13 +107,27 @@ ViewScale <- ggproto("ViewScale", NULL, is_empty = function(self) { is.null(self$get_breaks()) && is.null(self$get_breaks_minor()) }, - is_discrete = function(self) self$scale_is_discrete, - dimension = function(self) self$continuous_range, - get_limits = function(self) self$limits, - get_breaks = function(self) self$breaks, - get_breaks_minor = function(self) self$minor_breaks, - get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks), - get_transformation = function(self) self$scale$get_transformation(), + is_discrete = function(self) { + self$scale_is_discrete + }, + dimension = function(self) { + self$continuous_range + }, + get_limits = function(self) { + self$limits + }, + get_breaks = function(self) { + self$breaks + }, + get_breaks_minor = function(self) { + self$minor_breaks + }, + get_labels = function(self, breaks = self$get_breaks()) { + self$scale$get_labels(breaks) + }, + get_transformation = function(self) { + self$scale$get_transformation() + }, rescale = function(self, x) { self$scale$rescale(x, self$limits, self$continuous_range) }, diff --git a/R/stat-unique.R b/R/stat-unique.R index 38483a2d7b..9d31a1266b 100644 --- a/R/stat-unique.R +++ b/R/stat-unique.R @@ -35,5 +35,7 @@ stat_unique <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatUnique <- ggproto("StatUnique", Stat, - compute_panel = function(data, scales) unique0(data) + compute_panel = function(data, scales) { + unique0(data) + } ) From 33253f40d3426cd172304398d2b170663330bf98 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Thu, 15 May 2025 16:21:03 -0400 Subject: [PATCH 2/7] add test --- tests/testthat/test-ggproto.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R index 6614f6eb34..3e8adcaa80 100644 --- a/tests/testthat/test-ggproto.R +++ b/tests/testthat/test-ggproto.R @@ -10,3 +10,24 @@ test_that("construction checks input", { expect_snapshot_error(ggproto("Test", NULL, a <- function(self, a) a)) expect_snapshot_error(ggproto("Test", mtcars, a = function(self, a) a)) }) + +test_that("all ggproto methods start with `{` (#6459)", { + + ggprotos <- Filter( + function(x) inherits(x, "ggproto"), + mget(ls("package:ggplot2"), asNamespace("ggplot2"), ifnotfound = list(NULL)) + ) + + method_nobrackets <- lapply(ggprotos, function(x) { + Filter( + function(m) inherits(x[[m]], "ggproto_method") && { + b <- as.list(body(get(m, x))) + length(b) == 0 || b[[1]] != quote(`{`) + }, + ls(envir = x) + ) + }) + + expect_length(Filter(length, method_nobrackets), 0) + +}) From 07586400187ed15b149e5c56ffce9f89070c15c9 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Thu, 15 May 2025 16:21:41 -0400 Subject: [PATCH 3/7] spell out identity() --- R/scale-.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/scale-.R b/R/scale-.R index b379f51fbb..00290340f9 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -983,7 +983,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, self$range$train(x, drop = self$drop, na.rm = !self$na.translate) }, - transform = identity, + transform = function(self, x) { + x + }, map = function(self, x, limits = self$get_limits()) { limits <- vec_slice(limits, !is.na(limits)) From f6c13b2d650b29d8c8ac36ee4de4d5602863cb42 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 09:35:34 +0200 Subject: [PATCH 4/7] bracket `Scale$palette()` --- R/scale-.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/scale-.R b/R/scale-.R index 0af6dc757d..37cb65d400 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -458,7 +458,9 @@ Scale <- ggproto("Scale", NULL, #' as described in e.g. [`?continuous_scale`][continuous_scale]. #' Note that `limits` is expected in transformed space. aesthetics = character(), - palette = function() cli::cli_abort("Not implemented."), + palette = function() { + cli::cli_abort("Not implemented.") + }, limits = NULL, na.value = NA, From 735eabfd98d35a216146dc7e0263e337d070e01d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 09:42:07 +0200 Subject: [PATCH 5/7] report potential test failures --- tests/testthat/test-ggproto.R | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R index 3e8adcaa80..6d979cd78a 100644 --- a/tests/testthat/test-ggproto.R +++ b/tests/testthat/test-ggproto.R @@ -18,16 +18,31 @@ test_that("all ggproto methods start with `{` (#6459)", { mget(ls("package:ggplot2"), asNamespace("ggplot2"), ifnotfound = list(NULL)) ) - method_nobrackets <- lapply(ggprotos, function(x) { - Filter( - function(m) inherits(x[[m]], "ggproto_method") && { - b <- as.list(body(get(m, x))) - length(b) == 0 || b[[1]] != quote(`{`) - }, - ls(envir = x) - ) - }) + lacks_brackets <- function(method) { + if (!inherits(method, "ggproto_method")) { + return(FALSE) + } + body <- as.list(body(environment(method)$f)) + if (length(body) == 0 || body[[1]] != quote(`{`)) { + return(TRUE) + } + return(FALSE) + } - expect_length(Filter(length, method_nobrackets), 0) + report_no_bracket <- function(ggproto_class) { + unlist(lapply( + ls(envir = ggproto_class), + function(method) { + has_brackets <- !lacks_brackets(ggproto_class[[method]]) + if (has_brackets) { + return(character()) + } + return(method) + } + )) + } + failures <- lapply(ggprotos, report_no_bracket) + failures <- failures[lengths(failures) > 0] + expect_equal(failures, list()) }) From 984528b9b4cb0f145beb4f7ffa8fd2bb00bc16a4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 09:42:34 +0200 Subject: [PATCH 6/7] add positive/negative control to test --- tests/testthat/test-ggproto.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R index 6d979cd78a..13cfdb9fb0 100644 --- a/tests/testthat/test-ggproto.R +++ b/tests/testthat/test-ggproto.R @@ -42,6 +42,15 @@ test_that("all ggproto methods start with `{` (#6459)", { )) } + # Test to make sure we're testing correctly + ctrl <- list( + foo = ggproto("Dummy", dummy = function(x) x + 10), + bar = ggproto("Dummy", dummy = function(x) {x + 10}) + ) + ctrl <- lapply(ctrl, report_no_bracket) + expect_equal(ctrl, list(foo = "dummy", bar = character())) + + # Actual relevant test failures <- lapply(ggprotos, report_no_bracket) failures <- failures[lengths(failures) > 0] expect_equal(failures, list()) From aaf812a5f53f8d33655b04663a7ea48e1d25a492 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 27 May 2025 09:57:32 +0200 Subject: [PATCH 7/7] fix test --- tests/testthat/test-ggproto.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R index 13cfdb9fb0..baad887619 100644 --- a/tests/testthat/test-ggproto.R +++ b/tests/testthat/test-ggproto.R @@ -53,5 +53,5 @@ test_that("all ggproto methods start with `{` (#6459)", { # Actual relevant test failures <- lapply(ggprotos, report_no_bracket) failures <- failures[lengths(failures) > 0] - expect_equal(failures, list()) + expect_equal(names(failures), character()) })