如何手动调整刻面大小
How to adjust facet size manually
我有一个包含非常多样化数据的多面图。所以有些方面只有 1 x 值，但有些方面有 13 x 值。我知道有一个参数 space='free' 可以根据它代表的数据调整每个面的宽度。
我的问题是，是否可以手动调整此 space？由于我的某些刻面非常小，因此无法再阅读刻面中的标签。我做了一个可重现的小例子来说明我的意思。
df <- data.frame(labelx=rep(c('my long label','short'), c(2,26)),
labely=rep(c('a','b'), each=14),
x=c(letters[1:2],letters[1:26]),
y=LETTERS[6:7],
i=rnorm(28))
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x')
因此，根据您的屏幕，my long label 面被压缩，您无法再阅读标签。
我在互联网上找到了一个 post，它似乎完全符合我的要求，但这在 ggplot2 中似乎不再有效。 post 是 2010 年的。
https://kohske.wordpress.com/2010/12/25/adjusting-the-relative-space-of-a-facet-grid/
他建议使用facet_grid(fac1 + fac2 ~ fac3 + fac4, widths = 1:4, heights = 4:1)，所以widths和heights手动调整每个面的大小。
啊是的，很遗憾在 facet_grid 中设置 widths 和 heights 的功能已经消失。
没有 ggplotGrob 的另一种可能的解决方法是在 theme(strip.text.x=element_text(angle...)) 中设置文本角度，在 facet_grid(... labeller=label_wrap_gen(width...)) 中设置分面文本换行，例如
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x', labeller=label_wrap_gen(width = 10, multi_line = TRUE)) +
theme(strip.text.x=element_text(angle=90, hjust=0.5, vjust=0.5))
如果您有兴趣以更多和其他方式修改 ggplot2，我推荐小插图：
vignette("extending-ggplot2")
现在对于你手头的问题，我认为一个干净的解决方案的捷径如下：
library(ggplot2)
DF <- data.frame(labelx = rep(c('my long label','short'), c(2,26)),
labely = rep(c('a','b'), each = 14),
x = c(letters[1:2], letters[1:26]),
y = LETTERS[6:7],
i = rnorm(28))
# ad-hoc replacement for the "draw_panels" method, sorry for the hundred lines of code...
# only modification is marked with a comment
draw_panels_new <- function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
cols <- which(layout$ROW == 1)
rows <- which(layout$COL == 1)
axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
col_vars <- unique(layout[names(params$cols)])
row_vars <- unique(layout[names(params$rows)])
attr(col_vars, "type") <- "cols"
attr(col_vars, "facet") <- "grid"
attr(row_vars, "type") <- "rows"
attr(row_vars, "facet") <- "grid"
strips <- render_strips(col_vars, row_vars, params$labeller, theme)
aspect_ratio <- theme$aspect.ratio
if (is.null(aspect_ratio) && !params$free$x && !params$free$y) {
aspect_ratio <- coord$aspect(ranges[[1]])
}
if (is.null(aspect_ratio)) {
aspect_ratio <- 1
respect <- FALSE
} else {
respect <- TRUE
}
ncol <- max(layout$COL)
nrow <- max(layout$ROW)
panel_table <- matrix(panels, nrow = nrow, ncol = ncol, byrow = TRUE)
if (params$space_free$x) {
ps <- layout$PANEL[layout$ROW == 1]
widths <- vapply(ps, function(i) diff(ranges[[i]]$x.range), numeric(1))
# replaced "widths" below with custom manual values c(1,4)
panel_widths <- unit(c(1,4), "null")
} else {
panel_widths <- rep(unit(1, "null"), ncol)
}
if (params$space_free$y) {
ps <- layout$PANEL[layout$COL == 1]
heights <- vapply(ps, function(i) diff(ranges[[i]]$y.range), numeric(1))
panel_heights <- unit(heights, "null")
} else {
panel_heights <- rep(unit(1 * aspect_ratio, "null"),
nrow)
}
panel_table <- gtable_matrix("layout", panel_table, panel_widths,
panel_heights, respect = respect, clip = "on", z = matrix(1, ncol = ncol, nrow = nrow))
panel_table$layout$name <- paste0("panel-", rep(seq_len(ncol), nrow), "-", rep(seq_len(nrow), each = ncol))
panel_table <- gtable_add_col_space(panel_table, theme$panel.spacing.x %||% theme$panel.spacing)
panel_table <- gtable_add_row_space(panel_table, theme$panel.spacing.y %||% theme$panel.spacing)
panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
panel_pos_col <- panel_cols(panel_table)
panel_pos_rows <- panel_rows(panel_table)
panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off",
name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off",
name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off",
name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off",
name = paste0("axis-r-", seq_along(axes$y$right)), z = 3)
switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")
switch_y <- !is.null(params$switch) && params$switch %in% c("both", "y")
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
strip_padding <- convertUnit(theme$strip.switch.pad.grid, "cm")
panel_pos_col <- panel_cols(panel_table)
if (switch_x) {
if (!is.null(strips$x$bottom)) {
if (inside_x) {
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$bottom), -2)
panel_table <- gtable_add_grob(panel_table, strips$x$bottom, -2, panel_pos_col$l, clip = "on",
name = paste0("strip-b-", seq_along(strips$x$bottom)), z = 2)
} else {
panel_table <- gtable_add_rows(panel_table, strip_padding, -1)
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$bottom), -1)
panel_table <- gtable_add_grob(panel_table, strips$x$bottom, -1, panel_pos_col$l, clip = "on",
name = paste0("strip-b-", seq_along(strips$x$bottom)), z = 2)
}
}
} else {
if (!is.null(strips$x$top)) {
if (inside_x) {
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$top), 1)
panel_table <- gtable_add_grob(panel_table, strips$x$top, 2, panel_pos_col$l, clip = "on",
name = paste0("strip-t-", seq_along(strips$x$top)), z = 2)
} else {
panel_table <- gtable_add_rows(panel_table, strip_padding, 0)
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$top), 0)
panel_table <- gtable_add_grob(panel_table, strips$x$top, 1, panel_pos_col$l, clip = "on",
name = paste0("strip-t-", seq_along(strips$x$top)), z = 2)
}
}
}
panel_pos_rows <- panel_rows(panel_table)
if (switch_y) {
if (!is.null(strips$y$left)) {
if (inside_y) {
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$left), 1)
panel_table <- gtable_add_grob(panel_table, strips$y$left, panel_pos_rows$t, 2, clip = "on",
name = paste0("strip-l-", seq_along(strips$y$left)), z = 2)
} else {
panel_table <- gtable_add_cols(panel_table, strip_padding, 0)
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$left), 0)
panel_table <- gtable_add_grob(panel_table, strips$y$left, panel_pos_rows$t, 1, clip = "on",
name = paste0("strip-l-", seq_along(strips$y$left)), z = 2)
}
}
} else {
if (!is.null(strips$y$right)) {
if (inside_y) {
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$right), -2)
panel_table <- gtable_add_grob(panel_table, strips$y$right, panel_pos_rows$t, -2, clip = "on",
name = paste0("strip-r-", seq_along(strips$y$right)), z = 2)
} else {
panel_table <- gtable_add_cols(panel_table, strip_padding, -1)
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$right), -1)
panel_table <- gtable_add_grob(panel_table, strips$y$right, panel_pos_rows$t, -1, clip = "on",
name = paste0("strip-r-", seq_along(strips$y$right)), z = 2)
}
}
}
panel_table
}
在新代码块中继续以停止滚动：
# need to pre-set the same environment to find things like e.g.
# gtable_matrix() from package gtable
environment(draw_panels_new) <- environment(FacetGrid$draw_panels)
# assign custom method
FacetGrid$draw_panels <- draw_panels_new
# happy plotting
ggplot(DF, aes(x, y, color = i)) +
geom_point() +
facet_grid(labely~labelx, scales = 'free_x', space = 'free_x')
我说快捷方式是因为你当然可以另外编写你自己的 facet_grid_new 版本，允许你从上面灵活地传递值 c(1,4) 作为额外的 params.
当然，您可以创建自己的 ggproto 继承自 FacetGrid...
的对象
编辑：
另一种使它更灵活的简单方法是添加自定义 option，例如喜欢：
options(facet_size_manual = list(width = c(1,4), height = NULL))
然后可以像这样在自定义 draw_panels 方法中使用它：
if (!is.null(facet_width <- getOption("facet_size_manual")$width))
widths <- facet_width
您可以使用网格图形调整 ggplot object 的宽度
g = ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x')
library(grid)
gt = ggplot_gtable(ggplot_build(g))
gt$widths[4] = 4*gt$widths[4]
grid.draw(gt)
对于包含许多元素的复杂图表，确定要更改的宽度可能会稍微麻烦一些。在本例中，需要扩展的是网格第 4 列，但这会因地块不同而有所不同。有几种方法可以确定更改哪一个，但一个相当简单和好的方法是使用 gtable 包中的 gtable_show_layout。
gtable_show_layout(gt)
生成以下图像：
其中我们可以看到左侧面在第 4 列中。前 3 列为边距、轴标题和轴标签+刻度提供了空间。第 5 列是构面之间的 space，第 6 列是右侧的构面。第 7 列到第 12 列用于右侧小平面标签、spaces、图例和右边距。
检查 gtable 的图形表示的另一种方法是简单地检查 table 本身。事实上，如果您需要自动化该过程，这就是实现它的方法。那么让我们看看 TableGrob：
gt
# TableGrob (13 x 12) "layout": 25 grobs
# z cells name grob
# 1 0 ( 1-13, 1-12) background rect[plot.background..rect.399]
# 2 1 ( 7- 7, 4- 4) panel-1-1 gTree[panel-1.gTree.283]
# 3 1 ( 9- 9, 4- 4) panel-2-1 gTree[panel-3.gTree.305]
# 4 1 ( 7- 7, 6- 6) panel-1-2 gTree[panel-2.gTree.294]
# 5 1 ( 9- 9, 6- 6) panel-2-2 gTree[panel-4.gTree.316]
# 6 3 ( 5- 5, 4- 4) axis-t-1 zeroGrob[NULL]
# 7 3 ( 5- 5, 6- 6) axis-t-2 zeroGrob[NULL]
# 8 3 (10-10, 4- 4) axis-b-1 absoluteGrob[GRID.absoluteGrob.329]
# 9 3 (10-10, 6- 6) axis-b-2 absoluteGrob[GRID.absoluteGrob.336]
# 10 3 ( 7- 7, 3- 3) axis-l-1 absoluteGrob[GRID.absoluteGrob.343]
# 11 3 ( 9- 9, 3- 3) axis-l-2 absoluteGrob[GRID.absoluteGrob.350]
# 12 3 ( 7- 7, 8- 8) axis-r-1 zeroGrob[NULL]
# 13 3 ( 9- 9, 8- 8) axis-r-2 zeroGrob[NULL]
# 14 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip]
# 15 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip]
# 16 2 ( 7- 7, 7- 7) strip-r-1 gtable[strip]
# 17 2 ( 9- 9, 7- 7) strip-r-2 gtable[strip]
# 18 4 ( 4- 4, 4- 6) xlab-t zeroGrob[NULL]
# 19 5 (11-11, 4- 6) xlab-b titleGrob[axis.title.x..titleGrob.319]
# 20 6 ( 7- 9, 2- 2) ylab-l titleGrob[axis.title.y..titleGrob.322]
# 21 7 ( 7- 9, 9- 9) ylab-r zeroGrob[NULL]
# 22 8 ( 7- 9,11-11) guide-box gtable[guide-box]
# 23 9 ( 3- 3, 4- 6) subtitle zeroGrob[plot.subtitle..zeroGrob.396]
# 24 10 ( 2- 2, 4- 6) title zeroGrob[plot.title..zeroGrob.395]
# 25 11 (12-12, 4- 6) caption zeroGrob[plot.caption..zeroGrob.397]
相关位是
# cells name
# ( 7- 7, 4- 4) panel-1-1
# ( 9- 9, 4- 4) panel-2-1
# ( 6- 6, 4- 4) strip-t-1
其中名称 panel-x-y 指的是 x、y 坐标中的面板，单元格给出 table 中该命名面板的坐标（作为范围）。因此，例如，顶部和底部 left-hand 面板都位于 table 列范围为 4- 4 的单元格中。 （仅在第四列中）。 left-hand 顶部条带也在单元格第 4 列中。
如果您想使用此 table 以编程方式而不是手动查找相关宽度（使用左上角，即 "panel-1-1" 作为示例），您可以使用
gt$layout$l[grep('panel-1-1', gt$layout$name)]
# [1] 4
很抱歉今年晚些时候发帖，但我不久前遇到了这个问题，并编写了一个函数来简化它。我认为如果我分享它可以帮助这里的人。它的核心还在 gtable 中设置 widths/heights，但它在方面级别集成，因此您仍然可以添加内容。它存在于我在 github 上写的一个包中（编辑：它现在可以在 CRAN 上使用）。请注意，您还可以设置绝对大小 grid::unit(..., "cm") 例如。
library(ggplot2)
library(ggh4x)
df <- data.frame(labelx=rep(c('my long label','short'), c(2,26)),
labely=rep(c('a','b'), each=14),
x=c(letters[1:2],letters[1:26]),
y=LETTERS[6:7],
i=rnorm(28))
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x') +
force_panelsizes(cols = c(0.3, 1)) +
theme_bw() # Just to show you can still add things
由 reprex package (v0.3.0)
创建于 2021-01-21
我有一个包含非常多样化数据的多面图。所以有些方面只有 1 x 值，但有些方面有 13 x 值。我知道有一个参数 space='free' 可以根据它代表的数据调整每个面的宽度。
我的问题是，是否可以手动调整此 space？由于我的某些刻面非常小，因此无法再阅读刻面中的标签。我做了一个可重现的小例子来说明我的意思。
df <- data.frame(labelx=rep(c('my long label','short'), c(2,26)),
labely=rep(c('a','b'), each=14),
x=c(letters[1:2],letters[1:26]),
y=LETTERS[6:7],
i=rnorm(28))
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x')
因此，根据您的屏幕，my long label 面被压缩，您无法再阅读标签。
我在互联网上找到了一个 post，它似乎完全符合我的要求，但这在 ggplot2 中似乎不再有效。 post 是 2010 年的。
https://kohske.wordpress.com/2010/12/25/adjusting-the-relative-space-of-a-facet-grid/
他建议使用facet_grid(fac1 + fac2 ~ fac3 + fac4, widths = 1:4, heights = 4:1)，所以widths和heights手动调整每个面的大小。
啊是的，很遗憾在 facet_grid 中设置 widths 和 heights 的功能已经消失。
没有 ggplotGrob 的另一种可能的解决方法是在 theme(strip.text.x=element_text(angle...)) 中设置文本角度，在 facet_grid(... labeller=label_wrap_gen(width...)) 中设置分面文本换行，例如
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x', labeller=label_wrap_gen(width = 10, multi_line = TRUE)) +
theme(strip.text.x=element_text(angle=90, hjust=0.5, vjust=0.5))
如果您有兴趣以更多和其他方式修改 ggplot2，我推荐小插图：
vignette("extending-ggplot2")
现在对于你手头的问题，我认为一个干净的解决方案的捷径如下：
library(ggplot2)
DF <- data.frame(labelx = rep(c('my long label','short'), c(2,26)),
labely = rep(c('a','b'), each = 14),
x = c(letters[1:2], letters[1:26]),
y = LETTERS[6:7],
i = rnorm(28))
# ad-hoc replacement for the "draw_panels" method, sorry for the hundred lines of code...
# only modification is marked with a comment
draw_panels_new <- function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
cols <- which(layout$ROW == 1)
rows <- which(layout$COL == 1)
axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
col_vars <- unique(layout[names(params$cols)])
row_vars <- unique(layout[names(params$rows)])
attr(col_vars, "type") <- "cols"
attr(col_vars, "facet") <- "grid"
attr(row_vars, "type") <- "rows"
attr(row_vars, "facet") <- "grid"
strips <- render_strips(col_vars, row_vars, params$labeller, theme)
aspect_ratio <- theme$aspect.ratio
if (is.null(aspect_ratio) && !params$free$x && !params$free$y) {
aspect_ratio <- coord$aspect(ranges[[1]])
}
if (is.null(aspect_ratio)) {
aspect_ratio <- 1
respect <- FALSE
} else {
respect <- TRUE
}
ncol <- max(layout$COL)
nrow <- max(layout$ROW)
panel_table <- matrix(panels, nrow = nrow, ncol = ncol, byrow = TRUE)
if (params$space_free$x) {
ps <- layout$PANEL[layout$ROW == 1]
widths <- vapply(ps, function(i) diff(ranges[[i]]$x.range), numeric(1))
# replaced "widths" below with custom manual values c(1,4)
panel_widths <- unit(c(1,4), "null")
} else {
panel_widths <- rep(unit(1, "null"), ncol)
}
if (params$space_free$y) {
ps <- layout$PANEL[layout$COL == 1]
heights <- vapply(ps, function(i) diff(ranges[[i]]$y.range), numeric(1))
panel_heights <- unit(heights, "null")
} else {
panel_heights <- rep(unit(1 * aspect_ratio, "null"),
nrow)
}
panel_table <- gtable_matrix("layout", panel_table, panel_widths,
panel_heights, respect = respect, clip = "on", z = matrix(1, ncol = ncol, nrow = nrow))
panel_table$layout$name <- paste0("panel-", rep(seq_len(ncol), nrow), "-", rep(seq_len(nrow), each = ncol))
panel_table <- gtable_add_col_space(panel_table, theme$panel.spacing.x %||% theme$panel.spacing)
panel_table <- gtable_add_row_space(panel_table, theme$panel.spacing.y %||% theme$panel.spacing)
panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
panel_pos_col <- panel_cols(panel_table)
panel_pos_rows <- panel_rows(panel_table)
panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off",
name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off",
name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off",
name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off",
name = paste0("axis-r-", seq_along(axes$y$right)), z = 3)
switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")
switch_y <- !is.null(params$switch) && params$switch %in% c("both", "y")
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
strip_padding <- convertUnit(theme$strip.switch.pad.grid, "cm")
panel_pos_col <- panel_cols(panel_table)
if (switch_x) {
if (!is.null(strips$x$bottom)) {
if (inside_x) {
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$bottom), -2)
panel_table <- gtable_add_grob(panel_table, strips$x$bottom, -2, panel_pos_col$l, clip = "on",
name = paste0("strip-b-", seq_along(strips$x$bottom)), z = 2)
} else {
panel_table <- gtable_add_rows(panel_table, strip_padding, -1)
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$bottom), -1)
panel_table <- gtable_add_grob(panel_table, strips$x$bottom, -1, panel_pos_col$l, clip = "on",
name = paste0("strip-b-", seq_along(strips$x$bottom)), z = 2)
}
}
} else {
if (!is.null(strips$x$top)) {
if (inside_x) {
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$top), 1)
panel_table <- gtable_add_grob(panel_table, strips$x$top, 2, panel_pos_col$l, clip = "on",
name = paste0("strip-t-", seq_along(strips$x$top)), z = 2)
} else {
panel_table <- gtable_add_rows(panel_table, strip_padding, 0)
panel_table <- gtable_add_rows(panel_table, max_height(strips$x$top), 0)
panel_table <- gtable_add_grob(panel_table, strips$x$top, 1, panel_pos_col$l, clip = "on",
name = paste0("strip-t-", seq_along(strips$x$top)), z = 2)
}
}
}
panel_pos_rows <- panel_rows(panel_table)
if (switch_y) {
if (!is.null(strips$y$left)) {
if (inside_y) {
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$left), 1)
panel_table <- gtable_add_grob(panel_table, strips$y$left, panel_pos_rows$t, 2, clip = "on",
name = paste0("strip-l-", seq_along(strips$y$left)), z = 2)
} else {
panel_table <- gtable_add_cols(panel_table, strip_padding, 0)
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$left), 0)
panel_table <- gtable_add_grob(panel_table, strips$y$left, panel_pos_rows$t, 1, clip = "on",
name = paste0("strip-l-", seq_along(strips$y$left)), z = 2)
}
}
} else {
if (!is.null(strips$y$right)) {
if (inside_y) {
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$right), -2)
panel_table <- gtable_add_grob(panel_table, strips$y$right, panel_pos_rows$t, -2, clip = "on",
name = paste0("strip-r-", seq_along(strips$y$right)), z = 2)
} else {
panel_table <- gtable_add_cols(panel_table, strip_padding, -1)
panel_table <- gtable_add_cols(panel_table, max_width(strips$y$right), -1)
panel_table <- gtable_add_grob(panel_table, strips$y$right, panel_pos_rows$t, -1, clip = "on",
name = paste0("strip-r-", seq_along(strips$y$right)), z = 2)
}
}
}
panel_table
}
在新代码块中继续以停止滚动：
# need to pre-set the same environment to find things like e.g.
# gtable_matrix() from package gtable
environment(draw_panels_new) <- environment(FacetGrid$draw_panels)
# assign custom method
FacetGrid$draw_panels <- draw_panels_new
# happy plotting
ggplot(DF, aes(x, y, color = i)) +
geom_point() +
facet_grid(labely~labelx, scales = 'free_x', space = 'free_x')
我说快捷方式是因为你当然可以另外编写你自己的 facet_grid_new 版本，允许你从上面灵活地传递值 c(1,4) 作为额外的 params.
当然，您可以创建自己的 ggproto 继承自 FacetGrid...
编辑：
另一种使它更灵活的简单方法是添加自定义 option，例如喜欢：
options(facet_size_manual = list(width = c(1,4), height = NULL))
然后可以像这样在自定义 draw_panels 方法中使用它：
if (!is.null(facet_width <- getOption("facet_size_manual")$width))
widths <- facet_width
您可以使用网格图形调整 ggplot object 的宽度
g = ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x')
library(grid)
gt = ggplot_gtable(ggplot_build(g))
gt$widths[4] = 4*gt$widths[4]
grid.draw(gt)
对于包含许多元素的复杂图表，确定要更改的宽度可能会稍微麻烦一些。在本例中，需要扩展的是网格第 4 列，但这会因地块不同而有所不同。有几种方法可以确定更改哪一个，但一个相当简单和好的方法是使用 gtable 包中的 gtable_show_layout。
gtable_show_layout(gt)
生成以下图像：
其中我们可以看到左侧面在第 4 列中。前 3 列为边距、轴标题和轴标签+刻度提供了空间。第 5 列是构面之间的 space，第 6 列是右侧的构面。第 7 列到第 12 列用于右侧小平面标签、spaces、图例和右边距。
检查 gtable 的图形表示的另一种方法是简单地检查 table 本身。事实上，如果您需要自动化该过程，这就是实现它的方法。那么让我们看看 TableGrob：
gt
# TableGrob (13 x 12) "layout": 25 grobs
# z cells name grob
# 1 0 ( 1-13, 1-12) background rect[plot.background..rect.399]
# 2 1 ( 7- 7, 4- 4) panel-1-1 gTree[panel-1.gTree.283]
# 3 1 ( 9- 9, 4- 4) panel-2-1 gTree[panel-3.gTree.305]
# 4 1 ( 7- 7, 6- 6) panel-1-2 gTree[panel-2.gTree.294]
# 5 1 ( 9- 9, 6- 6) panel-2-2 gTree[panel-4.gTree.316]
# 6 3 ( 5- 5, 4- 4) axis-t-1 zeroGrob[NULL]
# 7 3 ( 5- 5, 6- 6) axis-t-2 zeroGrob[NULL]
# 8 3 (10-10, 4- 4) axis-b-1 absoluteGrob[GRID.absoluteGrob.329]
# 9 3 (10-10, 6- 6) axis-b-2 absoluteGrob[GRID.absoluteGrob.336]
# 10 3 ( 7- 7, 3- 3) axis-l-1 absoluteGrob[GRID.absoluteGrob.343]
# 11 3 ( 9- 9, 3- 3) axis-l-2 absoluteGrob[GRID.absoluteGrob.350]
# 12 3 ( 7- 7, 8- 8) axis-r-1 zeroGrob[NULL]
# 13 3 ( 9- 9, 8- 8) axis-r-2 zeroGrob[NULL]
# 14 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip]
# 15 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip]
# 16 2 ( 7- 7, 7- 7) strip-r-1 gtable[strip]
# 17 2 ( 9- 9, 7- 7) strip-r-2 gtable[strip]
# 18 4 ( 4- 4, 4- 6) xlab-t zeroGrob[NULL]
# 19 5 (11-11, 4- 6) xlab-b titleGrob[axis.title.x..titleGrob.319]
# 20 6 ( 7- 9, 2- 2) ylab-l titleGrob[axis.title.y..titleGrob.322]
# 21 7 ( 7- 9, 9- 9) ylab-r zeroGrob[NULL]
# 22 8 ( 7- 9,11-11) guide-box gtable[guide-box]
# 23 9 ( 3- 3, 4- 6) subtitle zeroGrob[plot.subtitle..zeroGrob.396]
# 24 10 ( 2- 2, 4- 6) title zeroGrob[plot.title..zeroGrob.395]
# 25 11 (12-12, 4- 6) caption zeroGrob[plot.caption..zeroGrob.397]
相关位是
# cells name
# ( 7- 7, 4- 4) panel-1-1
# ( 9- 9, 4- 4) panel-2-1
# ( 6- 6, 4- 4) strip-t-1
其中名称 panel-x-y 指的是 x、y 坐标中的面板，单元格给出 table 中该命名面板的坐标（作为范围）。因此，例如，顶部和底部 left-hand 面板都位于 table 列范围为 4- 4 的单元格中。 （仅在第四列中）。 left-hand 顶部条带也在单元格第 4 列中。
如果您想使用此 table 以编程方式而不是手动查找相关宽度（使用左上角，即 "panel-1-1" 作为示例），您可以使用
gt$layout$l[grep('panel-1-1', gt$layout$name)]
# [1] 4
很抱歉今年晚些时候发帖，但我不久前遇到了这个问题，并编写了一个函数来简化它。我认为如果我分享它可以帮助这里的人。它的核心还在 gtable 中设置 widths/heights，但它在方面级别集成，因此您仍然可以添加内容。它存在于我在 github 上写的一个包中（编辑：它现在可以在 CRAN 上使用）。请注意，您还可以设置绝对大小 grid::unit(..., "cm") 例如。
library(ggplot2)
library(ggh4x)
df <- data.frame(labelx=rep(c('my long label','short'), c(2,26)),
labely=rep(c('a','b'), each=14),
x=c(letters[1:2],letters[1:26]),
y=LETTERS[6:7],
i=rnorm(28))
ggplot(df, aes(x,y,color=i)) +
geom_point() +
facet_grid(labely~labelx, scales='free_x', space='free_x') +
force_panelsizes(cols = c(0.3, 1)) +
theme_bw() # Just to show you can still add things
由 reprex package (v0.3.0)
创建于 2021-01-21