🚸 Improvements to histogram guide (#65)

* Clarify `hist.args`

* populate `breaks` for histogram if we have a binned key

* default to binned key with binned scale

* move key extraction logic

* document

* add news bullet

* allow using density instead of counts

NEWS.md

@@ -8,6 +8,11 @@
 * A better attempt to honour ggplot2's mechanism for `<AsIs>` variables (#45)
 * Better alignment of `compose_stack(side.titles)` (#48)
 * Fixed aesthetic standardisation in `override.aes` arguments (#60)
+* Improvements to density and histogram gizmos (#62):
+    * The default key now depends on the scale type: continuous scales invoke 
+    `key_sequence()` and binned scales invoke `key_bins()`.
+    * When using a binned key in `gizmo_histogram()`, the default `hist(breaks)`
+    argument is populated with the key's breaks.
 
 # legendry 0.2.0
 

R/gizmo-density.R

@@ -6,7 +6,8 @@
 #' aesthetic is `colour` or `fill`, the shape will reflect this.
 #'
 #' @param key A [sequence key][key_sequence] or [binned key][key_bins]
-#'   specification.
+#'   specification. Internally defaults to a sequence key when the scale is
+#'   continuous and a binned key when the scale is binned.
 #' @param density One of the following:
 #'  * `NULL` for using kernel density estimation on the data values (default).
 #'  * a `<numeric>` vector to feed to the `density.fun` function.
@@ -53,7 +54,7 @@
 #' # Alternatively, parameters may be passed through density.args
 #' p + guides(colour = gizmo_density(density.args = list(adjust = 0.5)))
 gizmo_density <- function(
-  key = "sequence",
+  key = waiver(),
   density = NULL, density.args = list(), density.fun = stats::density,
   just = 0.5, oob = "keep", alpha = NA,
   # standard arguments
@@ -96,6 +97,7 @@ GizmoDensity <- ggproto(
   ),
 
   extract_key = function(scale, aesthetic, key, ...) {
+    key <- key %|W|% if (inherits(scale, "ScaleBinned")) "bins" else "sequence"
     key <-  resolve_key(key %||% "sequence")
     if (is.function(key)) {
       key <- disallow_even_steps(key)

R/gizmo-histogram.R

@@ -15,11 +15,17 @@
 #'   space, not original data space.
 #' @param hist.args A `<list>` with additional arguments to the `hist.fun`
 #'   argument. Only applies when `hist` is not provided as a `<list>` already.
+#'   Please note that these arguments are only used for binning and counting:
+#'   graphical arguments are ignored.
 #' @param hist.fun A `<function>` to use for computing histograms when the
 #'   `hist` argument is not provided as a list already.
 #' @param just A `<numeric[1]>` between 0 and 1. Use 0 for bottom- or
 #'   left-aligned histograms, use 1 for top- or right-aligned histograms and 0.5
 #'   for centred histograms.
+#' @param metric A `<character[1]>` either `"counts"` or `"density"` stating
+#'   which field of the `<histogram>` class to display. The `"density"` metric
+#'   might be more appropriate to display when the histogram breaks have
+#'   non-constant intervals.
 #' @inheritParams gizmo_density
 #'
 #' @details
@@ -51,23 +57,24 @@
 #' # Alternatively, parameters may be passed through hist.args
 #' p + guides(colour = gizmo_histogram(hist.arg = list(breaks = 10)))
 gizmo_histogram <- function(
-  key = "sequence",
+  key = waiver(),
   hist = NULL, hist.args = list(), hist.fun = graphics::hist,
-  just = 1, oob = oob_keep, alpha = NA,
+  just = 1, oob = oob_keep, metric = "counts", alpha = NA,
   # standard arguments
   theme = NULL, position = waiver(), direction = NULL
 ) {
   hist <- suppress_hist_plot(enquo(hist))
   hist.args$plot <- hist.args$plot %||% FALSE
 
   check_number_decimal(just, min = 0, max = 1, allow_infinite = FALSE)
+  check_argmatch(metric, c("counts", "density"))
 
   new_guide(
     key = key,
     hist      = hist,
     hist_args = hist.args,
     hist_fun  = hist.fun,
-    just = just, oob  = oob, alpha = alpha,
+    just = just, oob  = oob, metric = metric, alpha = alpha,
     theme = theme, position = position, direction = direction,
     name = "histogram",
     super = GizmoHistogram
@@ -85,7 +92,8 @@ GizmoHistogram <- ggproto(
 
   params = new_params(
     hist = NULL, hist_args = list(), hist_fun = graphics::hist,
-    just = 0.5, nbin = 15, oob = oob_keep, alpha = NA, key = "sequence"
+    just = 0.5, nbin = 15, oob = oob_keep, metric = "counts",
+    alpha = NA, key = "sequence"
   ),
 
   extract_decor = function(scale, hist, hist_args, hist_fun, ...) {
@@ -100,24 +108,33 @@ GizmoHistogram <- ggproto(
     hist
   },
 
+  extract_params = function(scale, params, ...) {
+    params <- GizmoDensity$extract_params(scale, params, ...)
+    if (is.null(params$hist) && inherits(params$key, "key_bins")) {
+      breaks <- sort(union(params$key$min, params$key$max))
+      params$hist_args$breaks <- params$hist_args$breaks %||% breaks
+    }
+    params
+  },
+
   get_layer_key = function(params, layers, data = NULL, ...) {
     hist <- params$decor %||% params$hist
     if (length(hist) == 0) {
       values <- filter_finite(vec_c(!!!lapply(data, .subset2, params$aesthetic)))
       hist   <- inject(params$hist_fun(values, !!!params$hist_args))
-      check_histogram(hist)
+      check_histogram(hist, params$metric)
     }
-    params$decor  <- normalise_histogram(hist)
+    params$decor  <- normalise_histogram(hist, params$metric)
     params$limits <- range(params$limits, params$decor$x)
     params
   }
 )
 
 # Helpers -----------------------------------------------------------------
 
-normalise_histogram <- function(hist) {
+normalise_histogram <- function(hist, metric = "counts") {
   x <- hist$breaks
-  y <- hist$counts
+  y <- hist[[metric]]
 
   xlim <- range(filter_finite(x), na.rm = TRUE)
   x    <- oob_squish_infinite(x, xlim)
@@ -131,28 +148,28 @@ normalise_histogram <- function(hist) {
   )
 }
 
-check_histogram <- function(x, arg = caller_arg(x), call = caller_env()) {
+check_histogram <- function(x, metric = "counts", arg = caller_arg(x), call = caller_env()) {
   if (is_missing(x)) {
     cli::cli_abort("{.arg {arg}} cannot be missing.", call = call)
   }
   if (inherits(x, "histogram")) {
     # We'll trust this class
     return(x)
   }
-  check_list_names(x, c("breaks", "counts"), arg = arg, call = call)
+  check_list_names(x, c("breaks", metric), arg = arg, call = call)
 
-  if (length(x$breaks) != (length(x$counts) + 1L)) {
+  if (length(x$breaks) != (length(x[[metric]]) + 1L)) {
     cli::cli_abort(c(paste0(
       "In the {.arg {arg}} argument, the {.field breaks} element should be ",
-      "exactly 1 longer than the {.field counts} element."
+      "exactly 1 longer than the {.field {metric}} element."
     ),
     i = "{.code {arg}$breaks} has length {length(x$breaks)}.",
-    i = "{.code {arg}$counts} has length {length(x$counts)}."
+    i = "{.code {arg}${metric}} has length {length(x[[metric]])}."
     ), call = call)
   }
   check_length(x$breaks, min = 2, arg = as_cli("{arg}$breaks"), call = call)
   check_bare_numeric(x$breaks,    arg = as_cli("{arg}$breaks"), call = call)
-  check_bare_numeric(x$counts,    arg = as_cli("{arg}$counts"), call = call)
+  check_bare_numeric(x$counts,    arg = as_cli("{arg}${metric}"), call = call)
   invisible()
 }