Scaled densities/counts in 2d density/bins plots (#2679)

NEWS.md

@@ -1,5 +1,11 @@
 # ggplot2 3.0.0.9000
 
+*   `stat_contour()`, `stat_density2d()`, `stat_bin2d()`,  `stat_binhex()`
+    now calculate normalized statistics including `nlevel`, `ndensity`, and
+    `ncount`. Also, `stat_density()` now includes the calculated statistic 
+    `nlevel`, an aliasfor `scaled`, to better match the syntax of `stat_bin()`
+    (@bjreisman, #2679).
+
 *  `geom_hex()` now understands the `size` and `linetype` aesthetics
    (@mikmart, #2488).
 

R/geom-density2d.r

@@ -30,6 +30,15 @@
 #' # set of contours for each value of that variable
 #' d + geom_density_2d(aes(colour = cut))
 #'
+#' # Similarly, if you apply faceting to the plot, contours will be
+#' # drawn for each facet, but the levels will calculated across all facets
+#' d + stat_density_2d(aes(fill = stat(level)), geom = "polygon") +
+#'   facet_grid(. ~ cut) + scale_fill_viridis_c()
+#' # To override this behavior (for instace, to better visualize the density
+#' # within each facet), use stat(nlevel)
+#' d + stat_density_2d(aes(fill = stat(nlevel)), geom = "polygon") +
+#'   facet_grid(. ~ cut) + scale_fill_viridis_c()
+#'
 #' # If we turn contouring off, we can use use geoms like tiles:
 #' d + stat_density_2d(geom = "raster", aes(fill = stat(density)), contour = FALSE)
 #' # Or points:

R/stat-bin2d.r

@@ -5,6 +5,13 @@
 #' @param drop if `TRUE` removes all cells with 0 counts.
 #' @export
 #' @rdname geom_bin2d
+#' @section Computed variables:
+#' \describe{
+#'   \item{count}{number of points in bin}
+#'   \item{density}{density of points in bin, scaled to integrate to 1}
+#'   \item{ncount}{count, scaled to maximum of 1}
+#'   \item{ndensity}{density, scaled to maximum of 1}
+#' }
 stat_bin_2d <- function(mapping = NULL, data = NULL,
                         geom = "tile", position = "identity",
                         ...,
@@ -74,7 +81,9 @@ StatBin2d <- ggproto("StatBin2d", Stat,
     out$height <- ydim$length
 
     out$count <- out$value
+    out$ncount <- out$count / max(out$count, na.rm = TRUE)
     out$density <- out$count / sum(out$count, na.rm = TRUE)
+    out$ndensity <- out$density / max(out$density, na.rm = TRUE)
     out
   }
 )

R/stat-binhex.r

@@ -1,6 +1,13 @@
 #' @export
 #' @rdname geom_hex
 #' @inheritParams stat_bin_2d
+#' @section Computed variables:
+#' \describe{
+#'   \item{count}{number of points in bin}
+#'   \item{density}{density of points in bin, scaled to integrate to 1}
+#'   \item{ncount}{count, scaled to maximum of 1}
+#'   \item{ndensity}{density, scaled to maximum of 1}
+#' }
 stat_bin_hex <- function(mapping = NULL, data = NULL,
                          geom = "hex", position = "identity",
                          ...,
@@ -48,7 +55,9 @@ StatBinhex <- ggproto("StatBinhex", Stat,
     wt <- data$weight %||% rep(1L, nrow(data))
     out <- hexBinSummarise(data$x, data$y, wt, binwidth, sum)
     out$density <- as.vector(out$value / sum(out$value, na.rm = TRUE))
+    out$ndensity <- out$density / max(out$density, na.rm = TRUE)
     out$count <- out$value
+    out$ncount <- out$count / max(out$count, na.rm = TRUE)
     out$value <- NULL
 
     out

R/stat-contour.r

@@ -3,6 +3,8 @@
 #' @section Computed variables:
 #' \describe{
 #'  \item{level}{height of contour}
+#'  \item{nlevel}{height of contour, scaled to maximum of 1}
+#'  \item{piece}{contour piece (an integer)}
 #' }
 #' @rdname geom_contour
 stat_contour <- function(mapping = NULL, data = NULL,
@@ -91,6 +93,7 @@ contour_lines <- function(data, breaks, complete = FALSE) {
 
   data.frame(
     level = rep(levels, lengths),
+    nlevel = rep(levels, lengths) / max(rep(levels, lengths), na.rm = TRUE),
     x = xs,
     y = ys,
     piece = pieces,

R/stat-density-2d.r

@@ -7,6 +7,12 @@
 #'   using [MASS::bandwidth.nrd()].
 #' @section Computed variables:
 #' Same as [stat_contour()]
+#'
+#' With the addition of:
+#' \describe{
+#'   \item{density}{the density estimate}
+#'   \item{ndensity}{density estimate, scaled to maximum of 1}
+#' }
 stat_density_2d <- function(mapping = NULL, data = NULL,
                             geom = "density_2d", position = "identity",
                             ...,
@@ -63,9 +69,10 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
     df$group <- data$group[1]
 
     if (contour) {
-      StatContour$compute_panel(df, scales, bins, binwidth)
+        StatContour$compute_panel(df, scales, bins, binwidth)
     } else {
       names(df) <- c("x", "y", "density", "group")
+      df$ndensity <- df$density / max(df$density, na.rm = TRUE)
       df$level <- 1
       df$piece <- 1
       df

R/stat-density.r

@@ -21,6 +21,8 @@
 #'   \item{count}{density * number of points - useful for stacked density
 #'      plots}
 #'   \item{scaled}{density estimate, scaled to maximum of 1}
+#'   \item{ndensity}{alias for `scaled`, to mirror the syntax of
+#'    [`stat_bin()`]}
 #' }
 #' @export
 #' @rdname geom_density
@@ -92,6 +94,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1,
       x = NA_real_,
       density = NA_real_,
       scaled = NA_real_,
+      ndensity = NA_real_,
       count = NA_real_,
       n = NA_integer_
     ))
@@ -104,6 +107,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1,
     x = dens$x,
     density = dens$y,
     scaled =  dens$y / max(dens$y, na.rm = TRUE),
+    ndensity = dens$y / max(dens$y, na.rm = TRUE),
     count =   dens$y * nx,
     n = nx
   )

tests/testthat/test-stat-density.R

@@ -9,6 +9,6 @@ test_that("compute_density returns useful df and throws warning when <2 values",
   expect_warning(dens <- compute_density(1, NULL, from = 0, to = 0))
 
   expect_equal(nrow(dens), 1)
-  expect_equal(names(dens), c("x", "density", "scaled", "count", "n"))
+  expect_equal(names(dens), c("x", "density", "scaled", "ndensity", "count", "n"))
   expect_type(dens$x, "double")
 })