Make bin_hex and summary_hex consistent.

Fixes #1383

Author: hadley

DESCRIPTION

@@ -135,6 +135,7 @@ Collate:
     'guides-.r'
     'guides-axis.r'
     'guides-grid.r'
+    'hexbin.R'
     'labels.r'
     'layer.r'
     'limits.r'

NEWS.md

@@ -1,5 +1,10 @@
 # ggplot2 2.0.0.9000
 
+* `stat_bin_hex()` and `stat_bin_summary()` now use the same underlying 
+  algorithm so results are consistent (#1383). `stat_bin_hex()` now accepts
+  a `weight` aesthetic. To be consistent, the output variable from
+  `stat_bin_hex()` is now value instead of count.
+
 * `facet_wrap()` correctly swaps `nrow` and `ncol` for facetting vertically
   (#1417).
 

R/hexbin.R

@@ -0,0 +1,38 @@
+hex_binwidth <- function(bins = 30, scales) {
+  c(
+    diff(scales$x$dimension()) / bins,
+    diff(scales$y$dimension()) / bins
+  )
+}
+
+hex_bounds <- function(x, binwidth) {
+  c(
+    plyr::round_any(min(x), binwidth, floor) - 1e-6,
+    plyr::round_any(max(x), binwidth, ceiling) + 1e-6
+  )
+}
+
+hexBinSummarise <- function(x, y, z, binwidth, fun = mean, fun.args = list(), drop = TRUE) {
+  # Convert binwidths into bounds + nbins
+  xbnds <- hex_bounds(x, binwidth[1])
+  xbins <- diff(xbnds) / binwidth[1]
+
+  ybnds <- hex_bounds(y, binwidth[2])
+  ybins <- diff(ybnds) / binwidth[2]
+
+  # Call hexbin
+  hb <- hexbin::hexbin(
+    x, xbnds = xbnds, xbins = xbins,
+    y, ybnds = ybnds, shape = ybins / xbins,
+    IDs = TRUE
+  )
+
+  value <- do.call(tapply, c(list(quote(z), quote(hb@cID), quote(fun)), fun.args))
+
+  # Convert to data frame
+  out <- as.data.frame(hexbin::hcell2xy(hb))
+  out$value <- as.vector(value)
+
+  if (drop) out <- stats::na.omit(out)
+  out
+}

R/stat-binhex.r

@@ -36,54 +36,17 @@ stat_binhex <- stat_bin_hex
 #' @usage NULL
 #' @export
 StatBinhex <- ggproto("StatBinhex", Stat,
-  default_aes = aes(fill = ..count..),
+  default_aes = aes(fill = ..value..),
 
   required_aes = c("x", "y"),
 
   compute_group = function(data, scales, binwidth = NULL, bins = 30,
                            na.rm = FALSE) {
-    if (is.null(binwidth)) {
-      binwidth <- c(
-        diff(scales$x$dimension()) / bins,
-        diff(scales$y$dimension()) / bins
-      )
-    }
+    try_require("hexbin", "stat_binhex")
 
-    hexBin(data$x, data$y, binwidth)
+    binwidth <- binwidth %||% hex_binwidth(bins, scales)
+    wt <- data$weight %||% rep(1L, nrow(data))
+    hexBinSummarise(data$x, data$y, wt, binwidth, sum)
   }
 )
 
-# Bin 2d plane into hexagons
-# Wrapper around \code{\link[hexbin]{hcell2xy}} that returns a data frame
-#
-# @param x positions
-# @param y positions
-# @param numeric vector of length 2 giving binwidth in x and y directions
-# @keyword internal
-hexBin <- function(x, y, binwidth) {
-  # Convert binwidths into bounds + nbins
-  xbnds <- c(
-    plyr::round_any(min(x), binwidth[1], floor) - 1e-6,
-    plyr::round_any(max(x), binwidth[1], ceiling) + 1e-6
-  )
-  xbins <- diff(xbnds) / binwidth[1]
-
-  ybnds <- c(
-    plyr::round_any(min(y), binwidth[2], floor) - 1e-6,
-    plyr::round_any(max(y), binwidth[2], ceiling) + 1e-6
-  )
-  ybins <- diff(ybnds) / binwidth[2]
-
-  # Call hexbin
-  hb <- hexbin::hexbin(
-    x, xbnds = xbnds, xbins = xbins,
-    y, ybnds = ybnds, shape = ybins / xbins
-  )
-
-  # Convert to data frame
-  data.frame(
-    hexbin::hcell2xy(hb),
-    count = hb@count,
-    density = hb@count / sum(hb@count, na.rm = TRUE)
-  )
-}

R/stat-summary-2d.r

@@ -12,7 +12,11 @@
 #'  \item \code{y}: vertical position
 #'  \item \code{z}: value passed to the summary function
 #' }
-#'
+#' @section Computed variables:
+#' \describe{
+#'   \item{x,y}{Location}
+#'   \item{value}{Value of summary statistic.}
+#' }
 #' @seealso \code{\link{stat_summary_hex}} for hexagonal summarization.
 #'   \code{\link{stat_bin2d}} for the binning options.
 #' @inheritParams layer

R/stat-summary-hex.r

@@ -43,41 +43,10 @@ StatSummaryHex <- ggproto("StatSummaryHex", Stat,
 
   compute_group = function(data, scales, binwidth = NULL, bins = 30, drop = TRUE,
                            fun = "mean", fun.args = list()) {
-    if (is.null(binwidth)) {
-      binwidth <- c(
-        diff(scales$x$dimension()) / bins,
-        diff(scales$y$dimension()) / bins
-      )
-    }
+    try_require("hexbin", "stat_summary_hex")
 
-    # Convert binwidths into bounds + nbins
-    x <- data$x
-    y <- data$y
-
-    xbnds <- c(
-      plyr::round_any(min(x), binwidth[1], floor) - 1e-6,
-      plyr::round_any(max(x), binwidth[1], ceiling) + 1e-6
-    )
-    xbins <- diff(xbnds) / binwidth[1]
-
-    ybnds <- c(
-      plyr::round_any(min(y), binwidth[1], floor) - 1e-6,
-      plyr::round_any(max(y), binwidth[2], ceiling) + 1e-6
-    )
-    ybins <- diff(ybnds) / binwidth[2]
-
-    # Call hexbin
-    hb <- hexbin::hexbin(
-      x, xbnds = xbnds, xbins = xbins,
-      y, ybnds = ybnds, shape = ybins / xbins,
-      IDs = TRUE
-    )
-
-    value <- do.call(tapply, c(list(quote(data$z), quote(hb@cID), quote(fun)), fun.args))
-
-    # Convert to data frame
-    ret <- data.frame(hexbin::hcell2xy(hb), value)
-    if (drop) ret <- stats::na.omit(ret)
-    ret
+    binwidth <- binwidth %||% hex_binwidth(bins, scales)
+    hexBinSummarise(data$x, data$y, data$z, binwidth,
+      fun = fun, fun.args = fun.args, drop = drop)
   }
 )