Common legend and identical plot width for multi-panel plot - r

I was wondering if there is a way to have a common legend and at the same time identical plot widths for a multi-panel plot. I know how to get identical plot widths without a legend, or with a legend that is not vertically centered.
Here's Hadley's fix that I use for the common legend (https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs):
library(ggplot2)
library(gridExtra)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data=dsamp, colour=clarity)
p2 <- qplot(carat, price, data=dsamp, colour=clarity, geom="path")
g_legend<-function(p){
tmp <- ggplotGrob(p)
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)}
legend <- g_legend(p1)
lwidth <- sum(legend$width)
## using grid.arrange for convenience
## could also manually push viewports
grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
main ="this is a title",
left = "This is my global Y-axis title"), legend,
widths=unit.c(unit(1, "npc") - lwidth, lwidth), nrow=1)
To illustrate my point, I changed p2 by adding two other variables of the same dataset keeping clarity as the common legend:
p1 <- qplot(carat, price, data=dsamp, colour=clarity)
p2 <- qplot(depth, table, data=dsamp, colour=clarity, geom="path")
g_legend<-function(p){
tmp <- ggplotGrob(p)
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)}
legend <- g_legend(p1)
lwidth <- sum(legend$width)
## using grid.arrange for convenience
## could also manually push viewports
grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
main ="this is a title",
left = "This is my global Y-axis title"), legend,
widths=unit.c(unit(1, "npc") - lwidth, lwidth), nrow=1)
This may not make sense in this example, but I have four different measurements on the same experimental units, which I want to graphically display in 2 plots with same plot widths and a common vertically centered legend.

I think you can achieve your goal better with faceting:
ggplot(dsamp, aes(x = carat, y = price, colour = clarity)) +
geom_point(data = cbind(dsamp, group = 1)) +
geom_path(data = cbind(dsamp, group = 2)) +
facet_grid(group ~ .) +
theme(strip.text.y = element_blank(),
strip.background = element_blank()) +
ggtitle("this is a title")
I've assumed that you have identical variables in your plots as in your example. Otherwise, I've had to use a lot of tinkering when I needed to align plots myself: See scatterplot with alpha transparent histograms in R for an example.

Related

R, how to set multiple bar_chart plots to have the same width through grid.arrange? [duplicate]

