add a proper stat_density_2d_filled(). Closes tidyverse#3846.

Author: clauswilke

NAMESPACE

@@ -594,7 +594,9 @@ export(stat_contour_filled)
 export(stat_count)
 export(stat_density)
 export(stat_density2d)
+export(stat_density2d_filled)
 export(stat_density_2d)
+export(stat_density_2d_filled)
 export(stat_ecdf)
 export(stat_ellipse)
 export(stat_function)

R/geom-density2d.r

@@ -17,8 +17,8 @@
 #' @inheritParams geom_point
 #' @inheritParams geom_path
 #' @param contour_var Character string identifying the variable to contour
-#'   by. Can be one of `"density"`, `"ndensity"`, or `"count"`. See [stat_density_2d()]
-#'   for details.
+#'   by. Can be one of `"density"`, `"ndensity"`, or `"count"`. See the section
+#'   on computed variables for details.
 #' @export
 #' @examples
 #' m <- ggplot(faithful, aes(x = eruptions, y = waiting)) +
@@ -86,7 +86,6 @@ geom_density_2d <- function(mapping = NULL, data = NULL,
       linejoin = linejoin,
       linemitre = linemitre,
       contour = TRUE,
-      contour_type = "lines",
       contour_var = contour_var,
       na.rm = na.rm,
       ...
@@ -128,7 +127,6 @@ geom_density_2d_filled <- function(mapping = NULL, data = NULL,
     params = list(
       na.rm = na.rm,
       contour = TRUE,
-      contour_type = "bands",
       contour_var = contour_var,
       ...
     )

R/stat-density-2d.r

@@ -1,25 +1,22 @@
 #' @export
 #' @rdname geom_density_2d
 #' @param contour If `TRUE`, contour the results of the 2d density
-#'   estimation
-#' @param contour_type When `contour = TRUE`, specifies whether the output
-#'   is contour lines (`contour_type = "lines"`) or contour bands
-#'   (`contour_type = "bands"`). For filled contours, you need to specify
-#'   bands.
+#'   estimation.
 #' @param contour_var Character string identifying the variable to contour
 #'   by. Can be one of `"density"`, `"ndensity"`, or `"count"`. See the section
 #'   on computed variables for details.
-#' @param n number of grid points in each direction
+#' @param n Number of grid points in each direction.
 #' @param h Bandwidth (vector of length two). If `NULL`, estimated
 #'   using [MASS::bandwidth.nrd()].
 #' @param adjust A multiplicative bandwidth adjustment to be used if 'h' is
 #'    'NULL'. This makes it possible to adjust the bandwidth while still
 #'    using the a bandwidth estimator. For example, `adjust = 1/2` means
 #'    use half of the default bandwidth.
 #' @section Computed variables:
-#' `stat_density_2d()` computes different variables depending on whether
-#' contouring is turned on or off. With contouring off (`contour = FALSE`),
-#' the following variables are provided:
+#' `stat_density_2d()` and `stat_density_2d_filled()` compute different
+#' variables depending on whether contouring is turned on or off. With
+#' contouring off (`contour = FALSE`), both stats behave the same, and the
+#' following variables are provided:
 #' \describe{
 #'   \item{`density`}{The density estimate.}
 #'   \item{`ndensity`}{Density estimate, scaled to a maximum of 1.}
@@ -29,38 +26,33 @@
 #'
 #' With contouring on (`contour = TRUE`), either [stat_contour()] or
 #' [stat_contour_filled()] (for contour lines or contour bands,
-#' respectively) is run after the density estimate is calculated,
+#' respectively) is run after the density estimate has been obtained,
 #' and the computed variables are determined by these stats.
+#' Contours are calculated for one of the three types of density estimates
+#' obtained before contouring, `density`, `ndensity`, and `count`. Which
+#' of those should be used is determined by the `contour_var` parameter.
 stat_density_2d <- function(mapping = NULL, data = NULL,
                             geom = "density_2d", position = "identity",
                             ...,
                             contour = TRUE,
-                            contour_type = "lines",
                             contour_var = "density",
                             n = 100,
                             h = NULL,
                             adjust = c(1, 1),
                             na.rm = FALSE,
                             show.legend = NA,
                             inherit.aes = TRUE) {
-  if (isTRUE(contour_type == "bands")) {
-    stat <- StatDensity2dFilled
-  } else {
-    stat <- StatDensity2d
-  }
-
   layer(
     data = data,
     mapping = mapping,
-    stat = stat,
+    stat = StatDensity2d,
     geom = geom,
     position = position,
     show.legend = show.legend,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
       contour = contour,
-      contour_type = contour_type,
       contour_var = contour_var,
       n = n,
       h = h,
@@ -70,11 +62,50 @@ stat_density_2d <- function(mapping = NULL, data = NULL,
   )
 }
 
-#' @export
 #' @rdname geom_density_2d
 #' @usage NULL
+#' @export
 stat_density2d <- stat_density_2d
 
+#' @rdname geom_density_2d
+#' @export
+stat_density_2d_filled <- function(mapping = NULL, data = NULL,
+                                   geom = "density_2d_filled", position = "identity",
+                                   ...,
+                                   contour = TRUE,
+                                   contour_var = "density",
+                                   n = 100,
+                                   h = NULL,
+                                   adjust = c(1, 1),
+                                   na.rm = FALSE,
+                                   show.legend = NA,
+                                   inherit.aes = TRUE) {
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = StatDensity2dFilled,
+    geom = geom,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list(
+      na.rm = na.rm,
+      contour = contour,
+      contour_var = contour_var,
+      n = n,
+      h = h,
+      adjust = adjust,
+      ...
+    )
+  )
+}
+
+#' @rdname geom_density_2d
+#' @usage NULL
+#' @export
+stat_density2d_filled <- stat_density_2d_filled
+
+
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL
@@ -85,24 +116,20 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
   required_aes = c("x", "y"),
 
   extra_params = c(
-    "na.rm", "contour", "contour_type", "contour_var",
+    "na.rm", "contour", "contour_var",
     "bins", "binwidth", "breaks"
   ),
 
+  # stat used for contouring
+  contour_stat = StatContour,
+
   compute_layer = function(self, data, params, layout) {
     # first run the regular layer calculation to infer densities
     data <- ggproto_parent(Stat, self)$compute_layer(data, params, layout)
 
     # if we're not contouring we're done
     if (!isTRUE(params$contour)) return(data)
 
-    # otherwise, simulate last part compute_layer() in StatContour or StatContourFilled
-    if (isTRUE(params$contour_type == "bands")) {
-      cont_stat <- StatContourFilled
-    } else {
-      cont_stat <- StatContour
-    }
-
     # set up data and parameters for contouring
     contour_var <- params$contour_var %||% "density"
     if (!isTRUE(contour_var %in% c("density", "ndensity", "count"))) {
@@ -119,7 +146,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
     args <- c(list(data = quote(data), scales = quote(scales)), params)
     dapply(data, "PANEL", function(data) {
       scales <- layout$get_scales(data$PANEL[1])
-      tryCatch(do.call(cont_stat$compute_panel, args), error = function(e) {
+      tryCatch(do.call(self$contour_stat$compute_panel, args), error = function(e) {
         warn(glue("Computation failed in `{snake_class(self)}()`:\n{e$message}"))
         new_data_frame()
       })
@@ -153,11 +180,15 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
   }
 )
 
+
+
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL
 #' @export
 StatDensity2dFilled <- ggproto("StatDensity2dFilled", StatDensity2d,
-  default_aes = aes(colour = NA, fill = after_stat(level))
+  default_aes = aes(colour = NA, fill = after_stat(level)),
+
+  contour_stat = StatContourFilled
 )
 

man/geom_density_2d.Rd

@@ -20,7 +20,7 @@ test_that("stat_density2d can produce contour and raster data", {
   p <- ggplot(faithful, aes(x = eruptions, y = waiting))
 
   p_contour_lines <- p + stat_density_2d()
-  p_contour_bands <- p + stat_density_2d(contour_type = "bands")
+  p_contour_bands <- p + stat_density_2d_filled()
   p_raster <- p + stat_density_2d(contour = FALSE)
 
   d_lines <- layer_data(p_contour_lines)
@@ -40,6 +40,16 @@ test_that("stat_density2d can produce contour and raster data", {
   expect_true(unique(d_raster$level) == 1)
   expect_true(unique(d_raster$piece) == 1)
 
+  # stat_density_2d() and stat_density_2d_filled() produce identical
+  # density output with `contour = FALSE`
+  # (`fill` and `colour` will differ due to different default aesthetic mappings)
+  d_raster2 <- layer_data(p + stat_density_2d_filled(contour = FALSE))
+  expect_identical(d_raster$x, d_raster2$x)
+  expect_identical(d_raster$y, d_raster2$y)
+  expect_identical(d_raster$density, d_raster2$density)
+  expect_identical(d_raster$ndensity, d_raster2$ndensity)
+  expect_identical(d_raster$count, d_raster2$count)
+
   # stat_density_2d() with contouring is the same as stat_contour() on calculated density
   p_lines2 <- ggplot(d_raster, aes(x, y, z = density)) + stat_contour()
   d_lines2 <- layer_data(p_lines2)