I want to extract the exact legend from template and add it to p.
library(ggplot2)
hc <- c("#00000000", heat.colors(4, alpha = 1))
ds <- cbind(expand.grid(1:4,1:4),z=sample(200:300,16))
p <-ggplot(ds, aes(Var1, Var2)) +
geom_raster(aes(fill = z)) +
scale_fill_gradientn(colours=hc) +
theme(
legend.position="bottom",
) +
ggtitle("My title")
tmp <- cbind(expand.grid(1:10,1:10),z=1:100)
template <-ggplot(tmp, aes(Var1, Var2)) +
geom_raster(aes(fill = z)) +
scale_fill_gradientn(colours=hc,breaks=c(25,50,75,100) ,labels=paste0(c(25,50,75,100),"%"),limits=c(1,100)) +
theme(
legend.position="bottom",
legend.title = element_blank()
) +
ggtitle("My template")
I have tried stuff like:
p$scales <- template$scales
and "play" around with
g <- ggplotGrob(template)
My solution uses ggplot_build and ggplot_gtable to extract legend and then simply put it into other plot.
library(ggplot2)
# Extract legend from ggplot object
extractLegend <- function(gg) {
grobs <- ggplot_gtable(ggplot_build(gg))
foo <- which(sapply(grobs$grobs, function(x) x$name) == "guide-box")
grobs$grobs[[foo]]
}
# Extract wanted legend
wantedLegend <- extractLegend(template)
# Extract grobs from plot
grobsToReplace <- ggplot_gtable(ggplot_build(p))
foo <- which(sapply(grobsToReplace$grobs, function(x) x$name) == "guide-box")
# Replace legend with wanted legend
grobsToReplace$grobs[[foo]] <- wantedLegend
plot(grobsToReplace)
Before
After
Not sure whether cowplot::get_legend was around back when this question was first posted, but combining that with cowplot::plot_grid (or another plot layout function from packages like patchwork or egg) lets you easily extract a legend and add it to a different ggplot object.
library(ggplot2)
cowplot::plot_grid(
p + theme(legend.position = "none"),
cowplot::get_legend(template),
ncol = 1, rel_heights = c(5, 1)
)
Mess around with the heights ratio in rel_heights as you see fit.
Related
Consider the following plot:
library(ggplot2)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color)
The facet_wrap function wraps a sequence of faceted panels into a roughly rectangular display of nrow rows and ncol columns. However, depending on the data, the actual number of panels is often a few panels short of nrow * ncol, which leaves a chunk of wasted space in the plot.
If the plot includes legend(s), the situation is exacerbated, because now we have even more wasted space due to the legend, whether it's on the right (default legend position), or one of the other three directions.
To save space, I would like to shift the legend(s) into the space created by unfilled facets.
The following works as a space-saving measure, but the legend is anchored to a corner of the plot area, with potentially a lot of space left on one side, creating an imbalanced look:
p +
theme(legend.position = c(1, 0),
legend.justification = c(1, 0))
Shifting a legend towards the centre of the blank space area by manually adjusting the legend.position/legend.justification values is a matter of trial and error, and difficult to scale if one has many faceted plots to work on.
In summary, I want a method that:
Shifts the legend(s) of a faceted plot into the space created due to empty facets.
Results in a reasonably nice-looking plot.
Is easily automated to handle many plots.
This is a recurring use case for me, and I've decided to post it along with my working solution here in case anyone else finds it useful. I haven't seen this scenario asked/answered elsewhere on Stack Overflow. If anyone has, please leave a comment and I'll be happy to answer there instead or have this marked as a duplicate, as the case may be.
The following is an extension to an answer I wrote for a previous question about utilising the space from empty facet panels, but I think it's sufficiently different to warrant its own space.
Essentially, I wrote a function that takes a ggplot/grob object converted by ggplotGrob(), converts it to grob if it isn't one, and digs into the underlying grobs to move the legend grob into the cells that correspond to the empty space.
Function:
library(gtable)
library(cowplot)
shift_legend <- function(p){
# check if p is a valid object
if(!"gtable" %in% class(p)){
if("ggplot" %in% class(p)){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish extent of unfilled facet panels (including any axis cells in between)
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
empty.facet.panels <- list(min(empty.facet.panels[["t"]]), min(empty.facet.panels[["l"]]),
max(empty.facet.panels[["b"]]), max(empty.facet.panels[["r"]]))
names(empty.facet.panels) <- c("t", "l", "b", "r")
# extract legend & copy over to location of unfilled facet panels
guide.grob <- which(gp[["layout"]][["name"]] == "guide-box")
if(length(guide.grob) == 0){
message("There is no legend present. Returning original plot.")
return(p)
}
gp <- gtable_add_grob(x = gp,
grobs = gp[["grobs"]][[guide.grob]],
t = empty.facet.panels[["t"]],
l = empty.facet.panels[["l"]],
b = empty.facet.panels[["b"]],
r = empty.facet.panels[["r"]],
name = "new-guide-box")
# squash the original guide box's row / column (whichever applicable)
# & empty its cell
guide.grob <- gp[["layout"]][guide.grob, ]
if(guide.grob[["l"]] == guide.grob[["r"]]){
gp <- gtable_squash_cols(gp, cols = guide.grob[["l"]])
}
if(guide.grob[["t"]] == guide.grob[["b"]]){
gp <- gtable_squash_rows(gp, rows = guide.grob[["t"]])
}
gp <- gtable_remove_grobs(gp, "guide-box")
return(gp)
}
Result:
library(grid)
grid.draw(shift_legend(p))
Nicer looking result if we take advantage of the empty space's direction to arrange the legend horizontally:
p.new <- p +
guides(fill = guide_legend(title.position = "top",
label.position = "bottom",
nrow = 1)) +
theme(legend.direction = "horizontal")
grid.draw(shift_legend(p.new))
Some other examples:
# example 1: 1 empty panel, 1 vertical legend
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
grid.draw(shift_legend(p1))
# example 2: 2 empty panels (vertically aligned) & 2 vertical legends side by side
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
grid.draw(shift_legend(p2))
# example 3: facets in polar coordinates
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
grid.draw(shift_legend(p3))
Nice Q&A!
I found something similar at this link. So, I thought that it would have been a nice addition to your function.
More precisely the function reposition_legend() from lemon seems to be quite what you needed, except that it doesn't look for the empty spaces.
I took inspiration from your function to find the names of the empty panels that are passed to reposition_legend() with the panel arg.
Example data and libraries:
library(ggplot2)
library(gtable)
library(lemon)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color) +
theme(legend.direction = "horizontal")
Of course, I removed all the checks (if cases, which should be the same) just to concentrate on the important stuff.
shift_legend2 <- function(p) {
# ...
# to grob
gp <- ggplotGrob(p)
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# example of names:
#[1] "panel-3-2" "panel-3-3"
# now we just need a simple call to reposition the legend
reposition_legend(p, 'center', panel=names)
}
shift_legend2(p)
Note that this might still need some tweaking, I just thought it was something worth to be shared.
At the moment the behaviour seems OK, and the function is a few lines shorter.
Other cases.
First example:
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
shift_legend2(p1)
Second example:
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
#[1] "panel-2-3" "panel-3-3" are the names of empty panels in this case
shift_legend2(p2)
Third example:
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
shift_legend2(p3)
Complete function:
shift_legend2 <- function(p) {
# check if p is a valid object
if(!(inherits(p, "gtable"))){
if(inherits(p, "ggplot")){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]),
USE.NAMES = F)
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# return repositioned legend
reposition_legend(p, 'center', panel=names)
}
I think lemon::reposition_legend() identified by #RLave is the most elegant solution. However, it does hinge on knowing the names of empty facets. I wanted to share a succinct way of finding these, thus proposing yet another version of shift_legend():
shift_legend3 <- function(p) {
pnls <- cowplot::plot_to_gtable(p) %>% gtable::gtable_filter("panel") %>%
with(setNames(grobs, layout$name)) %>% purrr::keep(~identical(.x,zeroGrob()))
if( length(pnls) == 0 ) stop( "No empty facets in the plot" )
lemon::reposition_legend( p, "center", panel=names(pnls) )
}
The R package patchwork offers an elegant solution when combining multiple plots (slightly different than a single facetted ggplot). If one has three ggplot objects, p1, p2, p3, then the syntax is very straightforward:
using the + operator, "add" the plots together in facets
using the guide_area() command, specify which facet should contain the guide
if all three plots have the same legend, save space by telling patchwork to "collect" the legends with the command plot_layout(guides = 'collect').
See the code below for the essential syntax and the link below for a fully reproducible example.
library(patchwork)
# guide_area() puts legend in empty fourth facet
p1 + p2 + p3 + guide_area() +
plot_layout(guides = 'collect')
https://patchwork.data-imaginist.com/articles/guides/layout.html#controlling-guides
library(ggplot2)
library(gridExtra)
df1 <- data.frame(x=c("A1","A2","A3","A4"),something=c(10,18,24,32),col=rep(c("A","B"),2))
df2 <- data.frame(x=c("C1","C2","C3","C4"),somethingelse=c(10543,182334,242334,32255),col=rep(c("A","B"),2))
p1 <- ggplot(df1,aes(x,something,fill=col))+
ggtitle("Plot")+
geom_bar(stat="identity")+
theme(legend.position="top",
legend.justification="right",
legend.direction="horizontal")
p2 <- ggplot(df2,aes(x,somethingelse,fill=col))+
ggtitle("Plot")+
geom_bar(stat="identity")+
theme(legend.position="top",
legend.justification="right",
legend.direction="horizontal")
I have these two plots that I would like to combine together with equal widths, common title and legend. I thought rather than pulling out the titles and legend grobs, I would leave it on the top plot and hide it in the second plot. This way, I don't have to set heights manually in grid.arrange().
#using loops to generalise to n plots
plist <- list()
plist[[1]] <- p1
plist[[2]] <- p2
grobs <- list()
for (i in 1:length(plist)){
if(i!=1) plist[[i]] <- plist[[i]]+theme(legend.position="none",plot.title=element_blank())
grobs[[i]] <- ggplotGrob(plist[[i]])
widths[[i]] <- grobs[[i]]$widths[2:5]
}
# fix widths
maxwidth <- do.call(grid::unit.pmax, widths)
for (i in 1:length(grobs)){
grobs[[i]]$widths[2:5] <- as.list(maxwidth)
}
#plot
pgrob = do.call("arrangeGrob",grobs)
grid.arrange(pgrob)
But, here the plot area heights are very different. So I manually set the height of all plots as the first.
for (i in 1:length(grobs)){
grobs[[i]]$heights[2:5] <- grobs[[1]]$heights[2:5]
}
#plot
pgrob = do.call("arrangeGrob",grobs)
grid.arrange(pgrob)
Now, I end up with this huge blank space above the second plot. How do I get rid of that?
You can use ggpubr package to set same legend for both plots (no need to extract grobs and adjust heights).
library(ggpubr)
figure <- ggarrange(p1, p2, nrow = 2, align = "v", common.legend = TRUE)
annotate_figure(figure, fig.lab = "Plot")
Explantion:
align = "v" aligns plots vertically
common.legend = TRUE sets same legend for both plots
annotate_figure adds shared label
Used data:
df1 <- data.frame(x=c("A1","A2","A3","A4"),something=c(10,18,24,32),col=rep(c("A","B"),2))
df2 <- data.frame(x=c("C1","C2","C3","C4"),somethingelse=c(10543,182334,242334,32255),col=rep(c("A","B"),2))
library(ggplot2)
p1 <- ggplot(df1,aes(x,something,fill=col))+
geom_bar(stat="identity")+
theme(legend.position="top",
legend.justification="right",
legend.direction="horizontal")
p2 <- ggplot(df2,aes(x,somethingelse,fill=col))+
geom_bar(stat="identity")+
theme(legend.position="top",
legend.justification="right",
legend.direction="horizontal")
If you can and restructure and rbind your dataframes, you can use facet_wrap(..., scale = "free") to get what you want.
library(ggplot2)
library(gridExtra)
df1 <- data.frame(x=c("A1","A2","A3","A4"),y=c(10,18,24,32),col=rep(c("A","B"),2), type = "something")
df2 <- data.frame(x=c("C1","C2","C3","C4"),y=c(10543,182334,242334,32255),col=rep(c("A","B"),2), type = "somethingelse")
df <- rbind(df1, df2)
ggplot(df,aes(x,y,fill=col))+
ggtitle("Plot")+
geom_bar(stat="identity")+
facet_wrap(~type, ncol = 1, scales = "free") +
theme(legend.position="top",
legend.justification="right",
legend.direction="horizontal")
I am generating some plots with the following code.I have 8 plots generated with the the following code and what I want is to have them on the same page with no titles. More specifically, I want in every plot to have on the left up-corner a letter (a,b..) and at the end of the plot to have something like an one-row legend (e.g Plots: a. category one, b. category two, ...).
Code:
g1= ggplot(som, aes(x=value, y=variable))+geom_smooth(method=lm,alpha=0.25,col='green',lwd=0.1) +ylim(0,1000)+xlim(-2,2)+
geom_point(shape=23,fill="black",size=0.2)+theme_bw()+theme(plot.background = element_blank(),panel.grid.major = element_blank()
,panel.grid.minor = element_blank()) +labs(x="something here",y="something else")+
theme(axis.title.x = element_text(face="bold", size=7),axis.text.x = element_text(size=5))+
theme(axis.title.y = element_text(face="bold", size=7),axis.text.y = element_text(size=5))+
theme(plot.title = element_text(lineheight=.8, face="bold",size=8))
grid.arrange(g1,g2,g3,g4,g5,g6,g7,g8,ncol=2)
Is it possible to do that with ggplot? If so, how can I do this?
p.s I have no problem with the above code
Thank you.
This is how you could do it with library(cowplot).
First some plots:
set.seed(1)
plots <- list()
for (i in 1:8) {
my_cars <- mtcars[sample(1:nrow(mtcars), 10), ]
plots[[i]] <- ggplot(my_cars, aes(mpg, hp, color = as.factor(cyl))) +
geom_point() +
geom_smooth(method = "lm", color = "black")
}
Then to have a unifying title (or legend here) we use a combination of two plot_grid() calls.
lbls <- LETTERS[1:length(plots)]
# add a line break because its long
lbls <- gsub("E", "\nE", lbls)
grid <- plot_grid(plotlist = plots, labels = lbls, ncol = 2)
legend <- ggdraw() +
draw_label(paste0(lbls, "= category",1:length(plots), collapse = " "))
plot_grid(grid, legend, rel_heights = c(1, .1), ncol = 1)
The documentation for cowplot is great and has a ton of examples. Check it out here and here. Let me know if you get stuck.
Here is some example code, which provides a legend with 2 columns. I want to decrease the space between the two colums of the legend (see below).
library(ggplot2)
labels <- c(expression(""^13*CH[4]),
expression(""^13*CH[4]~"+"~SO[4]^{2-''}),
expression(""^13*CH[4]~"+"~MoO[4]^{2-''}))
ggplot(aes(mpg, wt, colour = factor(cyl), shape=factor(cyl)),
data = mtcars) +
geom_point() +
scale_colour_manual(values=c("red", "green", "blue"), label=labels)+
scale_shape_manual(values = c(4,5,6), label=labels)+
theme(legend.position = "bottom",
legend.text.align = 0,
legend.text = element_text(size=8),
legend.key.size = unit(0.8, 'lines')) +
guides(col = guide_legend("", ncol=2), shape=guide_legend("", col=2))
Here is my real life problem:
Additional space is needed on the right side of the plot, because the three factor levels there contain much more characters. However, i am really constrained in the plot size. Hence, I would like to decrease the space between the two rows of the legend.
I also would like to keep the most bottom factor level of the left hand side as is, without adding an extra line.
Based on your example, I simplified it a bit:
Create the problematic plot:
library(ggplot2)
labels <- c("short1", "loooooooooooooooooong", "short2")
plt <- ggplot(aes(mpg, wt, colour = factor(cyl), shape=factor(cyl)),
data = mtcars) +
geom_point() +
scale_colour_manual(values=c("red", "green", "blue"), label=labels)+
scale_shape_manual(values = c(4,5,6), label=labels)+
theme(legend.position = "bottom",
legend.text.align = 0,
legend.text = element_text(size=8),
legend.key.size = unit(0.8, 'lines')) +
guides(col = guide_legend("", ncol=2), shape=guide_legend("", col=2))
plot(plt)
Extract the legend and tweak it
I used this answer to extract the legend from the plot:
#Extract Legend
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)}
legend <- g_legend(plt)
And print it:
grid.newpage()
grid.draw(legend)
Then I explored the grobs inside the legend and I found the widths field:
legend$grobs[[1]]$widths
[1] 0.2cm 0cm 0.1524cm 0.4064cm 0.0762cm 3.22791666666667cm 0.0762cm 0.4064cm 0.0762cm
[10] 0.79375cm 0.2cm
>
Apparently those 3.227 cm are too much so I just changed them:
legend$grobs[[1]]$widths[6] <- unit(1.5, "cm")
And plot it:
grid.newpage()
grid.draw(legend)
Apply the fix to the global plot:
The final steps are to replicate that on the ggplot:
Apply that same manual correction to the global plot:
# this is how the legend was extracted:
plt_gtable <- ggplot_gtable(ggplot_build(plt))
leg <- which(sapply(plt_gtable$grobs, function(x) x$name) == "guide-box")
# Replace the legend with our modified legend:
plt_gtable$grobs[[leg]] <- legend
And replot:
grid.newpage()
grid.draw(plt_gtable)
I am creating a graphic using facet_grid to facet a categorical variable on the y-axis. I decided not to use facet_wrap because I need space = 'free' and labeller = label_parsed. My labels are long and I have a legend on the right so I would like to move the labels from the right of the panel to the top of the panel.
Here is an example to show where I'm getting stuck.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme_minimal() +
theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0))
Now I would like to move the strip text from the right of each panel to the top of each panel. I can store the grobs for the strip labels and remove them from the plot:
grob <- ggplotGrob(mt)
strips.y <- gtable_filter(grob, 'strip-right')
grob2 <- grob[,-5]
But now I'm stuck when it comes to rbind-ing the grobs back so the labels go to the top of the panels.
Another possible solution would be to use facet_wrap and then re-size the panels as discussed in another question, but in that case I would have to manually change the labels on the facets because there is no labeller = label_parsed for facet_wrap.
I'd appreciate suggestions on either approach!
Thanks for reading,
Tom
This takes your first approach. It inserts a row above each of the panels, grabs the strip grobs (on the right), and inserts them into the new rows.
library(ggplot2)
library(gtable)
library(grid)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme(panel.spacing = unit(0.5, 'lines'),
strip.text.y = element_text(angle = 0))
# Get the gtable
gt <- ggplotGrob(mt)
# Get the position of the panels in the layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
# Add a row above each panel
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i)
# Get the positions of the panels and the strips in the revised layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
strips <- c(subset(gt$layout, grepl("strip-r", gt$layout$name), se=t:r))
# Get the strip grobs
stripText = gtable_filter(gt, "strip-r")
# Insert the strip grobs into the new rows
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=4)
# Remove the old strips
gt = gt[,-5]
# For this plot - adjust the heights of the strips and the empty row above the strips
for(i in panels$t) {
gt$heights[i-1] = unit(0.8, "lines")
gt$heights[i-2] = unit(0.2, "lines")
}
# Draw it
grid.newpage()
grid.draw(gt)
OR, you can achieve the second approach using a facet_wrap_labeller function available from here.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) +
theme(panel.margin = unit(0.2, 'lines'))
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))
return(g)
}
## Number of y breaks in each panel
g <- ggplot_build(mt)
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length)
# Some arbitrary strip texts
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4] )
# Apply the facet_wrap_labeller function
gt = facet_wrap_labeller(mt, StripTexts)
# Get the position of the panels in the layout
panels <- gt$layout$t[grepl("panel", gt$layout$name)]
# Replace the default panel heights with relative heights
gt$heights[panels] <- lapply(N, unit, "null")
# Draw it
gt
I was struggling with a similar problem but putting the labels on the bottom. I've used a code adaptation of this answer. And recently found that
ggplot2 ver.2.2.1.0 (http://docs.ggplot2.org/current/facet_grid.html)
~facet_grid(.~variable,switch='x')
option which has worked beautifully for me.