I've got a few different categories that I want to plot. These are different categories, each with their own set of labels, but which makes sense to group together in the document. The following gives some simple stacked bar chart examples:
df <- data.frame(x=c("a", "b", "c"),
y=c("happy", "sad", "ambivalent about life"))
ggplot(df, aes(x=factor(0), fill=x)) + geom_bar()
ggplot(df, aes(x=factor(0), fill=y)) + geom_bar()
The problem is that with different labels, the legends have different widths, which means the plots have different widths, leading to things looking a bit goofy if I make a table or \subfigure elements. How can I fix this?
Is there a way to explicitly set the width (absolute or relative) of either the plot or the legend?
Edit: Very easy with egg package
# install.packages("egg")
library(egg)
p1 <- ggplot(data.frame(x=c("a","b","c"),
y=c("happy","sad","ambivalent about life")),
aes(x=factor(0),fill=x)) +
geom_bar()
p2 <- ggplot(data.frame(x=c("a","b","c"),
y=c("happy","sad","ambivalent about life")),
aes(x=factor(0),fill=y)) +
geom_bar()
ggarrange(p1,p2, ncol = 1)
Original Udated to ggplot2 2.2.1
Here's a solution that uses functions from the gtable package, and focuses on the widths of the legend boxes. (A more general solution can be found here.)
library(ggplot2)
library(gtable)
library(grid)
library(gridExtra)
# Your plots
p1 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=x)) + geom_bar()
p2 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=y)) + geom_bar()
# Get the gtables
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# Set the widths
gA$widths <- gB$widths
# Arrange the two charts.
# The legend boxes are centered
grid.newpage()
grid.arrange(gA, gB, nrow = 2)
If in addition, the legend boxes need to be left justified, and borrowing some code from here written by #Julius
p1 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=x)) + geom_bar()
p2 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=y)) + geom_bar()
# Get the widths
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# The parts that differs in width
leg1 <- convertX(sum(with(gA$grobs[[15]], grobs[[1]]$widths)), "mm")
leg2 <- convertX(sum(with(gB$grobs[[15]], grobs[[1]]$widths)), "mm")
# Set the widths
gA$widths <- gB$widths
# Add an empty column of "abs(diff(widths)) mm" width on the right of
# legend box for gA (the smaller legend box)
gA$grobs[[15]] <- gtable_add_cols(gA$grobs[[15]], unit(abs(diff(c(leg1, leg2))), "mm"))
# Arrange the two charts
grid.newpage()
grid.arrange(gA, gB, nrow = 2)
Alternative solutions There are rbind and cbind functions in the gtable package for combining grobs into one grob. For the charts here, the widths should be set using size = "max", but the CRAN version of gtable throws an error.
One option: It should be obvious that the legend in the second plot is wider. Therefore, use the size = "last" option.
# Get the grobs
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# Combine the plots
g = rbind(gA, gB, size = "last")
# Draw it
grid.newpage()
grid.draw(g)
Left-aligned legends:
# Get the grobs
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# The parts that differs in width
leg1 <- convertX(sum(with(gA$grobs[[15]], grobs[[1]]$widths)), "mm")
leg2 <- convertX(sum(with(gB$grobs[[15]], grobs[[1]]$widths)), "mm")
# Add an empty column of "abs(diff(widths)) mm" width on the right of
# legend box for gA (the smaller legend box)
gA$grobs[[15]] <- gtable_add_cols(gA$grobs[[15]], unit(abs(diff(c(leg1, leg2))), "mm"))
# Combine the plots
g = rbind(gA, gB, size = "last")
# Draw it
grid.newpage()
grid.draw(g)
A second option is to use rbind from Baptiste's gridExtra package
# Get the grobs
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# Combine the plots
g = gridExtra::rbind.gtable(gA, gB, size = "max")
# Draw it
grid.newpage()
grid.draw(g)
Left-aligned legends:
# Get the grobs
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
# The parts that differs in width
leg1 <- convertX(sum(with(gA$grobs[[15]], grobs[[1]]$widths)), "mm")
leg2 <- convertX(sum(with(gB$grobs[[15]], grobs[[1]]$widths)), "mm")
# Add an empty column of "abs(diff(widths)) mm" width on the right of
# legend box for gA (the smaller legend box)
gA$grobs[[15]] <- gtable_add_cols(gA$grobs[[15]], unit(abs(diff(c(leg1, leg2))), "mm"))
# Combine the plots
g = gridExtra::rbind.gtable(gA, gB, size = "max")
# Draw it
grid.newpage()
grid.draw(g)
The cowplot package also has the align_plots function for this purpose (output not shown),
both2 <- align_plots(p1, p2, align="hv", axis="tblr")
p1x <- ggdraw(both2[[1]])
p2x <- ggdraw(both2[[2]])
save_plot("cow1.png", p1x)
save_plot("cow2.png", p2x)
and also plot_grid which saves the plots to the same file.
library(cowplot)
both <- plot_grid(p1, p2, ncol=1, labels = c("A", "B"), align = "v")
save_plot("cow.png", both)
As #hadley suggests, rbind.gtable should be able to handle this,
grid.draw(rbind(ggplotGrob(p1), ggplotGrob(p2), size="last"))
however, the layout widths should ideally be size="max", which doesn't cope well with some types of grid units.
Just by chance, I noticed that Arun's solution he had suggested in his comments hasn't been picked up. I feel his simple and efficient approach is really worth to be illustrated.
Arun suggested to move the legend to the top or bottom:
ggplot(df, aes(x=factor(0), fill=x)) + geom_bar() + theme(legend.position = "bottom")
ggplot(df, aes(x=factor(0), fill=y)) + geom_bar() + theme(legend.position = "bottom")
Now, the plots have the same width as requested. In addition, the plot area is equally sized in both cases.
If there are more factors or even longer labels, it might become necessary to play around with the legend, e.g., to display the legend in two ore more rows. theme() and guide_legend() have several parameters to control the position and appearance of legends in ggplot2.
I created a little function based on the answer of #Sandy.
same.size.ggplot <- function(vector.string.graph, # a vector of strings which correspond to Robject ggplot graphs
reference.string.graph, # a string of a Robject ggplot graphs where height and/or height will be taken for reference
width = T, # if you wanna adapat only the width
height = F # if you wanna adapat only the height
) {
# example: same.size.ggplot(p0rep(c("a", "b"), thre), "a30")
which(vector.string.graph %in% reference.string.graph)
newref <- ggplotGrob(get(reference.string.graph))
ref.width <- newref$widths
ref.height <- newref$heights
assign(reference.string.graph, newref, env = parent.frame(1))
for(i in seq_along(vector.string.graph)) {
if(vector.string.graph[i] != reference.string.graph) {
new <- ggplotGrob(get(vector.string.graph[i]))
if( width ) {
new$widths <- ref.width
}
if( height ) {
new$heights <- ref.height
}
assign(vector.string.graph[i], new, env = parent.frame(1))
}
}
}
p1 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=x)) + geom_bar()
p2 <- ggplot(data.frame(x=c("a","b","c"),y=c("happy","sad","ambivalent about life")),aes(x=factor(0),fill=y)) + geom_bar()
p3 <- ggplot(data.frame(x=c("a","b","c"),y=c("Crazy happy","sad","Just follow the flow")),aes(x=factor(0),fill=y)) + geom_bar()
grid.arrange(p1, p2, p3, ncol = 1)
same.size.ggplot(c("p1", "p2", "p3"), "p2") # same as same.size.ggplot(c("p2", "p3"), "p1")
grid.arrange(p1, p2, p3, ncol = 1)
Before
After
You could also use the patchwork-package for that:
require(ggplot2)
require(patchwork)
# data
df = data.frame(x = c("a", "b", "c"),
y = c("happy", "sad", "ambivalent about life"))
p1 = ggplot(df, aes(x=factor(0), fill=x)) + geom_bar()
p2 = ggplot(df, aes(x=factor(0), fill=y)) + geom_bar()
# Patchwork 1: Does it automatically
p1 / p2
# Patchwork 2: Create a list
l = patchwork::align_patches(p1, p2)

