rggplot2ggproto

replace magrittr operator pipe (%>%) with "+" in ggplot call


I am trying to modify this excellent answer which automatically labels ggplot objects so that it is more flexible and follows ggplot syntax (so uses +) so I can just add a call to the end of a ggplot call. Essentially I am trying to replace a magrittr operator pipe %>% with +.

library(tidyverse)
ir <- data.frame(sp = iris$Species, sep.len = iris$Sepal.Length,
                 sep.wid = iris$Sepal.Width, pet.len = iris$Petal.Length,
                 pet.wid = iris$Petal.Width)
my_labels <- c("sp" = "species", 
               "sep.len" = "sepal length", 
               "sep.wid" = "sepal width",
               "pet.len" = "petal length", 
               "pet.wid" = "petal width")

# function to automatically label ggplot object
add_ggplot_label <- function(my_ggplot, l) {
  my_ggplot$labels <- lapply(my_ggplot$labels, function(x) {
    as.character(l[x])
  })
  my_ggplot
}

p <- ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
  geom_point() 
p

# apply function via pipe magrittr operator which automates the labelling
p %>% 
  add_ggplot_label(., my_labels) 

enter image description here

This works well but it means I need to assign it to an object name first (i.e. p). So, for example, this doesn't work:

ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
  geom_point() %>% 
  add_ggplot_label(., my_labels)

I would need to remember to wrap it in brackets each time for this to work:

(ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
    geom_point()) %>% 
  add_ggplot_label(., my_labels)

Even still, its not exactly what I want. Ideally I want a more ggplot like workflow. Something like this, note + (not %>%):

ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
  geom_point() + 
  add_ggplot_label(my_labels)

Of course this doesn't work as + and %>% are not interchangeable in its current format. To use +, I think i would need to take a different approach and add a layer and access the names within the call:

# add a layer
labs_addition <- function() {
  list(labs(x = my_labels[.$labels$x],
            y = my_labels[.$labels$y],
            colour = my_labels[.$labels$colour]))
}
ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
  geom_point() +
  labs_addition()

This doesn't work and I am not sure if it is possible to reference what has been made previously upstream in the way I am attempting?

Any suggestions please?

thanks


Solution

  • You really have to do a bit of hacking to get this to work, but you can create your own class and then customize the ggplot_add method for that class. We can define some helpers

    as_ggfun <- function(fn) {
      structure(list(fun=fn), class="ggfun")
    }
    ggplot_add.ggfun <- function(object, p, objectname) {
      object$fun(p)
    }
    

    Then you need your add_ggplot_label function to return a ggfun object. For example

    add_ggplot_label <- function(l) {
      as_ggfun(function(p) {
        p$labels <- lapply(p$labels, function(x) {
          as.character(l[x])
        })
        p
      })
    }
    

    Then you can call

    ggplot(ir, aes(x = sep.len, y = sep.wid, col = sp)) + 
      geom_point() +
      add_ggplot_label(my_labels)
    

    and have it all "work". I wouldn't necessarily recommend this. It would probably be better to just create a helper function to build the correct labs() statement for you. For example you could define an alternate aes() function which also assigns labels. And you can pass variable/labels as formulas. If you have the function

    alt_aes1 <- function(...) {
      dots <- list(...)
      aess <- names(dots)
      vars <- sapply(dots, function(x) x[[2]])
      labels <- lapply(dots, function(x) x[[3]])
      list(
        do.call(aes, setNames(vars, aess)), 
        do.call(labs, setNames(labels, aess))
      )
    }
    

    Then you could call

    ggplot(ir) + 
      alt_aes1(x=sep.len~"Sepal Length", y=sep.wid~"Sepal.Width", color=sp~"species") + 
      geom_point() 
    

    to get the same plot. Alternative you could use

    alt_aes2 <- function(..., .rename=NULL) {
      dots <- as.list(match.call(expand.dots = FALSE)$...)
      list(
        do.call(aes, dots),
        if (!is.null(.rename)) do.call(labs, setNames(as.list(.rename[match(sapply(dots, deparse), names(.rename))]), names(dots)))
      )
    }
    

    which would be called like

    ggplot(ir) + 
      alt_aes2(x=sep.len, y=sep.wid, color=sp, .rename=my_labels) + 
      geom_point()