Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A way to add multiple color or fill scales to a ggplot2 plot
# 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")
@GeoKate

This comment has been minimized.

Copy link

@GeoKate GeoKate commented Mar 25, 2019

Hi I'm using ggplot to plot actual data with geom_point() with a scale_fill_manual over theoretical data that is plotted with geom_tile() with scale_fill_viridis(). This code seems to be perfect for what I want but I don't quite understand it as I'm relatively new to R.
I tried your example and it worked but then when I try my code (see the following), it doesn't work. I'd be really grateful if you could tell me which bits of the functions I need to put in a second fill scale. Thanks!

`
new_scale_fill <- function() {new_scale("fill")}

{PlotSymbol <- sort(c("Main","China","Right","Left","Cambodia","TimeSeries","NA"))
PlotSymbolColor <- c("#ADFF2F","#00B2EE","#A020F0","#FF69B4","#EE0000","#FF7F00","#FFE1FF")
PlotSymbolShape <- c(24, 25, 21, 23, 22, 22, 3)}

contours<-matrix(c(1:2 %o% 10^(-4:2)),ncol=1)
ytitle<-as.character("F_sulf")
xtitle<-as.character("F_carb")

Data_withn5_plot<-
labs(x=xtitle, y=ytitle, size=sizetitle)+
geom_tile(data=all_ns_CO2_subset, aes(x=Var1, y=Var2, fill=value))+
scale_fill_viridis("Amount of \nreaction n",option="magma",trans = "log", breaks=c(-1,0,1,10,100,1000))+
geom_contour(data=all_ns_CO2_subset, aes(x=Var1, y=Var2, z=value),breaks=c(contours[,1]))+
new_scale("fill") +
geom_point(data=Data_withn5, aes(x=F_carb_variable, y=F_sulf_variable, size=value,
fill=as.factor(Symbol), shape=as.factor(Symbol)), alpha=.7)+
scale_fill_manual(breaks = PlotSymbol, values=PlotSymbolColor)+
scale_shape_manual(breaks = PlotSymbol, values=PlotSymbolShape)+
guides(fill=guide_legend(title="Location"),
shape=guide_legend(title="Location"))+
facet_wrap(.~n, ncol=3)+
theme(panel.background = element_rect(fill = NA),
panel.border = element_rect(colour = "black", fill="NA", size=1),
panel.grid.major = element_line(colour = "white", size=0),
panel.grid.minor = element_line(colour = "white", size=0),
aspect.ratio=1,
legend.text=element_text(size=6),
legend.title=element_text(size=6),
#legend.key.size = unit(0.2,"line"),
plot.title = element_text(hjust = 0.5),
axis.title.x =element_text(size=10,angle=0),
axis.text.x = element_text(margin=unit(c(0.5,0.5,0.5,0.5), "cm")),
axis.title.y =element_text(size=10,angle=90),
axis.text.y = element_text(margin=unit(c(0.5,0.5,0.5,0.5), "cm")),
#plot.margin = margin(t = 0, r = 0, b = 0, l = 0, unit = "pt"),
axis.ticks.length=unit(-0.25, "cm"),
strip.background =element_rect(fill="white"))+
scale_x_continuous(expand = c(0,0))+
scale_y_continuous(expand = c(0,0))

`

@NotThatKindODr

This comment has been minimized.

Copy link

@NotThatKindODr NotThatKindODr commented Dec 15, 2019

Hello!

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

Thank you!!

@eliocamp

This comment has been minimized.

Copy link
Owner Author

@eliocamp eliocamp commented Dec 15, 2019

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

@Oliviersanterre

This comment has been minimized.

Copy link

@Oliviersanterre Oliviersanterre commented Dec 18, 2019

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.

@eliocamp

This comment has been minimized.

Copy link
Owner Author

@eliocamp eliocamp commented Dec 18, 2019

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

@NotThatKindODr

This comment has been minimized.

Copy link

@NotThatKindODr NotThatKindODr commented Jan 11, 2020

@GisellaDecarli

This comment has been minimized.

Copy link

@GisellaDecarli GisellaDecarli commented Mar 27, 2020

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!

@eliocamp

This comment has been minimized.

Copy link
Owner Author

@eliocamp eliocamp commented Mar 27, 2020

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

@GisellaDecarli

This comment has been minimized.

Copy link

@GisellaDecarli GisellaDecarli commented Mar 27, 2020

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..

@eliocamp

This comment has been minimized.

Copy link
Owner Author

@eliocamp eliocamp commented Mar 27, 2020

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

@GisellaDecarli

This comment has been minimized.

Copy link

@GisellaDecarli GisellaDecarli commented Mar 27, 2020

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

@GisellaDecarli

This comment has been minimized.

Copy link

@GisellaDecarli GisellaDecarli commented Mar 27, 2020

Thank you so much!!

@itoledor

This comment has been minimized.

Copy link

@itoledor itoledor commented Jun 25, 2020

Thank you! this is awesome!

@anapaulapoeta

This comment has been minimized.

Copy link

@anapaulapoeta anapaulapoeta commented Jul 22, 2020

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!

@eliocamp

This comment has been minimized.

Copy link
Owner Author

@eliocamp eliocamp commented Jul 22, 2020

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.

@anapaulapoeta

This comment has been minimized.

Copy link

@anapaulapoeta anapaulapoeta commented Jul 23, 2020

it worked! thank you a lot

@courtiol

This comment has been minimized.

Copy link

@courtiol courtiol commented Sep 11, 2020

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment