geom_ function for ggplot2 to create a hexagonal map

geom_simpler_hex.R

hexGrob <- function(x, y, size = rep(1, length(x)), gp = gpar()) {
  stopifnot(length(y) == length(x))
  n <- length(x)
  dx <- resolution(x, FALSE)
  dy <- resolution(y, FALSE)
  if(dx == 1) dx <- dy
  if(dy == 1) dy <- dx
  dratio <- dy/dx
  grid::polygonGrob(rep.int(cos(pi/2 + pi/3 * 0:5)*dx/sqrt(3), n) + 
                      rep(x + y/2/dratio, each = 6),
                    rep.int(sin(pi/2 + pi/3 * 0:5)*dy/sqrt(3), n) +
                      rep(sqrt(3)*y/2, each = 6),
                    id.lengths = rep(6, n),
                    gp=gp)
}


GeomSimplerHex <- ggproto("GeomSimperHex", Geom,
                          required_aes = c("x", "y"),
                          
                          default_aes = aes(
                            colour = "black", fill = "gray", size = 0.5,
                            linetype = 1, alpha = 1
                          ),
                          
                          draw_key = draw_key_polygon,
                          
                          draw_panel = function(data, panel_params, coord) {
                            coords <- coord$transform(data, panel_params)
                            hexGrob(
                              coords$x, coords$y, 
                              gp = grid::gpar(
                                col = coords$colour,
                                fill = alpha(coords$fill, coords$alpha),
                                lwd = coords$size * .pt,
                                lty = coords$linetype
                              )
                            )
                          }
)
geom_simpler_hex <- function(mapping = NULL, data = NULL, stat = "identity",
                             position = "identity", na.rm = FALSE, show.legend = NA, 
                             inherit.aes = TRUE, ...) {
  layer(
    geom = GeomSimplerHex, mapping = mapping, data = data, stat = stat, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

sample_hex_map.R

ex1 <- data.frame(X = c(-1L,  0L, 0L, 1L, 1L, 2L, 2L, 2L),
                  Y = c(-1L, -1L, 0L, 1L, 2L, 1L, 2L, 3L))
ggplot(ex1, aes(X, Y)) +   geom_simpler_hex() + 
  coord_cartesian(xlim=c(-1, 6), ylim=c(-3, 4)) 

sample_hex_map_result.png