ggplot2 + gridExtra: how to ensure geom_bar in different size plot grobs result in exact same bar width

This question is motivated by further exploring this question. The problem with the accepted solution becomes more obvious when there is a greater disparity in the number of bars per facet. Take a look at this data and the resultant plot using that solution:

这个问题的动机是进一步探索这个问题。当每个小平面的条数存在较大差异时，接受的解决方案的问题变得更加明显。使用该解决方案查看此数据和结果图：

# create slightly contrived data to better highlight width problems
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
                   TYPE=factor(rep(1:3,length(ID)/3)),
                   TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
                   VAL=runif(27))

# implement previously suggested solution
base.width <- 0.9
data$w <- base.width
# facet two has 3 bars compared to facet one's 5 bars
data$w[data$TIME==2] <- base.width * 3/5
# facet 3 has 1 bar compared to facet one's 5 bars
data$w[data$TIME==3] <- base.width * 1/5
ggplot(data, 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()

You'll notice the widths look exactly right, but the whitespace in facet 3 is quite glaring. There is no easy way to fix this in ggplot2 that I have seen yet (facet_wrap does not have a space option).

你会注意到宽度看起来完全正确，但是facet 3中的空白非常明显。在我看过的ggplot2中没有简单的方法来解决这个问题（facet_wrap没有空格选项）。

Next step is to try to solve this using gridExtra:

下一步是尝试使用gridExtra解决这个问题：

# create each of the three plots, don't worry about legend for now
p1 <- ggplot(data[data$TIME==1,], aes(x=ID, y=VAL, fill=TYPE)) +
  facet_wrap(~ TIME, ncol=1) +
  geom_bar(position="stack", show_guide=FALSE) +
  coord_flip()
p2 <- ggplot(data[data$TIME==2,], aes(x=ID, y=VAL, fill=TYPE)) +
  facet_wrap(~ TIME, ncol=1) +
  geom_bar(position="stack", show_guide=FALSE) +
  coord_flip()
p3 <- ggplot(data[data$TIME==3,], aes(x=ID, y=VAL, fill=TYPE)) +
  facet_wrap(~ TIME, ncol=1) +
  geom_bar(position="stack", show_guide=FALSE) +
  coord_flip()

# use similar arithmetic to try and get layout correct
require(gridExtra)
heights <- c(5, 3, 1) / sum(5, 3, 1)
print(arrangeGrob(p1 ,p2, p3, ncol=1,
            heights=heights))

You'll notice I used the same arithmetic previously suggested based off the number of bars per facet, but in this case it ends up horribly wrong. This seems to be because there are extra "constant height" elements that I need to take into consideration in the math.

你会注意到我使用了之前基于每个方面的柱数来建议的相同算法，但在这种情况下，它最终会出现可怕的错误。这似乎是因为我需要在数学中考虑额外的“恒定高度”元素。

Another complication (I believe) is that the final output (and whether or not the widths match) will also depend on the width and height of where I'm outputting the final grob to, whether its in a R/RStudio environment, or to a PNG file.

另一个复杂因素（我相信）是最终输出（以及宽度是否匹配）也将取决于我输出最终grob的位置的宽度和高度，无论是在R / RStudio环境中，还是一个PNG文件。

How can I accomplish this?

我怎么能做到这一点？

2 个解决方案

#1

Something like this appear to work, but it doesn't - not completely. It has the appearance of working because the levels of the ID factor are sequential. Anything else, and scale = "free" fails. But it might be possible to develop further. The method uses facet_grid, and thus space = "free" can be used. The method uses geom_rect to layer differently coloured rectangles on top of each other. It needs cumulative sums to be calculated so that the right-hand edge of each rectangle can be positioned.

这样的东西似乎有用，但它不是 - 不完全。它具有工作的外观，因为ID因子的级别是连续的。其他任何东西，scale =“free”都会失败。但它有可能进一步发展。该方法使用facet_grid，因此可以使用space =“free”。该方法使用geom_rect将不同颜色的矩形层叠在一起。它需要计算累积和，以便可以定位每个矩形的右边缘。

data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
                   TYPE=factor(rep(1:3,3)),
                   TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
                   VAL=runif(27))

library(ggplot2)
library(plyr)

# Get the cumulative sums
data = ddply(data, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))

ggplot(data, aes(x=VAL, y = as.numeric(ID), fill=TYPE)) +
   geom_rect(data = subset(data, TYPE == 3), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
   geom_rect(data = subset(data, TYPE == 2), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
   geom_rect(data = subset(data, TYPE == 1), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
   facet_grid(TIME~., space = "free", scale="free") +
   scale_y_continuous(breaks = c(1:5), expand = c(0, 0.2))

EDIT: OR really thick lines work a little better (I think)

编辑：或真的粗线工作好一点（我认为）

ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
       geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
       geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
       geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
       facet_grid(TIME~., space = "free", scale="free") 

Additional Edit Taking the data from your earleir post, and modifying it a little.
Updated opts is deprecated; using theme instead.

附加编辑从您的earleir帖子中获取数据，并稍微修改它。更新的opts已弃用;使用主题代替。

df <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("a", 
"b", "c", "d", "e", "f", "g"), class = "factor"), TYPE = structure(c(1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 
1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 
5L, 6L, 1L, 2L, 3L), .Label = c("1", "2", "3", "4", "5", "6", 
"7", "8"), class = "factor"), TIME = structure(c(2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 
1L, 1L, 1L), .Label = c("One", "Five", "Fifteen"), class = "factor"), VAL = c(0.937377670081332, 
0.522220720537007, 0.278690102742985, 0.967633064137772, 0.116124767344445, 
0.0544306698720902, 0.470229141646996, 0.62017166428268, 0.195459847105667, 
0.732876230962574, 0.996336271753535, 0.983087373664603, 0.666449476964772, 
0.291554537601769, 0.167933790013194, 0.860138458199799, 0.172361251665279, 
0.833266809117049, 0.620465772924945, 0.786503327777609, 0.761877260869369, 
0.425386636285111, 0.612077651312575, 0.178726130630821, 0.528709076810628, 
0.492527724476531, 0.472576208412647, 0.0702785139437765, 0.696220921119675, 
0.230852259788662, 0.359884874196723, 0.518227979075164, 0.259466265095398, 
0.149970305617899, 0.00682218233123422, 0.463400925742462, 0.924704828299582, 
0.229068386601284)), .Names = c("ID", "TYPE", "TIME", "VAL"), row.names = c(NA, 
-38L), class = "data.frame")

library(ggplot2)
library(plyr)

data = ddply(df, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))

ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
           geom_segment(data = subset(data, TYPE == 6), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           geom_segment(data = subset(data, TYPE == 5), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           geom_segment(data = subset(data, TYPE == 4), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
           facet_grid(TIME~., space = "free", scale="free") +
           theme(strip.text.y = element_text(angle = 0))

#2

Changing the gtable doesn't help, unfortunately, as the bar width is in relative units,

遗憾的是，改变gtable并没有帮助，因为条形宽度是相对单位，

g = ggplot_gtable(ggplot_build(p))
panels = which(sapply(g$heights, attr, "unit") == "null")
g$heights[[panels[1]]] <- unit(5, "null")
g$heights[[panels[2]]] <- unit(3, "null")
g$heights[[panels[3]]] <- unit(1, "null")
grid.draw(g)