Just came across this very useful function from roland and baptiste but needed a slightly different use case where the original wrap headers should be converted by a function rather than provided as a fixed value. I'm posting a slightly modified version of the original function in case it's useful to anybody else. It allows both the use of named (fixed value) expressions for the wrap strips, as well as use of custom functions and the functions already provided by ggplot2 for the facet_grid
labeller
parameter (such as label_parsed
and label_bquote
).
facet_wrap_labeller <- function(gg.plot, labels = NULL, labeller = label_value) {
#works with R 3.1.2 and ggplot2 1.0.1
require(gridExtra)
# old labels
g <- ggplotGrob(gg.plot)
gg <- g$grobs
strips <- grep("strip_t", names(gg))
modgrobs <- lapply(strips, function(i) {
getGrob(gg[[i]], "strip.text", grep=TRUE, global=TRUE)
})
old_labels <- sapply(modgrobs, function(i) i$label)
# find new labels
if (is.null(labels)) # no labels given, use labeller function
new_labels <- labeller(names(gg.plot$facet$facets), old_labels)
else if (is.null(names(labels))) # unnamed list of labels, take them in order
new_labels <- as.list(labels)
else { # named list of labels, go by name where provided, otherwise keep old
new_labels <- sapply(as.list(old_labels), function(i) {
if (!is.null(labels[[i]])) labels[[i]] else i
})
}
# replace labels
for(i in 1:length(strips)) {
gg[[strips[i]]]$children[[modgrobs[[i]]$name]] <-
editGrob(modgrobs[[i]], label=new_labels[[i]])
}
g$grobs <- gg
class(g) = c("arrange", "ggplot",class(g))
return(g)
}
Update / warning
For newer versions of the gridExtra
package you'll get the error Error: No layers in plot
when running this function because arrange
is no longer in gridExtra
and R tries to interpret it as a ggplot
. You can fix this by (re-)introducing the print
function for the arrange
class:
print.arrange <- function(x){
grid::grid.draw(x)
}
This should now allow the plot to render and you can use ggsave()
e.g. like so: ggsave("test.pdf", plot = facet_wrap_labeller(p, labeller = label_parsed))
Examples
A couple of use case examples:
# artificial data frame
data <- data.frame(x=runif(16), y=runif(16), panel = rep(c("alpha", "beta", "gamma","delta"), 4))
p <- ggplot(data, aes(x,y)) + geom_point() + facet_wrap(~panel)
# no changes, wrap panel headers stay the same
facet_wrap_labeller(p)
# replace each panel title statically
facet_wrap_labeller(p, labels = expression(alpha^1, beta^1, gamma^1, delta^1))
# only alpha and delta are replaced
facet_wrap_labeller(p, labels = expression(alpha = alpha^2, delta = delta^2))
# parse original labels
facet_wrap_labeller(p, labeller = label_parsed)
# use original labels but modifying them via bquote
facet_wrap_labeller(p, labeller = label_bquote(.(x)^3))
# custom function (e.g. for latex to expression conversion)
library(latex2exp)
facet_wrap_labeller(p, labeller = function(var, val) {
lapply(paste0("$\\sum\\", val, "$"), latex2exp)
})