Patchwork legend collecting fails - r

I have been trying to collect legends of plots created in a loop. However, this fails to produce the desired result, as the legends are not collected. I tried
(res[[1]] / res[[2]]) + plot_layout(guides = "collect") + theme(legend.position = "bottom")
where res[[1]] and res[[2]] are list elements created in the loop.
Any advice would be much appreciated.
Resulting plot

Remove + theme(legend.position = "bottom"):
library(ggplot2)
library(patchwork)
p1 <- ggplot(data = mtcars, aes(x = disp, y = cyl, color = as.factor(vs))) +
geom_point()
p2 <- ggplot(data = mtcars, aes(x = disp, y = cyl, color = as.factor(vs))) +
geom_point()
p1 + p2 + plot_layout(guides = "collect")
Or if you'd like to place the legend in the center:
p1 + p2 + plot_layout(guides = "collect") & theme(legend.position = 'bottom')

Related

ggplot: graphic issue with multiple graphs in a column

I want to set a few graphs in one column. The graph output, also the html knit output, does not extend the view frame of all graphs. In this way, the height of each additionally added graph decreases.
Corresponding code:
p_load(ggplot2)
library(patchwork)
p1 <- ggplot(mpg) +
geom_point(aes(x = displ, y = hwy))
p2 <- ggplot(mpg) +
geom_bar(aes(x = as.character(year), fill = drv), position = "dodge") +
labs(x = "year")
p3 <- ggplot(mpg) +
geom_density(aes(x = hwy, fill = drv), colour = NA) +
facet_grid(rows = vars(drv))
p4 <- ggplot(mpg) +
stat_summary(aes(x = drv, y = hwy, fill = drv), geom = "col", fun.data = mean_se) +
stat_summary(aes(x = drv, y = hwy), geom = "errorbar", fun.data = mean_se, width = 0.5)
p5 <- ggplot(mpg, aes(x = displ, y = hwy)) +
geom_point()
p6 <-ggplot(mpg, aes(displ, hwy, colour = class)) +
geom_point()
p1/ p2 / p3 / p4 / p5 / p6
I used Ggplot Arrange Plots Manual
How I can extend the complete view frame height for each added graph?
If you are talking about html knit output from a .Rmd document, the way to increase the display panel for the plot is to edit the parameter of the block of r code. For example:
> ```{r, fig.height=10, fig.width=6}
> p1/ p2 / p3 / p4 / p5 / p6
> ```

ggplot2 and grid.arrange, place legend below arranged plots

I am facing a problem when I arrange 2 ggplots next to each other using grid.arrange().
I want to place a legend evenly below both plots.
So I have (pseudocode):
p1 <- ggplot(data = df, aes(group = name, color=as.factor(fac), y = ys, x= (xs))) +
geom_point() +
geom_line() +
theme(legend.position="bottom")
p2 <- ggplot(data = df, aes(group = name, color=as.factor(fac), y = ys, x= (xs))) +
geom_point() +
geom_line() +
grid.arrange(p1,p2, ncol=2, widths=c(0.9,1))
Is there any possibility to arrange the legend so that it is positioned evenly below both plots? If I do it as above, the legend is (logically) placed below the first plot.
With package patchwork you could try this...
library(ggplot2)
library(patchwork)
p1 <- ggplot(data = mtcars, aes(group = gear, color=as.factor(am), y = mpg, x = hp)) +
geom_point() +
geom_line()
p2 <- ggplot(data = mtcars, aes(group = gear, color=as.factor(am), y = mpg, x = hp)) +
geom_point() +
geom_line()
p1 + p2 +
plot_layout(guides = "collect") &
theme(legend.position='bottom')
Created on 2022-02-04 by the reprex package (v2.0.1)

Controlling widths of many patchworked ggplots

