Как я могу сделать графики согласованной ширины в ggplot (с легендами)?

Ответ 1

Изменить: Очень легко с пакетом egg, доступным в github

# install.package(devtools)
# devtools::install_github("baptiste/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)

Оригинал Устаревший к ggplot2 2.2.1

Здесь используется решение, которое использует функции из пакета gtable и фокусируется на ширинах полей легенды. (Более общее решение можно найти здесь.)

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)

Если, кроме того, поля легенды необходимо оставить обоснованными и заимствовать код здесь, написанный @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)

Альтернативные решения В пакете gtable есть функции rbind и cbind для объединения grobs в один grob. Для диаграмм здесь ширины должны быть установлены с помощью size = "max", но версия CRAN gtable выдает ошибку.

Один вариант: должно быть очевидно, что легенда на втором графике шире. Поэтому используйте опцию size = "last".

# 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)

Левые легенды:

# 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)

Второй вариант - использовать rbind из пакета Baptiste gridExtra

# 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)

Левые легенды:

# 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)

Ответ 2

Пакет cowplot также имеет функцию align_plots для этой цели (вывод не показан),

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)

а также plot_grid, который сохраняет графики в тот же файл.

library(cowplot)
both <- plot_grid(p1, p2, ncol=1, labels = c("A", "B"), align = "v")
save_plot("cow.png", both)

Ответ 3

Как указывает @hadley, rbind.gtable должен иметь возможность справиться с этим,

  grid.draw(rbind(ggplotGrob(p1), ggplotGrob(p2), size="last"))

однако, в идеале ширина макета должна быть size="max", которая не справляется хорошо с некоторыми типами узлов сетки.

Ответ 4

Просто случайно я заметил, что решение Аруна, которое он предложил в своих комментариях, не было подобрано. Я считаю, что его простой и эффективный подход действительно стоит проиллюстрировать.

Арун предложил переместить легенду сверху или снизу:

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")

Теперь графики имеют ту же ширину, что и запрос. Кроме того, площадь участка одинакового размера в обоих случаях.

Если есть больше факторов или даже более длинных меток, может возникнуть необходимость играть с легендой, например, для отображения легенды в двух или более строках. theme() и guide_legend() имеют несколько параметров для управления положением и появлением легенд в ggplot2.

Ответ 5

Я создал небольшую функцию, основанную на ответе @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)

Перед

После