r - ggplot2在使用facet时控制每行面板的数量？

Question

是否可以控制 ggplot 中每行的面板数量？我只能在每行上获得相同数量的面板，如下面的示例图所示。


例如，我的数据由“标记”自然分组为 22 个块，而“标记”又由“染料”组织(参见下面的示例代码和数据)。在这个例子中，我想将面板排列成 4 行，每行分别有 5、6、6 和 5 个面板(如最后的图片所示，但 22 个块可以等宽)。

示例代码:

    df$Type <- factor(round(df$Type, 2))
    df$Allele <- factor(df$Allele)
    gp <- ggplot(df, aes_string(x = "Allele", y = "Ratio", colour = "Type")) 
    gp <- gp + geom_point(alpha = 0.8, position = position_jitter(width = 0.1))
    gp <- gp + facet_grid(Dye ~ Marker) + facet_wrap(~Marker, ncol = 5, drop = FALSE, scales = "free_x")
    gp <- gp + guides(fill = guide_legend(reverse = TRUE))
    gp <- gp + labs(title = "Stutter ratios")
    print(gp)

示例数据:

    Marker  Allele  Ratio   Type    Dye
    DYS576  18  0.116157205 -1  B
    DYS389 I    14  0.043252595 -1  B
    DYS448  19  0.018236074 -1  B
    DYS389 II   31  0.102169982 -1  B
    DYS19   14  0.058139535 -1  B
    DYS19   14  0.078224101 -0.2    B
    DYS391  10  0.090035245 -1  G
    DYS481  22  0.013492063 -2  G
    DYS481  22  0.179365079 -1  G
    DYS549  13  0.0625  -1  G
    DYS533  12  0.07564495  -1  G
    DYS437  14  0.04757085  -1  G
    DYS570  17  0.071079867 -1  Y
    DYS570  17  0.007420426 1   Y
    DYS635  21  0.192561983 -1  Y
    DYS390  24  0.073079325 -1  Y
    DYS439  12  0.084817642 -1  Y
    DYS392  13  0.125965997 -1  Y
    DYS393  13  0.009672831 -2  R
    DYS393  13  0.079374111 -1  R
    DYS393  13  0.013371266 1   R
    DYS458  17  0.126099707 -1  R
    DYS385  13  0.059782609 -1  R
    DYS385  16  0.092356688 -1  R
    DYS456  17  0.12    -1  R
    YGATAH4 11  0.07203718  -1  R
    DYS576  18  0.094989562 -1  B
    DYS389 I    14  0.044955045 -1  B
    DYS448  19  0.017171717 -1  B
    DYS389 II   31  0.124137931 -1  B
    DYS391  10  0.052903833 -1  G
    DYS481  22  0.198726115 -1  G
    DYS549  13  0.08853967  -1  G
    DYS533  12  0.106617647 -1  G
    DYS438  9   0.017562533 -1  G
    DYS570  17  0.006710002 -2  Y
    DYS570  17  0.076326274 -1  Y
    DYS570  17  0.007339065 1   Y
    DYS635  21  0.132272501 -1  Y
    DYS390  24  0.078853047 -1  Y
    DYS439  12  0.06980198  -1  Y
    DYS392  13  0.104508197 -1  Y
    DYS393  13  0.083853995 -1  R
    DYS393  13  0.014140085 1   R
    DYS458  17  0.094651285 -1  R
    DYS385  13  0.076977401 -1  R
    DYS385  13  0.076977401 -1  R
    DYS385  16  0.059866962 -1  R
    DYS385  16  0.059866962 -1  R
    DYS456  17  0.151162791 -1  R
    YGATAH4 11  0.09254902  -1  R
    DYS576  18  0.126856684 -1  B
    DYS389 I    14  0.052631579 -1  B
    DYS389 II   31  0.102253033 -1  B
    DYS19   14  0.056882821 -1  B
    DYS19   14  0.080773606 -0.2    B
    DYS391  10  0.053362122 -1  G
    DYS481  22  0.033595801 -2  G
    DYS481  22  0.164829396 -1  G
    DYS549  13  0.123548922 -1  G
    DYS533  12  0.06750174  -1  G
    DYS437  14  0.041118421 -1  G
    DYS570  17  0.097141001 -1  Y
    DYS570  17  0.010071475 1   Y
    DYS635  21  0.070416095 -1  Y
    DYS390  24  0.075715605 -1  Y
    DYS439  12  0.077648766 -1  Y
    DYS392  13  0.116974494 -1  Y
    DYS643  10  0.017945781 -1  Y
    DYS393  13  0.011755878 -2  R
    DYS393  13  0.121810905 -1  R
    DYS393  13  0.017008504 1   R
    DYS458  17  0.097028366 -1  R
    DYS385  13  0.083820663 -1  R
    DYS385  16  0.124661247 -1  R
    DYS456  17  0.11167002  -1  R
    DYS576  18  0.102416918 -1  B
    DYS448  19  0.021699819 -1  B
    DYS19   14  0.064239829 -0.2    B
    DYS391  10  0.054468085 -1  G
    DYS481  22  0.048726467 -2  G
    DYS481  22  0.182724252 -1  G
    DYS549  13  0.091326105 -1  G
    DYS533  12  0.074295474 -1  G
    DYS438  9   0.059535822 -1  G
    DYS437  14  0.044034091 -1  G
    DYS570  17  0.02547279  -2  Y
    DYS570  17  0.129293709 -1  Y
    DYS570  17  0.012350444 1   Y
    DYS635  21  0.09912927  -1  Y
    DYS390  24  0.086936937 -1  Y
    DYS439  12  0.060550459 -1  Y
    DYS392  13  0.149750416 -1  Y
    DYS393  13  0.08388521  -1  R
    DYS393  13  0.016188374 1   R
    DYS458  17  0.009228937 -2  R
    DYS458  17  0.092289372 -1  R
    DYS458  17  0.062816314 1   R
    DYS385  13  0.068504595 -1  R
    DYS385  16  0.077120823 -1  R
    DYS456  17  0.131855309 -1  R
    YGATAH4 11  0.070570571 -1  R
    DYS576  18  0.108604407 -1  B
    DYS389 I    14  0.053097345 -1  B
    DYS389 II   31  0.122986823 -1  B
    DYS19   14  0.044878049 -1  B
    DYS19   14  0.069268293 -0.2    B
    DYS391  10  0.057256368 -1  G
    DYS481  22  0.029480217 -2  G
    DYS481  22  0.171450737 -1  G
    DYS549  13  0.078275862 -1  G
    DYS533  12  0.062146893 -1  G
    DYS437  14  0.037869063 -1  G
    DYS570  17  0.0956807   -1  Y
    DYS570  17  0.021323127 1   Y
    DYS635  21  0.076858108 -1  Y
    DYS390  24  0.099143207 -1  Y
    DYS439  12  0.057610242 -1  Y
    DYS439  12  0.028449502 1   Y
    DYS392  13  0.101621622 -1  Y
    DYS393  13  0.012474012 -2  R
    DYS393  13  0.117463617 -1  R
    DYS393  13  0.01039501  1   R
    DYS458  17  0.081623347 -1  R
    DYS385  13  0.068003487 -1  R
    DYS385  16  0.066376496 -1  R
    DYS456  17  0.149382716 -1  R

