如果你有修改 ggplot2 的兴趣，并想以其他方式进行修改，我推荐阅读vignette：
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))
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))
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
}
继续在新的代码块中停止滚动：
environment(draw_panels_new) <- environment(FacetGrid$draw_panels)
FacetGrid$draw_panels <- draw_panels_new
ggplot(DF, aes(x, y, color = i)) +
geom_point() +
facet_grid(labely~labelx, scales = 'free_x', space = 'free_x')
我之所以说快捷方式，是因为你当然可以编写自己的
facet_grid_new 版本，此外还可以通过添加自定义的
params选项来灵活地传递上述的值
c(1,4)。 当然，您也可以创建继承自
FacetGrid 的自己的
ggproto 对象...
编辑：
另一种使其更具灵活性的简单方法是添加自定义的
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
ggplotGrob。此外，这里有一个函数源代码的链接。你可以尝试理解 "scales" 参数的作用，然后利用这个知识来修改最终的 ggplot。https://github.com/tidyverse/ggplot2/blob/master/R/facet-grid-.r#L314 很抱歉我不能提供更多帮助。 - Michael Harper