Check for aes params in uses_geom_param() (#28)

Co-authored-by: Garrick Aden-Buie <garrick@adenbuie.com>
Co-authored-by: rossellhayes <rossellhayes@users.noreply.github.com>

NAMESPACE

@@ -1,16 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(default_label,default)
-S3method(default_label,ggplot)
 S3method(get_data,ggplot)
 S3method(get_data,layer_to_check)
 S3method(get_mappings,ggplot)
 S3method(get_mappings,layer_to_check)
 export(.result)
 export(default_label)
+export(default_param)
 export(fail_if_not_ggplot)
 export(get_coordinate_system)
 export(get_data)
+export(get_default_labels)
+export(get_default_params)
 export(get_geom_layer)
 export(get_geoms)
 export(get_geoms_stats)
@@ -36,6 +37,7 @@ export(uses_coordinate_system)
 export(uses_data)
 export(uses_extra_mappings)
 export(uses_geom_param)
+export(uses_geom_params)
 export(uses_geoms)
 export(uses_labels)
 export(uses_mappings)

R/default_placeholders.R

@@ -0,0 +1,33 @@
+#' Placeholders for default values
+#'
+#' @description
+#' These functions generate placeholder values.
+#' - `default_label()` can be used as a named argument in [uses_labels()]
+#'   to check that a label matches the result of [get_default_labels()]
+#'   with that name.
+#' - `default_param()` can be used as a named argument in [uses_geom_params()]
+#'   to check that a parameter matched the result of [get_default_params()]
+#'   with that name.
+#'
+#' @examples
+#' require(ggplot2)
+#'
+#' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = trans)) +
+#'   geom_smooth(se = FALSE) +
+#'   labs(title = "My plot", x = "Weight", y = "MPG")
+#'
+#' uses_labels(p, x = default_label(), color = default_label())
+#'
+#' uses_geom_params(p, "smooth", size = default_param(), se = default_param())
+#' @return A placeholder value to be used within [uses_labels()]
+#'   or [uses_geom_params()].
+#' @export
+default_label <- function() {
+  structure(list(), class = c(".default_label", "ggcheck_placeholder"))
+}
+
+#' @rdname default_label
+#' @export
+default_param <- function() {
+  structure(list(), class = c(".default_param", "ggcheck_placeholder"))
+}

R/geom_params.R

@@ -0,0 +1,169 @@
+#' Does a layer use one of more specific parameters?
+#'
+#' \code{uses_geom_params} checks that a plot's geom layer uses a specific parameter.
+#'
+#' To specify a specific geom layer, either specify using position using the \code{i} index or
+#' by using a combination of \code{geom} function suffix name and \code{i} to check the ith layer that
+#' uses the geom.
+#'
+#' The \code{params} argument accepts a list that contains geom, stat, or aes
+#' parameters. This offers flexibility in certain situations where setting a
+#' parameter on a \code{geom_} function is actually setting a stat parameter or
+#' aes parameter. For example, in \code{geom_histogram(binwidth = 500)}, the
+#' \code{binwidth} is a stat parameter, while in
+#' \code{geom_histogram(fill = "blue")}, the \code{fill} is an aes parameter.
+#' \code{uses_geom_params} will take this into account and check geom, stat, and
+#' aes parameters.
+#'
+#' Note that `uses_geom_params()` can detect aes _parameters_, but not aes
+#' _mappings_. Parameters are set to static values directly within a layer (e.g.
+#' `geom_point(color = "blue")`), while mappings associate variables in the data with plot aesthetics using
+#' [`aes()`][ggplot2::aes] (e.g. `geom_point(aes(color = class))`).
+#'
+#' @examples
+#' require(ggplot2)
+#'
+#' p <- ggplot(data = diamonds, aes(x = cut, y = price)) +
+#'   geom_boxplot(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue")
+#'
+#' uses_geom_params(
+#'   p, "boxplot", list(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue")
+#' )
+#'
+#' uses_geom_params(
+#'   p, "boxplot", varwidth = TRUE, outlier.alpha = 0.01, fill = "blue"
+#' )
+#'
+#' # Unnamed arguments check that a parameter is set to any value
+#' uses_geom_params(p, "boxplot", "fill")
+#' @param p A ggplot object
+#' @param geom A character string found in the suffix of a ggplot2 geom function,
+#'  e.g. \code{"point"}.
+#' @param ... <[`dynamic-dots`][rlang::dyn-dots]>
+#'   Named values or [character] strings.
+#'   Unnamed arguments will check whether any value was set for that parameter.
+#'   Named arguments will check whether the parameter with the same name has a
+#'   matching value.
+#'   Each argument should have a name matching a [ggplot][ggplot2::ggplot]
+#'   layer parameter.
+#'   Values may be passed as arguments or as list elements.
+#' @param params A named list of geom or stat parameter values, e.g.
+#'   \code{list(outlier.alpha = 0.01)}.
+#'   This list is combined with any inputs to `...`
+#' @inheritParams get_geom_layer
+#'
+#' @return A named logical vector of the same length as the number of inputs
+#'   to `...`.
+#' @family functions for checking geom parameters
+#' @export
+uses_geom_params <- function(p, geom, ..., params = NULL, i = NULL) {
+  stop_if_not_ggplot(p)
+
+  layer <- get_geom_layer(p, geom = geom, i = i)$layer
+
+  params <- c(params, flatten_dots(...))
+  named  <- names(params) != ""
+
+  user_params         <- names(params)
+  user_params[!named] <- as.character(params[!named])
+
+  default_params <- purrr::map_lgl(params, inherits, ".default_param")
+  params[default_params] <- purrr::map(
+    names(params)[default_params],
+    ~ unlist(unname(get_default_params(p, geom, ., i = i)))
+  )
+
+  result        <- logical(length(params))
+  names(result) <- user_params
+
+  user_params[user_params == "color"] <- "colour"
+
+  # Collect geom, stat, and aes parameters
+  all_params <- c(layer$geom_params, layer$stat_params, layer$aes_params)
+
+  # Add inherited default parameters
+  get_default_params <- get_default_params(p, geom)
+  inherited <- !names(get_default_params) %in% names(all_params)
+  all_params_with_inherited <- c(all_params, get_default_params[inherited])
+
+  result[named] <- purrr::map2_lgl(
+    params[named], all_params_with_inherited[user_params][named], identical
+  )
+  result[!named] <- user_params[!named] %in% names(all_params)
+  result
+}
+
+#' @rdname uses_geom_params
+#' @export
+uses_geom_param <- uses_geom_params
+
+#' What are the default parameters for a plot layer?
+#'
+#' @examples
+#' require(ggplot2)
+#'
+#' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) +
+#'   geom_smooth(aes(color = class))
+#'
+#' # Returns the parameters the ggplot would use by default for a layer
+#' get_default_params(p, "smooth", "linetype")
+#' get_default_params(p, "smooth", c("se", "level"))
+#' get_default_params(p, "smooth")
+#'
+#' # If a parameter does not exist, returns NULL
+#' get_default_params(p, "smooth", "shape")
+#'
+#' # The colo(u)r aesthetic can be matched with or without a u
+#' get_default_params(p, "smooth", "color")
+#' get_default_params(p, "smooth", "colour")
+#' @inheritParams uses_geom_params
+#' @param params A [character] vector.
+#'   `get_default_params()` returns the default parameter value with a name
+#'   matching each string in `params`.
+#'   If `params` is [`NULL`] (the default), the default values for
+#'   all parameters are returned.
+#'
+#' @return A named [list] of the same length as `params`, or, if `params` is
+#'   [`NULL`], a named list of default values for all parameters of `geom`.
+#' @family functions for checking geom parameters
+#' @export
+get_default_params <- function(p, geom, params = NULL, i = NULL) {
+  stop_if_not_ggplot(p)
+
+  layer <- get_geom_layer(p, geom = geom, i = i)$layer
+
+  if (!is.character(params) && !is.null(params)) {
+    stop(
+      "`params` must be a character vector or `NULL`.",
+      call. = FALSE
+    )
+  }
+
+  names(params) <- params
+  params[params == "color"] <- "colour"
+
+  snake_class <- utils::getFromNamespace("snake_class", "ggplot2")
+
+  default_geom <- utils::getFromNamespace(snake_class(layer$geom), "ggplot2")()
+  default_stat <- utils::getFromNamespace(snake_class(layer$stat), "ggplot2")()
+
+  result <- c(
+    default_geom$geom$default_aes,
+    default_geom$geom_params,
+    default_geom$stat_params,
+    default_stat$geom$default_aes,
+    default_stat$geom_params,
+    default_stat$stat_params
+  )
+
+  # Remove duplicate entries
+  # (some params have the same default in geom_params and stat_params)
+  result <- result[unique(names(result))]
+
+  if (length(params)) {
+    result <- result[params]
+    names(result) <- names(params)
+  }
+
+  result
+}

R/geoms.R

@@ -102,53 +102,6 @@ uses_geoms <- function(p, geoms, stats = NULL, exact = TRUE) {
   }
 }
 
