Ggplot2 + Gridextra: How to Ensure Geom_Bar in Different Size Plot Grobs Result in Exact Same Bar Width

How to control plot width in gridExtra?

As per my comment (and also the comment in the middle of the @Justin answer) facet_wrap may be the way to go. It generates something like the image below. Obviously you'd need to play around with colours, legends and maybe the order of the factors, but you can see the general approach. Code follows image.

screenshot

library(ggplot2)
library(reshape)

mydf <- data.frame(day = 1:10,
upper1 = runif(10, 10000, 20000),
upper2 = runif(10, 15000, 16000),
lower1 = runif(10, 1, 10),
lower2 = runif(10, 3, 8))

mydf.melt <- melt(mydf, id.var = 'day')
mydf.melt$grouping <- ifelse(mydf.melt$value >= 10000, "upper", "lower")

ggplot(mydf.melt, aes(x = day, y = value, group = variable)) +
geom_line() +
facet_wrap(~ grouping, ncol = 1, scales = "free_y")

auto-size and fixed width bars in spited plot

you can dig out the number of breaks, and from there modify each plot to ensure they all have as many breaks by adding dummy ones to the x scale,

how_many <- function(p){
gb <- ggplot_build(p)
length(gb$layout$panel_params[[1]][['x.major']])
}

raxe <- function(p, n){

gb <- ggplot_build(p)
x_params <- gb$layout$panel_params[[1]]
ni <- length(x_params[['x.major']])
labels <- x_params[['x.labels']]
if(ni < n){
dummy <- c(labels, paste0("__",letters[seq_len(n-ni)]))
print(dummy)
phantom <- c(labels, rep('', n-ni))
return(p + scale_x_discrete(lim=dummy, labels=phantom))
}
p
}

n_breaks <- sapply(p_list, how_many)
p_list <- lapply(p_list, raxe, max(n_breaks))

egg::ggarrange(plots = p_list, ncol=2)

How can I make consistent-width plots in ggplot (with legends)?

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)

Sample Image

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)

R ggplot2 facetting keep ratio but override/define output plot size

you can edit the gtable setting the heights to physical units (e.g. cm) instead of relative ("null")

require(ggplot2)
p = qplot(Sepal.Width, Sepal.Length, data=iris) + facet_wrap(~Species, ncol=1)
g = ggplotGrob(p)

panels = which(sapply(g[["heights"]], "attr", "unit") == "null")
g[["heights"]][panels] = list(unit(4, "cm"), unit(8, "cm"), unit(2, "cm"))

device.height = convertHeight(sum(g[["heights"]]), "in", valueOnly=TRUE)

pdf("test.pdf", height = device.height)
grid.draw(g)
dev.off()

Sample Image

Edit As a follow-up, here's a function to set the height and width of all panels to a fixed value,

freeze_panels <- function(p, draw=TRUE,
width=unit(5,"cm"),
height=unit(1,"in")){
require(grid)
g <- ggplotGrob(p)

vertical_panels <-which(sapply(g[["heights"]], "attr", "unit") == "null")
horizontal_panels <-which(sapply(g[["widths"]], "attr", "unit") == "null")

g[["heights"]][vertical_panels] <- replicate(length(vertical_panels),
height, simplify=FALSE)

g[["widths"]][horizontal_panels] <- replicate(length(horizontal_panels),
width, simplify=FALSE)

device.height <- convertHeight(sum(g[["heights"]]), "in", valueOnly=TRUE)
device.width <- convertWidth(sum(g[["widths"]]), "in", valueOnly=TRUE)
if(draw){
dev.new(height=device.height, width=device.width)
grid.newpage()
grid.draw(g)
}
invisible(g)
}

require(ggplot2)
d1 <- subset(mtcars, carb != 8)
d2 <- subset(mtcars, carb %in% c(1,2,3))
p = qplot(vs, am, data=d1) + facet_wrap(~carb)

freeze_panels(p)
freeze_panels(p %+% d2)
freeze_panels(p %+% d2 + facet_wrap(~carb, ncol=1))

ggplot2: Drop unused factors in a faceted bar plot but not have differing bar widths between facets

How about this:

df$w <- 0.9
df$w[df$TIME == 5] <- 0.9 * 3/4
ggplot(df, aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~TIME, ncol=1, scale="free") +
geom_bar(position="stack",aes(width = w),stat = "identity") +
coord_flip()

Sample Image

Not sure if I got the arithmetic right there, but you get the idea.

ggplot2 legend width and legend strings size

You can set the gtable widths to a common value,

library(gtable)
library(grid)
gl <- lapply(list(p1, p2), ggplotGrob)

gwidth <- do.call(unit.pmax, lapply(gl, "[[", "widths"))
gl <- lapply(gl, "[[<-", "widths", value = gwidth)
gridExtra::grid.arrange(grobs=gl)

Alternatively, you can set the panel size to a fixed value.



Related Topics



Leave a reply



Submit