Skip to content

Instantly share code, notes, and snippets.

@eliocamp eliocamp/new_aes.R
Last active Nov 17, 2019

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

`

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.