A way to add multiple color or fill scales to a ggplot2 plot

new_aes.R

# All this is implemented (plus bugfixes!) in the ggnewscale package: 
# https://github.com/eliocamp/ggnewscale
# If you have any issues, I prefer it if you send them as issues here:
# https://github.com/eliocamp/ggnewscale/issues

#' Allows to add another scale 
#' 
#' @param new_aes character with the aesthetic for which new scales will be 
#' created
#'
new_scale <- function(new_aes) {
  structure(ggplot2::standardise_aes_names(new_aes), class = "new_aes")
}

#' Convenient functions
new_scale_fill <- function() {
  new_scale("fill")
}

new_scale_color <- function() {
  new_scale("colour")
}

new_scale_colour <- function() {
  new_scale("colour")
}

#' Special behaviour of the "+" for adding a `new_aes` object
#' It changes the name of the aesthethic for the previous layers, appending
#' "_new" to them. 
ggplot_add.new_aes <- function(object, plot, object_name) {
  plot$layers <- lapply(plot$layers, bump_aes, new_aes = object)
  plot$scales$scales <- lapply(plot$scales$scales, bump_aes, new_aes = object)
  plot$labels <- bump_aes(plot$labels, new_aes = object)
  plot
}


bump_aes <- function(layer, new_aes) {
  UseMethod("bump_aes")
}