-#' Does a layer use a specific geom parameter?
-#'
-#' \code{uses_geom_param} checks that a plot's geom layer uses a specific geom parameter.
-#'
-#' To specify a specific geom layer, either specify using position using the \code{i} index or
-#' by using a combination of \code{geom} function suffix name and \code{i} to check the ith layer that
-#' uses the geom.
-#'
-#' The \code{params} argument accepts a list that contains geom or stat parameters. This offers
-#' flexibility in certain situations where setting a parameter on a \code{geom_} function is
-#' actually setting a stat parameter. For e.g., in \code{geom_histogram(binwidth = 500)},
-#' the \code{binwidth} is a stat parameter. \code{uses_geom_param} will take this into account
-#' and check both geom and stat parameters.
-#'
-#' @param p A ggplot object
-#' @param geom A character string found in the suffix of a ggplot2 geom function,
-#'  e.g. \code{"point"}.
-#' @param params A named list of geom or stat parameter values, e.g. \code{list(outlier.alpha = 0.01)}
-#' @param i A numerical index, e.g. \code{1}.
-#'
-#' @return A boolean
-#' @export
-#'
-#' @examples
-#' require(ggplot2)
-#' p <- ggplot(data = diamonds, aes(x = cut, y = price)) +
-#'   geom_boxplot(varwidth = TRUE, outlier.alpha = 0.01)
-#' uses_geom_param(p, geom = "boxplot", params = list(varwidth = TRUE, outlier.alpha = 0.01))
-uses_geom_param <- function(p, geom, params, i = NULL) {
-  stop_if_not_ggplot(p)
-  layer <- get_geom_layer(p, geom = geom, i = i)$layer
-  user_params <- names(params)
-  # collect geom and stat parameters
-  all_params <- c(layer$geom_params, layer$stat_params)
-  p_params <- names(all_params)
-  # check if user supplied invalid parameters
-  invalid_params <- !(user_params %in% p_params)
-  if (any(invalid_params)) {
-    stop(
-      "Grading error: the supplied parameters ",
-      paste0("'", user_params[invalid_params], "'", collapse = ", "), " are invalid."
-    )
-  }
-  # check both the user parameters contained in plot's geom and stat parameters
-  identical(params, all_params[user_params])
-}
-
 #' Which geom is used in the ith layer?
 #'
 #' \code{ith_geom} returns the type of geom used by the ith layer.

