Skip to content

Instantly share code, notes, and snippets.

@fnshr

fnshr/geom_simpler_hex.R

Last active Jul 22, 2018
Embed
What would you like to do?
geom_ function for ggplot2 to create a hexagonal map
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, ...)
)
}
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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment