如何手动调整刻面尺寸

时间:2018-03-05 12:48:28

标签: r ggplot2 facet ggproto

我有一个分面的情节,数据非常多样化。因此,某些方面只有1 x个值,但其他一些方面有13 x个值。我知道有参数space='free'可以通过它代表的数据调整每个方面的宽度。

我的问题是,有可能手动调整此空间吗?由于我的一些方面很小,因此无法再读取刻面中的标签。我做了一个可重复的例子来说明我的意思。

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构面会被压缩,您无法再阅读标签。

我在互联网上发现了一个似乎完全符合我想做的帖子,但这似乎不再适用于ggplot2。这篇文章是从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)widthsheights手动调整每个方面的大小。

4 个答案:

答案 0 :(得分:15)

您可以使用网格图形

调整ggplot对象的宽度
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)

enter image description here

对于包含许多元素的复杂图形,确定要更改的宽度可能会稍微麻烦一些。在这种情况下,需要扩展的是网格列4,但这对于不同的图表会有所不同。有几种方法可以确定要更改哪一种方法,但一种相当简单和好的方法是使用gtable_show_layout包中的gtable

gtable_show_layout(gt)

生成以下图像:

enter image description here

其中我们可以看到左侧小平面在第4列中。前3列为边距,轴标题和轴标签+刻度提供空间。第5列是小平面之间的空间,第6列是右手小平面。第7列到第12列用于右侧构面标签,空格,图例和右边距。

检查gtable的图形表示的另一种方法是简单地检查表本身。实际上,如果您需要自动化该过程,这将是实现此过程的方法。那么让我们来看看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坐标中的面板,单元格给出表中该命名面板的坐标(作为范围)。因此,例如,顶部和底部左侧面板都位于表格单元格中,列范围为4- 4。 (仅在第四栏,即)。左侧顶部条带也位于单元格列4中。

如果您想使用此表以编程方式查找相关宽度,而不是手动(使用左上方,即"panel-1-1"作为示例),您可以使用

gt$layout$l[grep('panel-1-1', gt$layout$name)]
# [1] 4

答案 1 :(得分:5)

啊,非常遗憾,在widths中设置heightsfacet_grid的功能已经消失。

没有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))

enter image description here

答案 2 :(得分: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

答案 3 :(得分:4)

很抱歉在几年后发布,但我不久前遇到了这个确切的问题,并编写了一个函数以使其更容易。我认为如果我分享它可以帮助这里的人。它的核心也是在 gtable 中设置宽度/高度,但它在方面级别进行集成,以便您仍然可以添加内容。它存在于我在 github 上写的一个包中。请注意,例如,您还可以使用 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 年 1 月 21 日创建