ggplot2 grid_arrange_shared_legend share axis labels

I am using grid_arrange_shared_legend to combine plots with the same legend into one plot with one legend. Is there a way to edit the function slightly so it also shares the x and y axis labels? For example, if I made 3 graphs and wanted a 3x1 grid of those graphs made with grid_arrange_shared_legend, and wanted the shared x axis label on the very bottom and the shared y axis label on the left, how would I do that?
This is the code I am using for the function:
grid_arrange_shared_legend <- function(..., ncol=1, mytitle="mytitle") {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))[["grobs"]]
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
grid.arrange(
do.call(arrangeGrob, c(ncol=ncol, lapply(plots, function(x)
x + theme(legend.position="none")))),
legend,
ncol = 1,
heights = unit.c(unit(.95, "npc") - lheight, lheight),
top=textGrob(mytitle, gp = gpar(fontsize=16)))
}
I had the same problem.
My solution was to add a blank x-axis title to each plot (to save space to add an axis title):
p1 <- p1 + xlab(" ")
and then having created the plots with shared legends:
grid_arrange_shared_legend(p1, p2, p3, position = "right")
I then added new text as a new axis title:
grid.text("My title", y= 0.02, x=0.43)

marrangeGrob but can't add legends

I used marrangeGrob() instead of facet_wrap() to produce my plots from a list of plots. However, I can't seem to add a legend.
I already extracted my legend using
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)}
However, I am unable to add it it my plot.
Does anyone know a way?
Here's an example using the built-in diamonds data frame:
library(ggplot2)
library(gridExtra)
library(dplyr)
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)}
First we'll create two plots to lay out together:
df <- count(diamonds, cut)
p1 = ggplot(df, aes(x=cut, y=n, label=format(n, big.mark=","), fill=cut)) +
geom_bar(stat="identity") +
geom_text(aes(y=0.5*n), colour="white") +
coord_flip() +
theme(legend.position="bottom")
p2 = ggplot(diamonds %>% sample_n(1000), aes(x=carat, y=price, colour=cut)) +
geom_point()
Now save the legend from p1 as a separate grob:
leg = g_legend(p1)
Lay out the two plots side-by-side using arrangeGrob and then use marrangeGrob to lay out the two-plot layout and the legend beneath it. Note that we also remove the legends from the original plots.
marrangeGrob(grobs=list(
arrangeGrob(grobs=lapply(list(p1,p2), function(p) {
p + guides(colour=FALSE, fill=FALSE)
}), ncol=2),
leg), ncol=1, nrow=2, heights=c(20,1))

