type_summary improvements

NEWS.md

@@ -131,6 +131,11 @@ related to plot layering. See "Bug fixes" below.
   `"cat"` (console), in any combination; a destination the user has already
   labelled is left alone. Shared bandwidths are reported once and named as
   joint, individual bandwidths per group. (#287 @haomeng797-ship-it)
+- `type_summary()` gains a `dodge` (and `fixed.dodge`) argument, thus enabling 
+  dodging of grouped plots. This is mostly useful for adding summaries on top of
+  a base layer that is itself dodged. Separately, `type_summary()`'s internals
+  have been refactored to use `stats::aggregate` instead of `stats::ave`.
+  (#701 @grantmcdermott)
 - Custom plot types have more control over the surrounding plot machinery, via a
   new `type_hints` mechanism. A type can declare properties about itself---that
   it draws its own axes, needs a secondary right-hand axis, uses proportional

R/dodge.R

@@ -54,6 +54,15 @@ dodge_positions = function(
 
   if (is.logical(dodge)) {
     if (isTRUE(dodge)) {
+      if (!is.factor(datapoints[["by"]])) {
+        msg = paste0(
+          "`dodge = TRUE` only possible with discrete (categorical) `by`. ",
+          "Either specify numeric [0,1] dodge, or coerce ` by` to a factor.\n",
+          "Ignoring.\n"
+        )
+        warning(msg)
+        return(datapoints)
+      }
       n = nlevels(datapoints$by)
       dodge = if (n == 1) 0 else if (n <= 5) (n - 1) * 0.1 else 0.45
     } else {

R/type_summary.R

@@ -4,11 +4,13 @@
 #' @description
 #' Applies a summary function to `y` along unique values of `x`. For example,
 #' plot the mean `y` value for each `x` value. Internally,
-#' `type_summary()` applies a thin wrapper around \code{\link[stats]{ave}} and
-#' then passes the result to [`type_lines`] for drawing.
+#' `type_summary()` applies a thin wrapper around \code{\link[stats]{aggregate}}
+#' and then passes the result to [`type_lines`] for drawing.
 #'
 #' @param fun summarizing function. Should be compatible with
 #'   \code{\link[stats]{ave}}. Defaults to \code{\link[base]{mean}}.
+#' @inheritParams dodge_positions
+#' @inheritParams type_points
 #' @param ... Additional arguments are passed to the `lines()` function,
 #' ex: `type="p"`, `col="pink"`.
 #' @seealso [`ave`] which performs the summarizing (averaging) behind the
@@ -36,21 +38,26 @@
 #'
 #' @importFrom stats ave
 #' @export
-type_summary = function(fun = mean, ...) {
+type_summary = function(fun = mean, dodge = 0, fixed.dodge = FALSE, ...) {
   assert_function(fun)
   lines_args = list(...)
   data_summary = function(fun) {
     funky = function(settings, ...) {
       env2env(settings, environment(), c("datapoints", "by", "facet"))
-
-      datapoints = split(datapoints, list(datapoints$facet, datapoints$by), drop = TRUE)
-      datapoints = lapply(datapoints, function(dat) {
-        newy = ave(dat$y, dat$x, FUN = fun)
-        dat$y = newy
-        dat = dat[order(dat$x), ]
-        return(dat)
-      })
-      datapoints = do.call(rbind, datapoints)
+      datapoints[["rowid"]] = NULL
+      datapoints = aggregate(. ~ x + facet + by, data = datapoints, FUN = fun)
+      if (dodge != 0) {
+        if (is.factor(datapoints[["x"]])) {
+          xlvls = levels(datapoints[["x"]])
+          xlabs = seq_along(xlvls)
+          names(xlabs) = xlvls
+          datapoints[["x"]] = as.integer(datapoints[["x"]])
+          env2env(environment(), settings, "xlabs")
+        } else {
+          xlabs = NULL
+        }
+        datapoints = dodge_positions(datapoints, dodge, fixed.dodge)
+      }
       env2env(environment(), settings, "datapoints")
     }
     return(funky)