Improve consistency of naming internal functions (#6072)

* rename `validate_facets()` to `check_facets()`

* write prevalidation/postvalidation as checks

* more responsibility for `check_nondata_cols()`

* `check_subclass()` is actually validator

* path checker is validator

* plot_dev is a validator

* `check_breaks_labels()` has no return value

* make `check_scale_type()` consistent

* `validate_theme/element()` is a check

* update labeller deprecation message

* `check_labeller()` performs an update

* `check_linewidth()` performs an update

* `check_polar_guide()` is validator

* `update_labeller()` -> `fix_labeller()`

* `update_linewidth()` -> `fix_linewidth()`

* `check_facet_class()` --> `check_vars()`

Author: teunbrand

R/coord-radial.R

@@ -191,7 +191,7 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     # Validate appropriateness of guides
     drop_guides <- character(0)
     for (type in aesthetics) {
-      drop_guides <- check_polar_guide(drop_guides, guides, type)
+      drop_guides <- validate_polar_guide(drop_guides, guides, type)
     }
 
     guide_params <- guides$get_params(aesthetics)
@@ -603,7 +603,7 @@ theta_grid <- function(theta, element, inner_radius = c(0, 0.4),
   )
 }
 
-check_polar_guide <- function(drop_list, guides, type = "theta") {
+validate_polar_guide <- function(drop_list, guides, type = "theta") {
   guide <- guides$get_guide(type)
   primary <- gsub("\\.sec$", "", type)
   if (inherits(guide, "GuideNone") || primary %in% guide$available_aes) {

R/facet-.R

@@ -443,7 +443,7 @@ df.grid <- function(a, b) {
 # facetting variables.
 
 as_facets_list <- function(x) {
-  x <- validate_facets(x)
+  check_vars(x)
   if (is_quosures(x)) {
     x <- quos_auto_name(x)
     return(list(x))
@@ -487,7 +487,7 @@ as_facets_list <- function(x) {
   x
 }
 
-validate_facets <- function(x) {
+check_vars <- function(x) {
   if (is.mapping(x)) {
     cli::cli_abort("Please use {.fn vars} to supply facet variables.")
   }
@@ -499,7 +499,7 @@ validate_facets <- function(x) {
       "i" = "Did you use {.code %>%} or {.code |>} instead of {.code +}?"
     ))
   }
-  x
+  invisible()
 }
 
 # Flatten a list of quosures objects to a quosures object, and compact it

R/facet-grid-.R

@@ -177,7 +177,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   facets_list <- grid_as_facets_list(rows, cols)
 
   # Check for deprecated labellers
-  labeller <- check_labeller(labeller)
+  labeller <- fix_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,

R/facet-wrap.R

@@ -174,7 +174,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 
   # Check for deprecated labellers
-  labeller <- check_labeller(labeller)
+  labeller <- fix_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
   facets <- compact_facets(facets)

R/fortify.R

@@ -44,34 +44,46 @@ fortify.grouped_df <- function(model, data, ...) {
 # There are a lot of ways that dim(), colnames(), or as.data.frame() could
 # do non-sensical things (they are not even guaranteed to work!) hence the
 # paranoid mode.
-.prevalidate_data_frame_like_object <- function(data) {
+check_data_frame_like <- function(data) {
   orig_dims <- dim(data)
-  if (!vec_is(orig_dims, integer(), size=2))
-    cli::cli_abort(paste0("{.code dim(data)} must return ",
-                          "an {.cls integer} of length 2."))
-  if (anyNA(orig_dims) || any(orig_dims < 0))  # extra-paranoid mode
-    cli::cli_abort(paste0("{.code dim(data)} can't have {.code NA}s ",
-                          "or negative values."))
+  if (!vec_is(orig_dims, integer(), size = 2)) {
+    cli::cli_abort(
+      "{.code dim(data)} must return an {.cls integer} of length 2."
+    )
+  }
+  if (anyNA(orig_dims) || any(orig_dims < 0)) { # extra-paranoid mode
+    cli::cli_abort(
+      "{.code dim(data)} can't have {.code NA}s or negative values."
+    )
+  }
   orig_colnames <- colnames(data)
-  if (!vec_is(orig_colnames, character(), size = ncol(data)))
-    cli::cli_abort(paste0("{.code colnames(data)} must return a ",
-                          "{.cls character} of length {.code ncol(data)}."))
+  if (!vec_is(orig_colnames, character(), size = ncol(data))) {
+    cli::cli_abort(
+      "{.code colnames(data)} must return a {.cls character} of length {.code ncol(data)}."
+    )
+  }
+  invisible()
 }
-.postvalidate_data_frame_like_object <- function(df, data) {
+check_data_frame_conversion <- function(new, old) {
   msg0 <- "{.code as.data.frame(data)} must "
-  if (!is.data.frame(df))
+  if (!is.data.frame(new)) {
     cli::cli_abort(paste0(msg0, "return a {.cls data.frame}."))
-  if (!identical(dim(df), dim(data)))
+  }
+  if (!identical(dim(new), dim(old))) {
     cli::cli_abort(paste0(msg0, "preserve dimensions."))
-  if (!identical(colnames(df), colnames(data)))
+  }
+  if (!identical(colnames(new), colnames(old))) {
     cli::cli_abort(paste0(msg0, "preserve column names."))
+  }
+  invisible()
 }
 validate_as_data_frame <- function(data) {
-  if (is.data.frame(data))
+  if (is.data.frame(data)) {
     return(data)
-  .prevalidate_data_frame_like_object(data)
+  }
+  check_data_frame_like(data)
   df <- as.data.frame(data)
-  .postvalidate_data_frame_like_object(df, data)
+  check_data_frame_conversion(df, data)
   df
 }
 

R/geom-.R

@@ -170,17 +170,11 @@ Geom <- ggproto("Geom",
       )
 
       # Check that all output are valid data
-      nondata_modified <- check_nondata_cols(modified_aes)
-      if (length(nondata_modified) > 0) {
-        issues <- paste0("{.code ", nondata_modified, " = ", as_label(modifiers[[nondata_modified]]), "}")
-        names(issues) <- rep("x", length(issues))
-        cli::cli_abort(c(
-          "Aesthetic modifiers returned invalid values",
-          "x" = "The following mappings are invalid",
-          issues,
-          "i" = "Did you map the modifier in the wrong layer?"
-        ))
-      }
+      check_nondata_cols(
+        modified_aes, modifiers,
+        problem = "Aesthetic modifiers returned invalid values.",
+        hint    = "Did you map the modifier in the wrong layer?"
+      )
 
       modified_aes <- cleanup_mismatched_data(modified_aes, nrow(data), "after_scale")
 
@@ -283,7 +277,7 @@ check_aesthetics <- function(x, n) {
   ))
 }
 
-check_linewidth <- function(data, name) {
+fix_linewidth <- function(data, name) {
   if (is.null(data$linewidth) && !is.null(data$size)) {
     deprecate_soft0("3.4.0", I(paste0("Using the `size` aesthetic with ", name)), I("the `linewidth` aesthetic"))
     data$linewidth <- data$size

R/geom-boxplot.R

@@ -286,7 +286,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
                         whisker_gp = NULL, staple_gp = NULL, median_gp = NULL,
                         box_gp = NULL, notch = FALSE, notchwidth = 0.5,
                         staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     # this may occur when using geom_boxplot(stat = "identity")
     if (nrow(data) != 1) {

R/geom-crossbar.R

@@ -84,8 +84,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", fatten = 2.5, width = NULL,
                         flipped_aes = FALSE, middle_gp = NULL, box_gp = NULL) {
-
-    data <- check_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
 
     middle <- transform(data, x = xmin, xend = xmax, yend = y, linewidth = linewidth * fatten, alpha = NA)

R/geom-defaults.R

@@ -106,7 +106,7 @@ get_geom_defaults <- function(geom, theme = theme_get()) {
     return(data)
   }
   if (is.character(geom)) {
-    geom <- check_subclass(geom, "Geom")
+    geom <- validate_subclass(geom, "Geom")
   }
   if (is.geom(geom)) {
     out <- geom$use_defaults(data = NULL, theme = theme)
@@ -126,7 +126,7 @@ reset_stat_defaults <- function() reset_defaults("stat")
 cache_defaults <- new_environment()
 
 update_defaults <- function(name, subclass, new, env = parent.frame()) {
-  obj   <- check_subclass(name, subclass, env = env)
+  obj   <- validate_subclass(name, subclass, env = env)
   index <- snake_class(obj)
 
   if (is.null(new)) { # Reset from cache

R/geom-errorbar.R

@@ -93,7 +93,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
   # Note: `width` is vestigial
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         width = NULL, flipped_aes = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     x <- vec_interleave(data$xmin, data$xmax, NA, data$x,    data$x,    NA, data$xmin, data$xmax)
     y <- vec_interleave(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)