I'm trying to make a graph with several ggplot2 graphs combined via patchwork.
I want first a shared y-axis for plot 1 and 3. Then plot 1 and 3 and at the end plot 2 and 4. This I have achieved with the help from #Allan Cameron - see the plot. Unfortunately I cannot control the width of plot 1,3,2 and 4. I would like plot 1 and 3 to be wider than plot 2 and 4. Also, for some reason the legend ends up in the middle of the plots. How can I put it all the way to the right?
Any ideas? All help is much appreaciated!
Here's the code:
mtcars
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(disp, wt, colour = mpg)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_point(aes(carb, wt)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p4 <- ggplot(mtcars) +
geom_area(aes(gear, carb)) +
ggtitle('Plot 4')
# Patchwork graph with shared y-axis
y_axis <- ggplot(data.frame(l = p1$labels$y, x = 1, y = 1)) +
geom_text(aes(x, y, label = l), angle = 90) +
theme_void() +
coord_cartesian(clip = "off")
p1$labels$y <- p2$labels$y <- " "
y_axis + (p1 + p2) / (p3 + p4) + plot_layout(widths = c(1, 15, 5), guides = "collect")
With regards to the widths issue, the nesting you do -for example (p1 + p1)- causes the nested objects to respond differently. Instead you can use the design argument in plot_layout() to achieve the same, but responsive to the widths.
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(disp, wt, colour = mpg)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_point(aes(carb, wt)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p4 <- ggplot(mtcars) +
geom_area(aes(gear, carb)) +
ggtitle('Plot 4')
# Patchwork graph with shared y-axis
y_axis <- ggplot(data.frame(l = p1$labels$y, x = 1, y = 1)) +
geom_text(aes(x, y, label = l), angle = 90) +
theme_void() +
coord_cartesian(clip = "off")
p1$labels$y <- p2$labels$y <- " "
y_axis + p1 + p2 + p3 + p4 +
plot_layout(widths = c(1, 15, 5),
guides = "collect",
design = "
123
145
")
Created on 2020-12-16 by the reprex package (v0.3.0)
Small note, you're deleting the y-axis lable of p2, whereas I think you meant to delete it from p3.
The patchwork can control the width of each part by iteral call the "plot_layout" in the sub-plot, just like :
patchwork <- (p1+p2)/(p3) + plot_layout(guides = "collect") while you want to make p1 wider than p2, you could try :
patchwork <- (p1+p2 + plot_layout(widths = c(2, 1), guides = "collect"))/(p3) + plot_layout(guides = "collect")

Merging two y-axes titles in patchwork

Any ideas as to how I can "merge" two identical y-axes titles into one, and then place this y-axis title in the middle between the plot? I have succeded in merging legends by using plot_layout(guides = "collect") but I cannot seem to find anything similar for axes. In this case I would merge the two axes titles called disp_disp_disp into one.
mtcars
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p1 / (p2 | p3)
I guess it would be slightly easier to strip out the y axis title before the plot is built then draw it back on after it is plotted:
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
ylab <- p1$labels$y
p1$labels$y <- p2$labels$y <- " "
p1 / (p2 | p3)
grid::grid.draw(grid::textGrob(ylab, x = 0.02, rot = 90))
Another option if you want to avoid getting your hands dirty with grobs altogether is to specify a text-only ggplot and add that as your axis text:
p4 <- ggplot(data.frame(l = p1$labels$y, x = 1, y = 1)) +
geom_text(aes(x, y, label = l), angle = 90) +
theme_void() +
coord_cartesian(clip = "off")
p1$labels$y <- p2$labels$y <- " "
p4 + (p1 / (p2 | p3)) + plot_layout(widths = c(1, 25))
This behaves a bit better on resizing too.
The only way I could think of is to hack this at the gtable level, but I'd also be excited to learn more convenient ways. Here is the gtable method:
library(ggplot2)
library(patchwork)
library(grid)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p123 <- p1 / (p2 | p3)
# Convert to gtable
gt <- patchworkGrob(p123)
# Stretching one y-axis title
is_yaxis_title <- which(gt$layout$name == "ylab-l")
# Find new bottom position based on gtable::gtable_show_layout(gt)
gt$layout$b[is_yaxis_title] <- gt$layout$b[is_yaxis_title] + 18
# Deleting other y-axis title in sub-patchwork
is_patchwork <- which(gt$layout$name == "patchwork-table")
pw <- gt$grobs[[is_patchwork]]
pw <- gtable::gtable_filter(pw, "ylab-l", invert = TRUE)
# Set background to transparent
pw$grobs[[which(pw$layout$name == "background")[1]]]$gp$fill <- NA
# Putting sub-patchwork back into main patchwork
gt$grobs[[is_patchwork]] <- pw
# Render
grid.newpage(); grid.draw(gt)
Created on 2020-12-14 by the reprex package (v0.3.0)
Another way to do this with gridExtra.
library(ggplot2)
library(patchwork)
library(gridExtra)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg") +
theme(axis.title.y = element_blank())
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear") +
theme(axis.title.y = element_blank())
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
grid.arrange(patchworkGrob(p1 / (p2 | p3)), left = "disp_disp_disp_disp_disp")

How can I align multiple plots by their titles instead of plot area?

I'm using egg to align multiple plots on a page. I'm wondering if it's possible to align two columns by the titles a) and c) instead of plot area? Thanks!
Code:
library(egg)
library(grid)
p1 <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) +
geom_point() + ggtitle("a)")
p1
p2 <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) +
geom_point() + facet_wrap(~ cyl, ncol = 2, scales = "free") +
guides(colour = "none") +
theme() + ggtitle("b)")
p2
p3 <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) +
geom_point() + facet_grid(. ~ am, scales = "free") + guides(colour="none") +
ggtitle("c)")
p3
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
g3 <- ggplotGrob(p3)
fg1 <- gtable_frame(g1, debug = TRUE)
fg2 <- gtable_frame(g2, debug = TRUE)
fg12 <- gtable_frame(gtable_rbind(fg1, fg2),
width = unit(2, "null"),
height = unit(1, "null"))
fg3 <-
gtable_frame(
g3,
width = unit(2, "null"),
height = unit(1, "null"),
debug = TRUE
)
grid.newpage()
combined <- gtable_cbind(fg12, fg3)
grid.draw(combined)
Plot:
I found another way by using cowplot package
left_col <- cowplot::plot_grid(p1 + ggtitle(""), p2 + ggtitle(""),
labels = c('a)', 'b)'), label_size = 14,
ncol = 1, align = 'v', axis = 'lr')
cowplot::plot_grid(left_col, p3 + ggtitle(""),
labels = c('', 'c)'), label_size = 14,
align = 'h', axis = 'b')
See also here
Edit:
A recently developed package patchwork for ggplot2 can also get the job done
library(patchwork)
{
p1 + {p2} + patchwork::plot_layout(ncol = 1)
} / p3 + patchwork::plot_layout(ncol = 2)
Adding a blank dummy faceting variable to plot p1/ a) seems like the easiest solution
p1 <- ggplot(data.frame(mtcars, dummy=''),
aes(mpg, wt, colour = factor(cyl))) +
geom_point() + ggtitle("a)") +
facet_wrap(~dummy)

Resources