R/labels.R

@@ -94,15 +94,15 @@ get_labels <- function(p, aes = NULL) {
 #'   [aesthetic][ggplot2::aes] or [label][ggplot2::labs].
 #'   Strings may be input as individual arguments or as list elements.
 #'
-#' @return A logical vector of the same length as the number of inputs to `...`.
+#' @return A named logical vector of the same length as the number of inputs
+#'   to `...`.
 #'
 #' @family functions for checking labels
 #' @export
 uses_labels <- function(p, ...) {
   stop_if_not_ggplot(p)
 
-  args <- rlang::flatten(rlang::dots_list(...))
-  args <- rlang::dots_list(!!!args, .homonyms = "error")
+  args <- flatten_dots(...)
 
   if (length(args) == 0) {
     stop(
@@ -114,7 +114,7 @@ uses_labels <- function(p, ...) {
   default_labels <- purrr::map_lgl(args, inherits, ".default_label")
 
   args[default_labels] <- purrr::map(
-    names(args)[default_labels], ~ unlist(default_label(p, .))
+    names(args)[default_labels], ~ unlist(get_default_labels(p, .))
   )
 
   if (!all(is_scalar_string_or_null(args))) {
@@ -154,20 +154,20 @@ uses_labels <- function(p, ...) {
 #'   labs(title = "My plot", x = "Weight", y = "MPG", color = NULL)
 #'
 #' # Returns the label the ggplot would create by default for an aesthetic
-#' default_label(p, "x")
-#' default_label(p, c("x", "y"))
-#' default_label(p)
+#' get_default_labels(p, "x")
+#' get_default_labels(p, c("x", "y"))
+#' get_default_labels(p)
 #'
 #' # If an aesthetic does not exist, returns NULL
-#' default_label(p, "size")
+#' get_default_labels(p, "size")
 #'
 #' # Non-aesthetic labels have no default value, so they also return NULL
-#' default_label(p, "title")
-#' default_label(p, "comment")
+#' get_default_labels(p, "title")
+#' get_default_labels(p, "comment")
 #'
 #' # The colo(u)r aesthetic can be matched with or without a u
-#' default_label(p, "color")
-#' default_label(p, "colour")
+#' get_default_labels(p, "color")
+#' get_default_labels(p, "colour")
 #' @param p A [ggplot][ggplot2::ggplot] object
 #' @param aes If `aes` is a [character] vector, returns only the default labels
 #'   (based on the plot `p`) that correspond to the included aesthetics.
@@ -181,21 +181,9 @@ uses_labels <- function(p, ...) {
 #'
 #' @family functions for checking labels
 #' @export
-default_label <- function(p, aes = NULL) {
-  UseMethod("default_label")
-}
-
-#' @export
-default_label.default <- function(p, aes = NULL) {
-  if (!missing(p)) {
-    stop_if_not_ggplot()
-  }
-
-  structure(list(), class = c(".default_label", "ggcheck_placeholder"))
-}
+get_default_labels <- function(p, aes = NULL) {
+  stop_if_not_ggplot(p)
 
-#' @export
-default_label.ggplot <- function(p, aes = NULL) {
   if (is.null(aes)) {
     aes <- names(p$labels)
   }

R/utils.R

@@ -334,3 +334,9 @@ map_stat <- function(stat) {
     stat = stat_lookup$STAT[which(stat_lookup$stat == stat)]
   )
 }
+
+flatten_dots <- function(...) {
+  args <- rlang::flatten(rlang::dots_list(...))
+  args <- rlang::dots_list(!!!args, .homonyms = "error")
+  args
+}

README.md

@@ -82,7 +82,8 @@ method and the confidence interval was not displayed:
 
 ``` r
 uses_geom_param(p, "smooth", list(se = FALSE, method = "lm"))
-#> [1] TRUE
+#>     se method 
+#>   TRUE   TRUE
 ```
 
 There’s a lot more that ggcheck can do. Read more in the [full function