bump_aes.Scale <- function(layer, new_aes) {
  old_aes <- layer$aesthetics[remove_new(layer$aesthetics) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")
  
  layer$aesthetics[layer$aesthetics %in% old_aes] <- new_aes
  
  if (is.character(layer$guide)) {
    layer$guide <- match.fun(paste("guide_", layer$guide, sep = ""))()
  }
  layer$guide$available_aes[layer$guide$available_aes %in% old_aes] <- new_aes
  layer
}

bump_aes.Layer <- function(layer, new_aes) {
  original_aes <- new_aes
  
  old_aes <- names(layer$mapping)[remove_new(names(layer$mapping)) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")
  
  old_geom <- layer$geom
  
  old_setup <- old_geom$handle_na
  new_setup <- function(self, data, params) {
    colnames(data)[colnames(data) %in% new_aes] <- original_aes
    old_setup(data, params)
  }
  
  new_geom <- ggplot2::ggproto(paste0("New", class(old_geom)[1]), old_geom,
                               handle_na = new_setup)
  
  new_geom$default_aes <- change_name(new_geom$default_aes, old_aes, new_aes)
  new_geom$non_missing_aes <- change_name(new_geom$non_missing_aes, old_aes, new_aes)
  new_geom$required_aes <- change_name(new_geom$required_aes, old_aes, new_aes)
  new_geom$optional_aes <- change_name(new_geom$optional_aes, old_aes, new_aes)
  
  layer$geom <- new_geom
  
  old_stat <- layer$stat
  
  old_setup2 <- old_stat$handle_na
  new_setup <- function(self, data, params) {
    colnames(data)[colnames(data) %in% new_aes] <- original_aes
    old_setup2(data, params)
  }
  
  new_stat <- ggplot2::ggproto(paste0("New", class(old_stat)[1]), old_stat,
                               handle_na = new_setup)
  
  new_stat$default_aes <- change_name(new_stat$default_aes, old_aes, new_aes)
  new_stat$non_missing_aes <- change_name(new_stat$non_missing_aes, old_aes, new_aes)
  new_stat$required_aes <- change_name(new_stat$required_aes, old_aes, new_aes)
  new_stat$optional_aes <- change_name(new_stat$optional_aes, old_aes, new_aes)
  
  layer$stat <- new_stat
  
  layer$mapping <- change_name(layer$mapping, old_aes, new_aes)
  layer
}

bump_aes.list <- function(layer, new_aes) {
  old_aes <-  names(layer)[remove_new(names(layer)) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")
  
  names(layer)[names(layer) %in% old_aes] <- new_aes
  layer
}

change_name <- function(list, old, new) {
  UseMethod("change_name")
}

change_name.character <- function(list, old, new) {
  list[list %in% old] <- new
  list
}

change_name.default <- function(list, old, new) {
  nam <- names(list)
  nam[nam %in% old] <- new
  names(list) <- nam
  list
}

change_name.NULL <- function(list, old, new) {
  NULL
}

remove_new <- function(aes) {
  stringi::stri_replace_all(aes, "", regex = "(_new)*")
}



# Example

library(ggplot2)

vd <- reshape2::melt(volcano)
names(vd) <- c("x", "y", "z")

# point measurements of something (abund) at a few locations
d <- data.frame(x=runif(30, 1, 80), y = runif(30, 1, 60), abund=rnorm(30))


ggplot(mapping = aes(x, y)) +
  geom_contour(aes(z = z, color = ..level..), data = vd) +
  scale_color_viridis_c(option = "D") +
  new_scale_color() +   # geoms below can use another color scale!
  geom_point(data = d, size = 3, aes(color = abund)) +
  scale_color_viridis_c(option = "A") 

Hello!

I wanted to let you know this helped me greatly trying to add a little visual flair for a plot!!

Thank you!!

Hey, thanks! It means a lot to know that my code helped someone.
I had forgotten about this gist and should add to it that now all this (with bug fixes) is packaged in the ggnewscale package
https://github.com/eliocamp/ggnewscale

Hello! Thanks a lot for this code. I was wondering if there is a way to specify the order of the legends. For example, in your demo on your ggnewscale repo, is there a way for the 'spiecies' legend to be on top, followed by Sepal.Width legend? The guides() fonction does not work in that situation.

That's ggplot2 stuff. You need to pass the order parameter to the relevant guide. Something like scale_color_continuous(guide = guide_colorbar(order = 3))
See here: https://stackoverflow.com/questions/11393123/controlling-ggplot2-legend-display-order

Awesome, I will add this to my new base of packages I load out.

…

Hi! Thank you for your code! it is very helpful!
I was wondering if I can combine scale_fill_gradient2 and scale_fill_manual with your package.
For example I have the following script:
pp<-ggplot(mapping=aes(x=X1, y=Y1)) +
geom_tile(data=pred.dat, aes(x=X1, y=Y1,fill=group)) +
scale_fill_gradient2(low="gray43", mid="white", high="gray43",
midpoint=median(pred.dat$group)) +
labs(title='Probability of Direction="Up"',fill="Probability") +
new_scale_fill() +
geom_point(data = out_comp3, aes(x=Estimation, y=medRT_dgcomp, fill= group2))+
scale_fill_manual(values=c("white","black"))

With this script I should have the background with grey-scaled colors while the dots should be white and black. But it does not work for the dots. Do you have any insights? thank you!

The default shape of geom_point does not have a "fill" aesthetic. In your case, you can ignore ggnewscale and just use

geom_point(data = out_comp3, aes(x=Estimation, y=medRT_dgcomp, color = group2)) +
scale_color_manual(values=c("white","black"))

If, for some reason, you want to use the fill aesthetic with points, then you need to change the shape parameter to one that accepts fill (21 and greater, following this chart: http://www.sthda.com/english/wiki/ggplot2-point-shapes)

PS: In the future, consider creating a reproducible example. That is, a piece of code that by itself reproduces the issue you're facing. In this case, I don't have the variable pred.dat nor out_comp3 so I cannot run your example and get any result. Here's a helpful article with links: https://community.rstudio.com/t/faq-whats-a-reproducible-example-reprex-and-how-do-i-do-one/5219

Thank you so much for your help!! Yes, I would like to use fill aesthetic with points because it's difficult to see the white dots on the grey background. So I would like to fill balck and white but with the contour black..

Ah, yes. In that case, then geom_point(aes(..., fill = group2), shape = 21, color = "black") should do the trick.

Ok, now I fixed it with new_scale_fill() and including the scale_shape_manual (21) and scale_fill_manual(white and black)

Thank you so much!!

Thank you! this is awesome!

That was super helpful Dr. Campitelli
I have just used it.
One problem that I am dealing, I am not able to modify the order of labels in the legend. Do you have any advice on it? Thank you!

Please, Dr. Campitelli lives in Bariloche. Calle me Elio 😆 (also, I'm not a doctor nor have a PhD -yet)

To control de order of legends you need to put something like scale_color_continuous(guide = guide_legend(order = 1)). So, inside each scale definition, you set the guide parameter and then the order of each guide.

it worked! thank you a lot

Awesome! Thanks.
With current ggplot2, at least in your example above, remove_new() as no effect as there is never an aes with new in it.
So I don't know if you still need it for other cases, but if you do, perhaps removing the dependence to stringi could be good.
Perhaps this would do the job:

  remove_new <- function(aes) {
    gsub(pattern = "(_new)*", replacement = "", x = aes)
  }

but double check since I cannot test it.

This solved my problem after days of trying. Thank you!