diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 8cc8c015a1..eee2d4b061 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -97,8 +97,14 @@ coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE, #' @export CoordCartesian <- ggproto("CoordCartesian", Coord, - is_linear = function() TRUE, - is_free = function(self) is.null(self$ratio), + is_linear = function() { + TRUE + }, + + is_free = function(self) { + is.null(self$ratio) + }, + aspect = function(self, ranges) { if (is.null(self$ratio)) { return(NULL) diff --git a/R/coord-fixed.R b/R/coord-fixed.R index 8485220c3f..f35e3d8cbb 100644 --- a/R/coord-fixed.R +++ b/R/coord-fixed.R @@ -37,7 +37,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 683f14cd44..107cbf0f74 100644 --- a/R/coord-polar.R +++ b/R/coord-polar.R @@ -20,9 +20,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 ba48ba46cc..d60479b506 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -199,7 +199,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 16967cda8c..4d6e9c1490 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -303,11 +303,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) @@ -328,7 +332,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 cb8d152286..145a5f8117 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -126,7 +126,11 @@ coord_trans <- function(...) { #' @export CoordTransform <- ggproto( "CoordTransform", 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/geom-blank.R b/R/geom-blank.R index d51416a43d..72b5b1e265 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 4fb8c00dcb..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, @@ -998,7 +1000,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) { @@ -1257,7 +1261,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) { @@ -1271,7 +1277,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, ) }, - transform = identity, + transform = function(self, x) { + x + }, map = function(self, x, limits = self$get_limits()) { limits <- vec_slice(limits, !is.na(limits)) @@ -1483,7 +1491,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, after.stat = FALSE, show.limits = FALSE, - is_discrete = function() FALSE, + is_discrete = function() { + FALSE + }, train = function(self, x) { if (length(x) == 0) { @@ -1644,7 +1654,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 db0b4bcd65..53d1404197 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 fca6399abd..0fa45cf5eb 100644 --- a/R/stat-unique.R +++ b/R/stat-unique.R @@ -4,7 +4,9 @@ #' @export StatUnique <- ggproto( "StatUnique", Stat, - compute_panel = function(data, scales) unique0(data) + compute_panel = function(data, scales) { + unique0(data) + } ) #' Remove duplicates diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R index 6614f6eb34..baad887619 100644 --- a/tests/testthat/test-ggproto.R +++ b/tests/testthat/test-ggproto.R @@ -10,3 +10,48 @@ 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)) + ) + + 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) + } + + 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) + } + )) + } + + # 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(names(failures), character()) +})