1hex_binwidth <- function(bins = 30, scales) {
2  c(
3    diff(scales$x$dimension()) / bins,
4    diff(scales$y$dimension()) / bins
5  )
6}
7
8hex_bounds <- function(x, binwidth) {
9  c(
10    round_any(min(x), binwidth, floor) - 1e-6,
11    round_any(max(x), binwidth, ceiling) + 1e-6
12  )
13}
14
15hexBinSummarise <- function(x, y, z, binwidth, fun = mean, fun.args = list(), drop = TRUE) {
16  if (length(binwidth) == 1) {
17    binwidth <- rep(binwidth, 2)
18  }
19
20  # Convert binwidths into bounds + nbins
21  xbnds <- hex_bounds(x, binwidth[1])
22  xbins <- diff(xbnds) / binwidth[1]
23
24  ybnds <- hex_bounds(y, binwidth[2])
25  ybins <- diff(ybnds) / binwidth[2]
26
27  # Call hexbin
28  hb <- hexbin::hexbin(
29    x, xbnds = xbnds, xbins = xbins,
30    y, ybnds = ybnds, shape = ybins / xbins,
31    IDs = TRUE
32  )
33
34  value <- do.call(tapply, c(list(quote(z), quote(hb@cID), quote(fun)), fun.args))
35
36  # Convert to data frame
37  out <- new_data_frame(hexbin::hcell2xy(hb))
38  out$value <- as.vector(value)
39
40  if (drop) out <- stats::na.omit(out)
41  out
42}
43