ggplot2 graph, scale axis from a certain point on

How do i scale an axis with ggplot2 beginning at a certain point. Let's say we have a range from 0 to 100 and most values are within the range 1 to 10 and one value is at 100.
require('data.table')
require('ggplot2')
test <- data.table(x=1:10,y=c(seq(1,9),100))
ggplot(test, aes(x=x,y=y)) + geom_point(size=5)
I would like to create a graph with an y-scale from 1 to 10 by 1 and afterwards by 10 so the space between the value 9 and 100 gets "smaller" in the graph.
Update:
The way of eipi10 works perfect for what i want to achieve. Just one more detail i am struggling with. How do i get rid of the 2nd legend and keep the right ratio in the final plot?
and the code for the plot:
test <- data.table(x=1:10,y=c(seq(1,9),100))
p1 = ggplot(test, aes(x=x,y=y,color=x)) +
geom_point(size=5) +
scale_x_continuous(limits=c(0,10)) +
coord_cartesian(ylim=c(-0.1,10)) +
scale_y_continuous(breaks=0:10) +
theme(plot.margin=unit(c(0,0.5,0,0),"lines"))
p2 = ggplot(test, aes(x=x,y=y,color=x)) +
geom_point(size=5) + #geom_point(size=5,show.legend=FALSE) +
scale_x_continuous(limits=c(0,10)) +
coord_cartesian(ylim=c(40,110)) +
scale_y_continuous(breaks=c(50,100)) +
theme(plot.margin=unit(c(0,0.5,-0.5,0), "lines"),
axis.title.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.x=element_blank(),
legend.position="none") +
labs(y="")
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
grid.arrange(gB, gA, ncol=1, heights=c(0.15,0.85))
Update 2:
An example of the final result. Thanks again to eipi10 and his great support!
A log transformation will do that:
require('data.table')
require('ggplot2')
library(scales)
test <- data.table(x=1:10,y=c(seq(1,9),100))
ggplot(test, aes(x=x,y=y)) +
geom_point(size=5) +
scale_y_log10(breaks=c(1,3,10,30,100))
UPDATE: There's no easy way to do a broken axis with ggplot2 (because ggplot2 doesn't allow you to (easily) do things that are considered bad practice), but here's a way to get what you're looking for. (Just don't tell Hadley I told you.)
library(data.table)
library(ggplot2)
library(scales)
library(grid)
library(gridExtra)
test <- data.table(x=1:10,y=c(seq(1,9),100))
The overall strategy is to make two separate plots, one for y>=10 and one for y<10 and then put them together. We'll change the plot margins in order to control the amount of space between the top of the bottom plot and the bottom of the top plot. We'll also get rid of the x-axis ticks and labels on the top plot.
Bottom plot (y < 10):
p1 = ggplot(test[test$y<10,], aes(x=x,y=y)) +
geom_point(size=5) +
scale_x_continuous(limits=c(0,10)) +
coord_cartesian(ylim=c(-0.1,10)) +
scale_y_continuous(breaks=0:10) +
theme(plot.margin=unit(c(0,0.5,0,0),"lines"))
Top plot (y >= 10). For this one, we get rid of the x axis labels and tick marks:
p2 = ggplot(test[test$y>=10,], aes(x=x,y=y)) +
geom_point(size=5) +
scale_x_continuous(limits=c(0,10)) +
coord_cartesian(ylim=c(10.0,110)) +
scale_y_continuous(breaks=c(50,100)) +
theme(plot.margin=unit(c(0,0.5,-0.5,0), "lines"),
axis.title.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.x=element_blank()) +
labs(y="")
Left align the two plots (based on this SO answer):
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
Arrange both plots together. The heights argument determines the proportion of vertical space allotted to each plot:
grid.arrange(gB, gA, ncol=1, heights=c(0.15,0.85))
UPDATE 2: To include a legend, but also ensure that the plots are properly right justified, do the following:
1) Run the code in your updated question to create plots p1 and p2, where only p1 has a legend.
2) Extract legend as a separate grob using the function below (from this SO answer).
3) Remove the legend from p1.
4) Lay out the plots and the legend using grid.arrange and arrangeGrob.
# Function to extract the legend as a stand-alone grob
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]]
legend
}
# Extract the legend from p1
leg = g_legend(p1)
# Remove the legend from p1
p1 = p1 + theme(legend.position="none")
# Left justify the two plots
gA <- ggplotGrob(p1)
gB <- ggplotGrob(p2)
maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5])
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
# Lay out the plots and the legend
grid.arrange(arrangeGrob(gB, gA, ncol=1, heights=c(0.15,0.85)),
leg, ncol=2, widths=c(0.9,0.1))

