Playing nice with facet_wrap

[davidaknowles]

Large points are distorted when using facet_wrap, e.g.

N=100
data.frame(x=runif(N), y=runif(N), d=runif(N) %>%
             cut(seq(0,1,by=1/3))) %>% 
             ggplot(aes(x,y)) + geom_point_rast(size=10) + facet_wrap(~d)

gives

whereas using geom_point you get

[VPetukhov]

It's because ggrastr by default scales images to the size of the whole panel, but not of the current plot. I didn't find the way to get the later one. I admit that it's quite annoying, and if you have a suggestions, I'd be extremely happy to implement them. In the meantime, you can adjust the size by hands with parameters width and height (see example).

[davidaknowles]

Yeah I guessed it was something like that. Good to know about the hand-adjusting option! Sadly I don't know enough about ggplot internals to be much help.

[teunbrand]

You can get the exact dimensions of the panel only once the actual drawing process has been initiated. Before that, the draw_panel method builds the gtable entry for the layer, which can still be resized. Once the entire gtable is being rendered, the dimensions become known, and the gtable is rendered again when dimensions change whenever the plot window is being resized.

To dynamically get the dimensions of a layer, one could implement a makeContext.mygrob() method that can convert relative sizes (e.g. npcs) to absolute sizes (cm, inches).

Example below, note that the user doesn't have to provide dimensions, only desired dpi.

library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.0.2
library(grid)
library(magrittr)

geom_point_rast <- function(mapping = NULL,
                            data = NULL,
                            stat = "identity",
                            position = "identity",
                            ...,
                            na.rm = FALSE,
                            show.legend = NA,
                            inherit.aes = TRUE,
                            raster.dpi=300) {
  ggplot2::layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomPointRast,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm,
                  raster.dpi=raster.dpi,
                  ...)
  )
}

GeomPointRast <- ggplot2::ggproto(
  "GeomPointRast",
  ggplot2::GeomPoint,
  draw_panel = function(self, data, panel_params, coord, na.rm = FALSE,
                        raster.dpi) {
    grob <- ggproto_parent(GeomPoint, self)$draw_panel(
      data, panel_params, coord, na.rm = na.rm
    )
    class(grob) <- c("rasterpoint", class(grob))
    grob$dpi <- raster.dpi
    grob
  }
)

makeContext.rasterpoint <- function(x) {
  vp <- if (is.null(x$vp)) viewport() else x$vp
  
  width <- grid::convertWidth(unit(1, "npc"), "inch", valueOnly = TRUE)
  height <- grid::convertHeight(unit(1, "npc"), "inch", valueOnly = TRUE)
  
  dev_cur <- dev.cur()
  dev_id <- Cairo::Cairo(type = 'raster',
                         width = width * x$dpi , height = height * x$dpi,
                         units = "px",
                         dpi = x$dpi, bg = "transparent")[1]
  grid::pushViewport(vp)
  grid::grid.points(x = x$x, y = x$y, pch = x$pch, size = x$size,
                    name = x$name, gp = x$gp, vp = x$vp, draw = TRUE)
  grid::popViewport()
  cap <- grid::grid.cap()
  dev.off(dev_id)
  dev.set(dev_cur)
  
  grid::rasterGrob(
    cap, x = 0, y = 0, height = 1, default.units = "native",
    just = c("left", "bottom")
  )
}

N=100
df <- data.frame(x=runif(N), y=runif(N), d=runif(N) %>%
             cut(seq(0,1,by=1/3)))

ggplot(df, aes(x,y)) + geom_point_rast(size=10) + facet_wrap(~d)

ggplot(df, aes(x,y)) + geom_point(size=10) + facet_wrap(~d)

^{Created on 2020-07-05 by the reprex package (v0.3.0)}

[evanbiederstedt]

Thanks @teunbrand

The example is clear, thanks for this. Just to clarify, how would you use makeContext.rasterpoint in the snippet above?

[teunbrand]

You don't use it yourself. It's an S3 method for the makeContext generic, you just need to make sure that grid can see the function, so you'd have to @export if from the ggrastr namespace. The grid system calls makeContext on every grob before drawing the contents (see ?grid::makeContext). You can use it as a hook to make latest-minute modifications to grobs, including making dimension-dependent changes to the grob. Which is what I did above.

You can paste the code above into your R console and try it for yourself. Especially try resizing the plot window, you can see that the resolution remains stable and points don't get elongated/distorted.

Giving this another thought, you might probably be able to write a more-or-less general rasterise() function that can do this for any layer, not just points. This might be tricky to implement at first, but it would save you having to write a rasterised version of every geom you intend to support.

[evanbiederstedt]

You don't use it yourself. It's an S3 method for the makeContext generic, you just need to make sure that grid can see the function, so you'd have to @export if from the ggrastr namespace. The grid system calls makeContext on every grob before drawing the contents (see ?grid::makeContext). You can use it as a hook to make latest-minute modifications to grobs, including making dimension-dependent changes to the grob. Which is what I did above.

Thanks, I understand this a bit better after reading through the grid source code and the documentation for makeContext.

Giving this another thought, you might probably be able to write a more-or-less general rasterise() function that can do this for any layer, not just points. This might be tricky to implement at first, but it would save you having to write a rasterised version of every geom you intend to support.

Yes, we'll need to do this for every geom currently supported, e.g. you can see similar distortions here:

set.seed(12345)
library(ggplot2)
library(ggbeeswarm)
library(grid)
library(ggrastr)
library(magrittr)

N=100
df <- data.frame(x=runif(N), y=runif(N), d=runif(N) %>%
             cut(seq(0,1,by=1/3)))

ggplot(df, aes(x,y)) + geom_quasirandom(size=10) + facet_wrap(~d)

ggplot(df, aes(x,y)) + geom_quasirandom_rast(size=10) + facet_wrap(~d)


ggplot(df, aes(x,y)) + geom_beeswarm(size=10) + facet_wrap(~d)

ggplot(df, aes(x,y)) + geom_beeswarm_rast(size=10) + facet_wrap(~d)

We'll to write up a pull request.

[teunbrand]

I'm not meaning to sound grumpy, but that is not quite what I meant. I meant a function that is pretty much agnostic of what layer it gets, so it can be used in general for any layer. I made an example function here. It should rasterise most geoms/stats layers indiscriminately, and I added some ragg device options.

If you'd like I can draft a PR on these functions if you're okay with considering including it and reviewing the code.

[evanbiederstedt]

I'm not meaning to sound grumpy, but that is not quite what I meant. I meant a function that is pretty much agnostic of what layer it gets, so it can be used in general for any layer.

No problem, I think the miscommunication is due to me; I think I understood what you meant the first time. By "we'll need to do this for every geom currently supported", I mean we need to include this in the PR such that it works for the ggrastr package as a whole, not just GeomPointRast. I didn't mean create a specialized rasterise() function for each geom we support.

Anyways, sorry about that.

If you'd like I can draft a PR on these functions if you're okay with considering including it and reviewing the code.

Please do! PRs are welcome

[evanbiederstedt]

Should be resolved here: #19

Will version and release on master soon