1#' @export 2#' @rdname geom_hex 3#' @inheritParams stat_bin_2d 4#' @section Computed variables: 5#' \describe{ 6#' \item{count}{number of points in bin} 7#' \item{density}{density of points in bin, scaled to integrate to 1} 8#' \item{ncount}{count, scaled to maximum of 1} 9#' \item{ndensity}{density, scaled to maximum of 1} 10#' } 11stat_bin_hex <- function(mapping = NULL, data = NULL, 12 geom = "hex", position = "identity", 13 ..., 14 bins = 30, 15 binwidth = NULL, 16 na.rm = FALSE, 17 show.legend = NA, 18 inherit.aes = TRUE) { 19 layer( 20 data = data, 21 mapping = mapping, 22 stat = StatBinhex, 23 geom = geom, 24 position = position, 25 show.legend = show.legend, 26 inherit.aes = inherit.aes, 27 params = list( 28 bins = bins, 29 binwidth = binwidth, 30 na.rm = na.rm, 31 ... 32 ) 33 ) 34} 35 36#' @export 37#' @rdname geom_hex 38#' @usage NULL 39stat_binhex <- stat_bin_hex 40 41#' @rdname ggplot2-ggproto 42#' @format NULL 43#' @usage NULL 44#' @export 45StatBinhex <- ggproto("StatBinhex", Stat, 46 default_aes = aes(weight = 1, fill = after_stat(count)), 47 48 required_aes = c("x", "y"), 49 50 compute_group = function(data, scales, binwidth = NULL, bins = 30, 51 na.rm = FALSE) { 52 check_installed("hexbin", reason = "for `stat_binhex()`") 53 54 binwidth <- binwidth %||% hex_binwidth(bins, scales) 55 wt <- data$weight %||% rep(1L, nrow(data)) 56 out <- hexBinSummarise(data$x, data$y, wt, binwidth, sum) 57 out$density <- as.vector(out$value / sum(out$value, na.rm = TRUE)) 58 out$ndensity <- out$density / max(out$density, na.rm = TRUE) 59 out$count <- out$value 60 out$ncount <- out$count / max(out$count, na.rm = TRUE) 61 out$value <- NULL 62 63 out 64 } 65) 66 67