Creating composite figures with ggplot2 for reproducible research
[This article was first published on bioCS, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
So far, I have been preparing composite figures by plotting the data using ggplot2, and then putting the panels together in OmniGraffle or Adobe Illustrator. Of course, every time the data is updated, I would need to go back to the vector editing program. After moving my manuscript from Word to knitr, I figured I should also try to cut out the image editing step. Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
ggplot2 does not make it easy to put different panels together in a seamless fashion and without any margins. However, by piecing together different StackOverflow answers, I found a way to extract different parts of the figures, and glue them back together with the gtable package. I can now produce a plot like this without a trip to Illustrator!
The solution is still a bit fragile, as the different dimensions of the PNG image and the rows and columns need to be adjusted manually to make it look right. Here is a minimal working example (with some superfluous steps, I’m sure):
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(ggplot2) | |
library(gtable) | |
# create example data | |
set.seed(42) | |
dataset_names <- c("Human", "Mouse", "Fly", "Worm") | |
datasets <- data.frame(name = factor(dataset_names, levels=dataset_names), parity = factor(c(0, 0, 1, 0)), v50 = runif(4, max=0.5), y=1:4) | |
data <- data.frame( dataset1 = rep(datasets$name, 4), dataset2 = rep(datasets$name, each = 4), z = runif(16,min = 0, max = 0.5) ) | |
pal <- c("#dddddd", "#aaaaaa") | |
## set up individual plots | |
# heatmap | |
new_theme_empty <- theme_bw() | |
new_theme_empty$line <- element_blank() | |
new_theme_empty$rect <- element_blank() | |
new_theme_empty$strip.text <- element_blank() | |
new_theme_empty$axis.text <- element_blank() | |
new_theme_empty$plot.title <- element_blank() | |
new_theme_empty$axis.title <- element_blank() | |
new_theme_empty$legend.position <- "none" | |
new_theme_empty$plot.margin <- structure(c(0, 0, 0, 0), unit = "lines", valid.unit = 3L, class = "unit") | |
new_theme_empty$axis.ticks <- element_blank() | |
new_theme_empty$axis.title.x <- element_blank() | |
new_theme_empty$axis.title.y <- element_blank() | |
p <- ggplot( data, aes(dataset1, dataset2, fill=z) ) + geom_raster() | |
p <- p + coord_fixed() | |
p <- p + scale_fill_gradient2(midpoint=0.5, mid="black", low="#56B1F7", high="red", name="", breaks=c(0,0.25,0.5,0.75,1), limits=c(0,0.5)) | |
p <- p + scale_x_discrete(expand=c(0,0)) + scale_y_discrete(expand=c(0,0)) | |
plegend <- p + theme(legend.direction="horizontal") | |
pmiddle <- p + new_theme_empty | |
# top bar chart | |
theme_partly_empty <- theme_bw() | |
theme_partly_empty$rect <- element_blank() | |
theme_partly_empty$strip.text <- element_blank() | |
theme_partly_empty$axis.text.x <- element_blank() | |
theme_partly_empty$plot.title <- element_blank() | |
theme_partly_empty$legend.position <- "none" | |
theme_partly_empty$plot.margin <- structure(c(0, 0, 0, 0), unit = "lines", valid.unit = 3L, class = "unit") | |
theme_partly_empty$axis.ticks.x <- element_blank() | |
theme_partly_empty$axis.title.x <- element_blank() | |
theme_partly_empty$panel.grid.major.x <-element_blank() | |
theme_partly_empty$panel.grid.minor <-element_blank() | |
p <- ggplot( datasets, aes(name, v50, fill=parity)) + geom_bar(stat="identity") | |
p <- p + theme_partly_empty | |
p <- p + scale_fill_manual(values=pal) | |
p <- p + scale_y_continuous(expand=c(0,0), breaks=0.1*1:5) + scale_x_discrete(expand=c(0,0)) | |
p <- p + ylab(expression(v[50])) | |
ptop <- p | |
# right bar chart | |
theme_partly_empty <- theme_bw() | |
theme_partly_empty$rect <- element_blank() | |
theme_partly_empty$strip.text <- element_blank() | |
theme_partly_empty$plot.title <- element_blank() | |
theme_partly_empty$legend.position <- "none" | |
theme_partly_empty$plot.margin <- structure(c(0, 0, 0, 0), unit = "lines", valid.unit = 3L, class = "unit") | |
theme_partly_empty$axis.text.y <- element_blank() | |
theme_partly_empty$axis.ticks.y <- element_blank() | |
theme_partly_empty$axis.title.y <- element_blank() | |
theme_partly_empty$panel.grid.major.y <-element_blank() | |
theme_partly_empty$panel.grid.minor <-element_blank() | |
p <- ggplot( datasets, aes(name, v50, fill=parity)) + geom_bar(stat="identity") + coord_flip() | |
p <- p + theme_partly_empty | |
p <- p + scale_fill_manual(values=pal) | |
p <- p + scale_y_continuous(expand=c(0,0), breaks=0.1*1:5) + scale_x_discrete(expand=c(0,0)) | |
p <- p + ylab(expression(v[50])) | |
pright <- p | |
# left strip of labels | |
p <- ggplot( datasets, aes(xmin=0, xmax=1, ymin=y, ymax=y+1, fill=parity)) + geom_rect() | |
p <- p + new_theme_empty | |
p <- p + scale_fill_manual(values=pal) | |
p <- p + geom_text(aes(x=1, y=y+0.5, label=paste0(name, " ")), hjust=1, vjust=0.5) | |
p <- p + scale_y_discrete(expand = c(0,0)) + scale_x_continuous(expand=c(0,0)) | |
pleft <- p | |
# bottom strip of labels | |
p <- ggplot( datasets, aes(xmin=y, xmax=y+1, ymin=0, ymax=1, fill=parity)) + geom_rect() | |
p <- p + new_theme_empty | |
p <- p + scale_fill_manual(values=pal) | |
p <- p + geom_text(aes(y=1, x=y+0.5, label=paste0(name, " ")), hjust=1, vjust=0.5, angle=90) | |
p <- p + scale_x_discrete(expand = c(0,0)) + scale_y_continuous(expand = c(0,0)) | |
pbottom <- p | |
## create the layout, centered around the heatmap | |
g <- gtable_filter(ggplotGrob(pmiddle), pattern = "panel", trim = TRUE, fixed=TRUE) | |
g <- gtable_add_rows(g, unit(0.2, "null"), 0) # left labels | |
g <- gtable_add_rows(g, unit(0.2, "null"), 2) # right bar chart | |
g <- gtable_add_rows(g, unit(0.05, "null"), 2) # space for axis label 1/2 | |
g <- gtable_add_rows(g, unit(0.05, "null"), 2) # space for axis label 2/2 | |
g <- gtable_add_cols(g, unit(0.05, "null"), 0) # space for axis label 1/2 | |
g <- gtable_add_cols(g, unit(0.05, "null"), 0) # space for axis label 2/2 | |
g <- gtable_add_cols(g, unit(0.2, "null"), 0) # top bar chart | |
g <- gtable_add_cols(g, unit(0.2, "null"), 4) # bottom labels | |
# gtable_show_layout(g) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(ptop), pattern = "ylab", trim = TRUE, fixed=TRUE), 1, 2) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(ptop), pattern = "axis-l", trim = TRUE, fixed=TRUE), 1, 3) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(ptop), pattern = "panel", trim = TRUE, fixed=TRUE), 1, 4) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(pleft), pattern = "panel", trim = TRUE, fixed=TRUE), 2, 1, 2, 3) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(pbottom), pattern = "panel", trim = TRUE, fixed=TRUE), 3, 4, 5) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(pright), pattern = "panel", trim = TRUE, fixed=TRUE), 2, 5) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(pright), pattern = "axis-b", trim = TRUE, fixed=TRUE), 3, 5) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(pright), pattern = "xlab", trim = TRUE, fixed=TRUE), 4, 5) | |
g <- gtable_add_grob(g, gtable_filter(ggplotGrob(plegend), pattern = "guide-box", trim = TRUE, fixed=TRUE), 5, 1, 5, 3) | |
g <- gtable_add_grob(g, textGrob("\nMedian expression\ndistance of\n1:1 orthologs\n\n\n\n", gp = gpar(fontsize = 12)), 3, 1, 5, 3) | |
grid.newpage() | |
grid.draw(g) | |
png(paste0("test.png"), width = 10, height = 10, units = "in", res=300) | |
grid.draw(g) | |
dev.off() | |
To leave a comment for the author, please follow the link and comment on their blog: bioCS.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.