更新: 终于有时间尝试解决这个问题了。基于 DWin 的回答，并在网上找到的一些示例的帮助下，我几乎按照我的意愿设法创建了一个情节。但是，我需要更多帮助才能完全按照我的意愿获得它:

1)如何使每个情节中的面板同样宽(或高)，并且仍然只能在某些情节中放入标题和图例。

2) 如何在所有图中垂直居中 y 标题和图例。

3)当然我想对不同面板中的相同类型使用相同的颜色，但我认为使用ggplot应该很容易。但这里也欢迎任何建议。

到目前为止，请参阅附加的代码和图像以了解我的进度。

# Prepare data.
df$Marker <- factor(df$Marker, levels = c("DYS576", "DYS389 I", "DYS448", "DYS389 II", "DYS19",
                                          "DYS391", "DYS481", "DYS549", "DYS533", "DYS438", "DYS437",
                                          "DYS570", "DYS635", "DYS390", "DYS439", "DYS392",
                                          "DYS643", "DYS393", "DYS458", "DYS385", "DYS456", "YGATAH4" ))
df$Type <- factor(round(df$Type, 2))
df$Dye <- factor(df$Dye, levels = c("B", "G", "Y", "R"))
df$Allele <- factor(df$Allele)

# Get y max to use same scale.
yMax <- max(df$Ratio)

# Get dyes.
dyes <- levels(df$Dye)

# start new page
plot.new() 

# setup layout
gl <- grid.layout(nrow=length(dyes) , ncol=1)
# grid.show.layout(gl) # To inspect layout.

# Init layout
pushViewport(viewport(layout=gl))

# Loop over all dyes.
for(d in seq(along=dyes)){

  # Move to the next viewport
  pushViewport(viewport(layout.pos.col=1, layout.pos.row=d))

  # Create a plot for the current subset.  
  gp <- ggplot(subset(df, Dye==dyes[d]), aes_string(x = "Allele", y = "Ratio")) 
  gp <- gp + geom_point(aes_string(colour = "Type"), alpha = 0.8, position = position_jitter(width = 0.1))
  gp <- gp + facet_grid(Dye ~ Marker, scales="free_x")
  gp <- gp + ylim(0, yMax)

  # If first dye channel.
  if(d == 1){

    # Plot title only.
    gp <- gp + labs(title = "Stutter ratios")
    gp <- gp + theme(axis.title.x=element_blank())
    gp <- gp + theme(axis.title.y=element_blank())

    # Remove legends.
    gp <- gp + theme(legend.position="none")

  } else if(d == length(dyes)){ # If last dye channel.

    # No title but x and y labels.
    # Y label should ideally be centered vertically in final plot.
    gp <- gp + labs(title = element_blank())
    gp <- gp + labs(xlab = "Allele")
    gp <- gp + labs(xlab = "Ratio")

    # Not removing legend works but makes the last plot more compact (horizontally).
    # Can the panel height or width be fixed for all subplots?

    # 'bottom' is nicer (assuming I can't center it vertically in the final plot)
    # but makes the last dye channel very compact (vertically).
    # gp <- gp + theme(legend.position="bottom")

  } else {  # No titles, labels or legends.

    gp <- gp + labs(title = element_blank())
    gp <- gp + theme(axis.title.x = element_blank())
    gp <- gp + theme(axis.title.y = element_blank())
    gp <- gp + theme(legend.position="none")
  }

  # Print the ggplot graphics here
  print(gp, newpage = FALSE)

  # Done with this viewport
  popViewport(1)

}

