How can a patchwork of ggplots be given a colourful title using ggtext?
Example
Suppose we have four plots
library(ggplot2)
library(patchwork)
library(ggtext)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p4 <- ggplot(mtcars) +
geom_bar(aes(gear)) +
facet_wrap(~cyl) +
ggtitle('Plot 4')
These can be arranged like so
patch <- (p1 + p2) / (p3 + p4)
patch
The patchwork can be given a title like so
patch +
plot_annotation(
title = "Here is a regular title")
A single ggplot can be given a colourful title like so
p1 +
ggtitle("Here <span style='color:#953011;'><strong>is a colourful title</strong></span>") +
theme(plot.title = element_markdown(lineheight = 1.1))
How can the patchwork of ggplots be given a colourful title. Here's my unsuccessful attempt
patch +
plot_annotation(
title = "Here<span style='color:#953011;'><strong>is a colourful title</strong></span>") +
theme(plot.title = element_markdown(lineheight = 1.1))
plot_annotation has a theme argument, so you can do
#remotes::install_github("wilkelab/ggtext")
library(ggplot2)
library(patchwork)
library(ggtext)
patch <- (p1 + p2)
patch +
plot_annotation(
title = "Here <span style='color:#953011;'><strong>is a colourful title</strong></span>",
theme = theme(plot.title = element_markdown(lineheight = 1.1)))
Related
I want to position a legend (common to all plots) in a blank space in a patchwork layout. From what I can find online I cannot manually position a legend using legend.position if I also use guides="collect" (but can use left, right etc.).
I have tried to use l <- get.legend and then + inset_element(l, 0.6, 0.6, 1, 1) however it doesn't understand l. I also tried mixing in + inset_element(gridExtra::tableGrob(l)) without luck.
My goal is to place the legend in the blank space. My actual patchwork plot is more complicated but has two blank spaces I want the legend to sit in.
MWE
library(patchwork)
library(ggplot2)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp, color = mpg)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
design <- "
1111
223#
"
p1 + p2 + p3 + plot_layout(guides = 'collect') + plot_layout(design=design, guides = "collect") &
theme(legend.position = 'right',
legend.direction = 'vertical')
Alter your design object to include a fourth element and use guide_area() to place the guide.
library(patchwork)
library(ggplot2)
design <- "
1111
2234
"
p1 + p2 + p3 + guide_area() + plot_layout(design=design, guides = "collect")
Suppose I want to merge the following six plots into one plot.
library(ggplot2)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p2 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p3 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p4 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p4 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p5 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p6 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
For this I use the package Pachwork:
library(patchwork)
(p1 | p2 | p2 ) / (p4 | p5 | p6 ) +
plot_annotation(title = "Perceptual Domain", tag_levels = 'A') &
theme(plot.title = element_text(hjust = 0.5), plot.tag = element_text(size = 15, face = "bold"))
I want to add a title for the upper three plots and a separate title for the lower three plots.
As you can see in the example I can only add one title but not a second one.
Can someone help me and show me how I can add a second title for the lower three plots?
One option to achieve your desired result would be to make separate patchworks for the top and the bottom level plots and glue them together by wrapping them inside patchwork::wrap_elements. Note that this approach requires some "manual" work to set the tag levels for the bottom level plot:
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp))
p11 <- (p1 | p1 | p1 ) +
plot_annotation(title = "Title 1", tag_levels = "A") &
theme(plot.title = element_text(hjust = 0.5), plot.tag = element_text(size = 15, face = "bold"))
p12 <- (p1 | p1 | p1 ) +
plot_annotation(title = "Title 2", tag_levels = list(c("D", "E", "F"))) &
theme(plot.title = element_text(hjust = 0.5), plot.tag = element_text(size = 15, face = "bold"))
wrap_elements(p11) / wrap_elements(p12)
we want to change the color and size of tag using patchwork, but no changes occur
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
p3 <- ggplot(mtcars) + geom_bar(aes(gear)) + facet_wrap(~cyl)
# Add title, etc. to a patchwork
p1 + p2 + plot_annotation('This is a title', caption = 'made with patchwork')
# Change styling of patchwork elements
p1 + p2 +
plot_annotation(
title = 'This is a title',
caption = 'made with patchwork',
theme = theme(plot.title = element_text(size = 16,color="red"))
)
# Add tags to plots
p1 / (p2 | p3) +
plot_annotation(tag_levels = 'A',theme = theme(plot.tag = element_text(color = "red")))
With the '&' synthax describe in the website it seems to work well.
p1 / (p2 | p3) +
plot_annotation(tag_levels = 'A') &
theme(plot.tag = element_text(color = "red"))
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")
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")