I am trying to combine grid_arrange_shared_legend()
and facet_wrap_labeller()
in R. More specifically, I want to draw a figure including two ggplot figures with multiple panels each and have a common legend. I further want to italicize part of the facet strip labels. The former is possible with the grid_arrange_shared_legend()
function introduced here, and the latter can be achieved with the facet_wrap_labeller()
function here. However, I have not been successful in combining the two.
Here's an example.
library("ggplot2")
set.seed(1)
d <- data.frame(
f1 = rep(LETTERS[1:3], each = 100),
f2 = rep(letters[1:3], 100),
v1 = runif(3 * 100),
v2 = rnorm(3 * 100)
)
p1 <- ggplot(d, aes(v1, v2, color = f2)) + geom_point() + facet_wrap(~f1)
p2 <- ggplot(d, aes(v1, v2, color = f2)) + geom_smooth() + facet_wrap(~f1)
I can place p1 and p2 in the same figure and have a common legend using grid_arrange_shared_legend()
(slightly modified from the original).
grid_arrange_shared_legend <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position = "right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$width)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position = "none"))),
legend,
ncol = 2,
widths = unit.c(unit(1, "npc") - lheight, lheight))
}
grid_arrange_shared_legend(p1, p2)
Here's what I get.
It is possible to italicize part of the strip label by facet_wrap_labeller()
.
facet_wrap_labeller <- function(gg.plot,labels=NULL) {
require(gridExtra)
g <- ggplotGrob(gg.plot)
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
modgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
}
g$grobs <- gg
class(g) = c("arrange", "ggplot",class(g))
g
}
facet_wrap_labeller(p1,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
However, I cannot combine the two in a straightforward manner.
p3 <- facet_wrap_labeller(p1,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
p4 <- facet_wrap_labeller(p2,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
grid_arrange_shared_legend(p3, p4)
# Error in plot_clone(p) : attempt to apply non-function
Does anyone know how to modify either or both of the functions so that they can be combined? Or is there any other way to achieve the goal?
You need to pass the gtable instead of the ggplot,
library(gtable)
library("ggplot2")
library(grid)
set.seed(1)
d <- data.frame(
f1 = rep(LETTERS[1:3], each = 100),
f2 = rep(letters[1:3], 100),
v1 = runif(3 * 100),
v2 = rnorm(3 * 100)
)
p1 <- ggplot(d, aes(v1, v2, color = f2)) + geom_point() + facet_wrap(~f1)
p2 <- ggplot(d, aes(v1, v2, color = f2)) + geom_smooth() + facet_wrap(~f1)
facet_wrap_labeller <- function(g, labels=NULL) {
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
oldgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
newgrob <- editGrob(oldgrob,label=labels[ii])
gg[[strips[ii]]]$children[[oldgrob$name]] <- newgrob
}
g$grobs <- gg
g
}
combined_fun <- function(p1, p2, labs1) {
g1 <- ggplotGrob(p1 + theme(legend.position = "right"))
g2 <- ggplotGrob(p2 + theme(legend.position = "none"))
g1 <- facet_wrap_labeller(g1, labs1)
legend <- gtable_filter(g1, "guide-box", trim = TRUE)
g1p <- g1[,-(ncol(g1)-1)]
lw <- sum(legend$width)
g12 <- rbind(g1p, g2, size="first")
g12$widths <- unit.pmax(g1p$widths, g2$widths)
g12 <- gtable_add_cols(g12, widths = lw)
g12 <- gtable_add_grob(g12, legend,
t = 1, l = ncol(g12), b = nrow(g12))
g12
}
test <- combined_fun(p1, p2, labs1 = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
grid.draw(test)