1#' Hexagonal heatmap of 2d bin counts
2#'
3#' Divides the plane into regular hexagons, counts the number of cases in
4#' each hexagon, and then (by default) maps the number of cases to the hexagon
5#' fill.  Hexagon bins avoid the visual artefacts sometimes generated by
6#' the very regular alignment of [geom_bin2d()].
7#'
8#' @eval rd_aesthetics("geom", "hex")
9#' @seealso [stat_bin2d()] for rectangular binning
10#' @param geom,stat Override the default connection between `geom_hex()` and
11#'   `stat_binhex()`.
12#' @export
13#' @inheritParams layer
14#' @inheritParams geom_point
15#' @export
16#' @examples
17#' d <- ggplot(diamonds, aes(carat, price))
18#' d + geom_hex()
19#'
20#' \donttest{
21#' # You can control the size of the bins by specifying the number of
22#' # bins in each direction:
23#' d + geom_hex(bins = 10)
24#' d + geom_hex(bins = 30)
25#'
26#' # Or by specifying the width of the bins
27#' d + geom_hex(binwidth = c(1, 1000))
28#' d + geom_hex(binwidth = c(.1, 500))
29#' }
30geom_hex <- function(mapping = NULL, data = NULL,
31                     stat = "binhex", position = "identity",
32                     ...,
33                     na.rm = FALSE,
34                     show.legend = NA,
35                     inherit.aes = TRUE) {
36  layer(
37    data = data,
38    mapping = mapping,
39    stat = stat,
40    geom = GeomHex,
41    position = position,
42    show.legend = show.legend,
43    inherit.aes = inherit.aes,
44    params = list(
45      na.rm = na.rm,
46      ...
47    )
48  )
49}
50
51
52#' @rdname ggplot2-ggproto
53#' @format NULL
54#' @usage NULL
55#' @export
56GeomHex <- ggproto("GeomHex", Geom,
57  draw_group = function(data, panel_params, coord) {
58    if (!inherits(coord, "CoordCartesian")) {
59      abort("geom_hex() only works with Cartesian coordinates")
60    }
61
62    coords <- coord$transform(data, panel_params)
63    ggname("geom_hex", hexGrob(
64      coords$x, coords$y,
65      gp = gpar(
66        col = coords$colour,
67        fill = alpha(coords$fill, coords$alpha),
68        lwd = coords$size * .pt,
69        lty = coords$linetype
70      )
71    ))
72  },
73
74  required_aes = c("x", "y"),
75
76  default_aes = aes(
77    colour = NA,
78    fill = "grey50",
79    size = 0.5,
80    linetype = 1,
81    alpha = NA
82  ),
83
84  draw_key = draw_key_polygon
85)
86
87
88# Draw hexagon grob
89# Modified from code by Nicholas Lewin-Koh and Martin Maechler
90#
91# @param x positions of hex centres
92# @param y positions
93# @param size vector of hex sizes
94# @param gp graphical parameters
95# @keyword internal
96hexGrob <- function(x, y, size = rep(1, length(x)), gp = gpar()) {
97  if (length(y) != length(x)) abort("`x` and `y` must have the same length")
98
99  dx <- resolution(x, FALSE)
100  dy <- resolution(y, FALSE) / sqrt(3) / 2 * 1.15
101
102  hexC <- hexbin::hexcoords(dx, dy, n = 1)
103
104  n <- length(x)
105
106  polygonGrob(
107    x = rep.int(hexC$x, n) * rep(size, each = 6) + rep(x, each = 6),
108    y = rep.int(hexC$y, n) * rep(size, each = 6) + rep(y, each = 6),
109    default.units = "native",
110    id.lengths = rep(6, n), gp = gp
111  )
112}
113