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)
I'm trying to display three time series using facet_grid() and in order to save space, I'm reducing panel spacing between them. The problem is that their vertical axis overlap so I want to move it to the right only on the plot in the middle.
Since this seem impossible in ggplot2, what I'm trying to do is to render every axis and then remove it editing the gtable but so far I was not successful.
This is a minimal example:
library(ggplot2)
set.seed(123)
df <- data.frame(expand.grid(x = 1:150, type = letters[1:3]))
df$y <- df$x*0.016 + rnorm(150, sd = .5)
ggplot(df, aes(x, y)) + geom_line() +
facet_grid(type~.) +
theme(panel.spacing.y = unit(-3, "lines"), strip.text = element_blank()) +
scale_y_continuous(sec.axis = dup_axis(name = ""), name = "y")
Which produces this:
And I want to delete each axis text to get to this:
Thanks!
The solution was to assign a nullGrob() to the relevant elements of the gTable.
gt <- ggplotGrob(g)
t <- gt[["grobs"]][[8]][["children"]][[2]]
# Found those grobs by looking around the table.
gt[["grobs"]][[8]][["children"]][[2]] <- nullGrob()
gt[["grobs"]][[10]][["children"]][[2]] <- nullGrob()
gt[["grobs"]][[12]][["children"]][[2]] <- nullGrob()
grid.newpage()
grid.draw(gt)
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)
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.
Suppose I have two plots, side by side, with the same y-axis, generated by the following R code:
df <- data.frame(x=c(5,2,7,3), y=c(11,3,5,6), facet=c(1,1,2,2))
ggplot(df, aes(x, y)) + facet_grid(~facet) + geom_point()
Is it possible to write the y axis text (e.g., 10.0, 7.5, 5.0) in the middle, between the two plots? (Preferentially the text should be centered.)
Here is a way (well almost) using Baptiste's answer from this SO post Display y-axis for each subplot when faceting. Not quite in the middle but its close
library(ggplot2)
library(gtable)
# your data
df <- data.frame(x=c(5,2,7,3), y=c(11,3,5,6), facet=c(1,1,2,2))
# First plot (a bit of extra space between facets)
p <- ggplot(df, aes(x, y)) + facet_grid(~facet) +
geom_point() +
theme(panel.margin = unit(1, "lines"),
axis.text.y = element_text( hjust=0))
# get y-axis labels
g <- ggplotGrob(p)
axis <- gtable_filter(g, "axis-l")[["grobs"]][[1]][["children"]][["axis"]][,1]
# remove axis
g[["grobs"]][[4]][["children"]][["axis"]] <- NULL
# build plot & add axis to LHS of left facet
panels <- subset(g$layout, name == "panel")
g <- gtable_add_grob(g, grobs=axis, t = unique(panels$t), l=tail(panels$l, -1)-1)
grid.newpage()
grid.draw(g)