更新 2: 新尝试使用 gtable 作为 baptiste 的建议。我现在可以生成我想要的确切情节。我能想到的唯一外观改进就是减少图例占用的水平空间。很高兴对此提出任何建议。但我不会花更多的时间去尝试找出自己，情节已经足够接近完美了。

下面的新代码和绘图。代码可能会稍微清理一下，所以如果您有任何提示，请发表评论。

# Prepare data.
df$Marker <- factor(df$Marker, levels = c("DYS576", "DYS389 I", "DYS448", "DYS389 II", "DYS19",
                                          "DYS391", "DYS481", "DYS549", "DYS533", "DYS438", "DYS437",
                                          "DYS570", "DYS635", "DYS390", "DYS439", "DYS392",
                                          "DYS643", "DYS393", "DYS458", "DYS385", "DYS456", "YGATAH4" ))
df$Type <- factor(round(df$Type, 2))
df$Dye <- factor(df$Dye, levels = c("B", "G", "Y", "R"))
df$Allele <- factor(df$Allele)

# Get y max to use same scale.
yMax <- max(df$Ratio)

# Get dyes.
dyes <- levels(df$Dye)
# Number of dyes.
noDyes <- length(dyes)
# Number of rows in table object.
noRows <- length(dyes) + 2

# Create table object.
g <- gtable(widths=unit(c(1,4,1),c("lines","null","null")),
            heights = unit(c(1,rep(1,noDyes),1), c("line",rep("null",noDyes), "line")))

# Add titles.
g <- gtable_add_grob(g, textGrob("Stutter ratios"), t=1,b=1,l=2,r=2)
g <- gtable_add_grob(g, textGrob("Allele"), t=noRows ,b=noRows ,l=2,r=2)
g <- gtable_add_grob(g, textGrob("Ratio", rot=90), t=1,b=noRows ,l=1,r=1)

# Create a plot for the entire dataset to extract the legend.
gp <- ggplot(df, aes_string(x = "Allele", y = "Ratio")) 
gp <- gp + geom_point(aes_string(colour = "Type"))
# Extract the legend.
guide <- gtable_filter(ggplotGrob(gp), pattern="guide")
# Add the legend to the table object.
g <- gtable_add_grob(g,guide , t=1,b=noRows,l=3,r=3)

# Loop over all dyes.
for(d in seq(along=dyes)){

  # Create a plot for the current subset.
  gp <- ggplot(subset(df, Dye==dyes[d]), aes_string(x = "Allele", y = "Ratio")) 
  gp <- gp + geom_point(aes_string(colour = "Type"), alpha = 0.8, position = position_jitter(width = 0.1))
  gp <- gp + scale_colour_discrete(drop = FALSE)
  gp <- gp + facet_grid(Dye ~ Marker, scales="free_x")
  gp <- gp + ylim(0, yMax)

  # Remove titles, axis labels and legend.
  gp <- gp + labs(title = element_blank())
  gp <- gp + theme(axis.title.x = element_blank())
  gp <- gp + theme(axis.title.y = element_blank())
  gp <- gp + theme(legend.position="none")

  # Add plot panel to table object.  
  g <- gtable_add_grob(g,ggplotGrob(gp), t=(d+1),b=(d+1),l=2,r=2)

}

# Plot.
grid.newpage()
grid.draw(g)

Answer 1

放置 grobs 的一种简单方法是使用 gtable 包，

library(gtable)
gtable_add_grobs <- gtable_add_grob #misleading name

g <- gtable(widths=unit(c(1,4,1),c("lines","null","null")),
            heights = unit(c(1,1,1,1), c("line","null","null", "line")))

lg <- list(textGrob("title"), 
           textGrob("xlab"),
           textGrob("ylab", rot=90),
           rectGrob(),
           rectGrob(),
           rectGrob())

pos <- data.frame(t=c(1, 4, 1, 2, 3, 2),
                  b=c(1, 4, 4, 2, 3, 3),
                  l=c(2, 2, 1, 2, 2, 3),
                  r=c(3, 2, 1, 2, 2, 3))

g <- with(pos, gtable_add_grobs(g, lg, t=t, l=l, b=b, r=r))
grid.newpage()
grid.draw(g)

您可以使用 gtable_filter(ggplotGrob(p), pattern="guide") 提取 ggplot 的图例.