diff --git a/NEWS.md b/NEWS.md index 708ec55d62..61372a1a25 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* `geom_hex()` will now use the binwidth from `stat_bin_hex()` if present, + instead of deriving it (@thomasp85, #4580) + +* `geom_hex()` now works on non-linear coordinate systems (@thomasp85) + * Fixed a bug throwing errors when trying to render an empty plot with secondary axes (@thomasp85, #4509) diff --git a/R/geom-hex.r b/R/geom-hex.r index 2e18b221e9..e28e1cbe74 100644 --- a/R/geom-hex.r +++ b/R/geom-hex.r @@ -56,12 +56,36 @@ geom_hex <- function(mapping = NULL, data = NULL, GeomHex <- ggproto("GeomHex", Geom, draw_group = function(data, panel_params, coord, lineend = "butt", linejoin = "mitre", linemitre = 10) { - if (!inherits(coord, "CoordCartesian")) { - abort("geom_hex() only works with Cartesian coordinates") + if (empty(data)) { + return(zeroGrob()) } + # Get hex sizes + if (!is.null(data$width)) { + dx <- data$width[1] / 2 + } else { + dx <- resolution(data$x, FALSE) + } + # Adjust for difference in width and height of regular hexagon. 1.15 adjusts + # for the effect of the overlapping range in y-direction on the resolution + # calculation + if (!is.null(data$height)) { + dy <- data$height[1] / sqrt(3) / 2 + } else { + dy <- resolution(data$y, FALSE) / sqrt(3) / 2 * 1.15 + } + + hexC <- hexbin::hexcoords(dx, dy, n = 1) + + n <- nrow(data) + + data <- data[rep(seq_len(n), each = 6), ] + data$x <- rep.int(hexC$x, n) + data$x + data$y <- rep.int(hexC$y, n) + data$y + coords <- coord$transform(data, panel_params) - ggname("geom_hex", hexGrob( + + ggname("geom_hex", polygonGrob( coords$x, coords$y, gp = gpar( col = coords$colour, @@ -71,7 +95,9 @@ GeomHex <- ggproto("GeomHex", Geom, lineend = lineend, linejoin = linejoin, linemitre = linemitre - ) + ), + default.units = "native", + id.lengths = rep.int(6, n) )) }, @@ -97,6 +123,8 @@ GeomHex <- ggproto("GeomHex", Geom, # @param size vector of hex sizes # @param gp graphical parameters # @keyword internal +# +# THIS IS NO LONGER USED BUT LEFT IF CODE SOMEWHERE ELSE RELIES ON IT hexGrob <- function(x, y, size = rep(1, length(x)), gp = gpar()) { if (length(y) != length(x)) abort("`x` and `y` must have the same length") diff --git a/R/hexbin.R b/R/hexbin.R index 6d6e38e5fd..296f8f2cce 100644 --- a/R/hexbin.R +++ b/R/hexbin.R @@ -36,6 +36,8 @@ hexBinSummarise <- function(x, y, z, binwidth, fun = mean, fun.args = list(), dr # Convert to data frame out <- new_data_frame(hexbin::hcell2xy(hb)) out$value <- as.vector(value) + out$width <- binwidth[1] + out$height <- binwidth[2] if (drop) out <- stats::na.omit(out) out diff --git a/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg b/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg new file mode 100644 index 0000000000..34bc427bd8 --- /dev/null +++ b/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg @@ -0,0 +1,183 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2 +3 +4 +5 +6 + + + +20 +30 +40 + + + +displ +hwy + + +2.5 +5.0 +7.5 +10.0 +count + + + + + + + + +hex bin plot in polar coordinates + + diff --git a/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg b/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg new file mode 100644 index 0000000000..82486696e1 --- /dev/null +++ b/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg @@ -0,0 +1,181 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +20 +30 +40 + + + + + + + + + +2 +3 +4 +5 +6 +7 +displ +hwy + + +2.5 +5.0 +7.5 +10.0 +count + + + + + + + + +hex bin plot with sqrt-transformed y + + diff --git a/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg new file mode 100644 index 0000000000..ec51b6ab15 --- /dev/null +++ b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 + + + + + + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +x +y + + +1 +count + + +single hex bin with width and height of 0.1 + + diff --git a/tests/testthat/test-geom-hex.R b/tests/testthat/test-geom-hex.R index 3cffeb8a66..82465e2183 100644 --- a/tests/testthat/test-geom-hex.R +++ b/tests/testthat/test-geom-hex.R @@ -15,6 +15,25 @@ test_that("size and linetype are applied", { geom_hex(color = "red", size = 4, linetype = 2) gpar <- layer_grob(plot)[[1]]$children[[1]]$gp - expect_equal(gpar$lwd, c(4, 4) * .pt, tolerance = 1e-7) - expect_equal(gpar$lty, c(2, 2), tolerance = 1e-7) + expect_equal(gpar$lwd, rep(4, 12) * .pt, tolerance = 1e-7) + expect_equal(gpar$lty, rep(2, 12), tolerance = 1e-7) +}) + +test_that("bin size are picked up from stat", { + expect_doppelganger("single hex bin with width and height of 0.1", + ggplot(data.frame(x = 0, y = 0)) + + geom_hex(aes(x = x, y = y), binwidth = c(0.1, 0.1)) + + coord_cartesian(xlim = c(-1, 1), ylim = c(-1, 1)) + ) +}) + +test_that("geom_hex works in non-linear coordinate systems", { + p <- ggplot(mpg, aes(displ, hwy)) + geom_hex() + + expect_doppelganger("hex bin plot with sqrt-transformed y", + p + coord_trans(y = "sqrt") + ) + expect_doppelganger("hex bin plot in polar coordinates", + p + coord_polar() + ) })