How to selectively add box around legend key

How could I add box around legend key only for color not for size while keeping both legend keys. Code below add boxes to both mappings.
x<-1:6;
y<-factor(2:7);
z<-1:6;
df <- data.frame(x,y,z)
ggplot(df, aes(x,y)) +
geom_point(aes(colour=y, size = z) ) +
theme(legend.key = element_rect(colour = '#bdbdbd', size = 0.6))
Here is one approach using the ggplot layout and gtable. It extracts the color legend from the layout, draws boxes around each key, re-assambles the legend, then inserts the legend back into the ggplot layout.
library(ggplot2)
library(gtable)
library(grid)
x<-1:6;
y<-factor(2:7);
z<-1:6;
df <- data.frame(x,y,z)
p = ggplot(df, aes(x,y)) +
geom_point(aes(colour=y, size = z) )
# get ggplot grob
gt = ggplotGrob(p)
# Get the combined legend
leg = gtable_filter(gt, "guide-box")
# The legend has two parts.
# Get the second part - the color legend
leg2 = leg$grobs[[1]]$grobs[[2]]
# Get the locations of the top of each box containing the legend keys
# in this legend's layout
rects <- leg2$layout$t[grepl("bg", leg2$layout$name)]
# Draw boxes around each key
for(i in rects) leg2 = gtable_add_grob(leg2, grid.rect(gp = gpar(col = '#bdbdbd', fill = NA)), t = i, l = 2)
# Insert new color legend back into the combined legend
leg$grobs[[1]]$grobs[2][[1]] <- leg2
# Insert combined legend back into ggplot grob
gt$grobs[gt$layout$name == "guide-box"][[1]] <- leg
# Draw it
grid.newpage()
grid.draw(gt)
Here is a second approach (based on #Baptiste's answer here) that draw two plots: one containing the size legend, and the other containing the color legend (with boxes around the keys). It then extracts the legends from each plot's layout, combines the two legends into a single legend, then inserts the combined legend back into one of the layouts.
library(ggplot2)
library(gtable)
library(grid)
x<-1:6;
y<-factor(2:7);
z<-1:6;
df <- data.frame(x,y,z)
p1 = ggplot(df, aes(x,y)) +
geom_point(aes(colour=y, size = z) ) +
scale_colour_discrete(guide = "none")
p2 = ggplot(df, aes(x,y)) +
geom_point(aes(colour=y, size = z) ) +
scale_size(guide = "none") +
theme(legend.key = element_rect(colour = '#bdbdbd', size = 0.6))
# Get ggplot grobs
gt1 = ggplotGrob(p1)
gt2 = ggplotGrob(p2)
# Get the legends
leg1 = gtable_filter(gt1, "guide-box")
leg2 = gtable_filter(gt2, "guide-box")
# Combine the legends
leg <- rbind(leg1[["grobs"]][[1]], leg2[["grobs"]][[1]], size = "first")
# Insert legend into g1 (or g2)
gt1$grobs[gt1$layout$name == "guide-box"][[1]] <- leg
# Draw it
grid.newpage()
grid.draw(gt1)

Resources