Combining grid_arrange_shared_legend() and facet_wrap_labeller() in R - r

Question

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?

Answer 1

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)