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