1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#' @export
#' @rdname stat_summary_2d
#' @inheritParams stat_bin_hex
stat_summary_hex <- function(mapping = NULL, data = NULL,
geom = "hex", position = "identity",
...,
bins = 30,
binwidth = NULL,
drop = TRUE,
fun = "mean",
fun.args = list(),
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = StatSummaryHex,
geom = geom,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list2(
bins = bins,
binwidth = binwidth,
drop = drop,
fun = fun,
fun.args = fun.args,
na.rm = na.rm,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
StatSummaryHex <- ggproto("StatSummaryHex", Stat,
default_aes = aes(fill = after_stat(value)),
required_aes = c("x", "y", "z"),
dropped_aes = "z", # z gets dropped during statistical transformation
compute_group = function(data, scales, binwidth = NULL, bins = 30, drop = TRUE,
fun = "mean", fun.args = list()) {
check_installed("hexbin", reason = "for `stat_summary_hex()`.")
binwidth <- binwidth %||% hex_binwidth(bins, scales)
fun <- as_function(fun)
hexBinSummarise(data$x, data$y, data$z, binwidth,
fun = fun, fun.args = fun.args, drop = drop)
}
)
|
