How to adjust facet size manually

穿精又带淫゛_ 提交于 2019-12-18 11:25:24

问题


I have a faceted plot with very diverse data. So some facets have only 1 x value, but some others have 13 x values. I know there is the parameter space='free' which adjusts the width of each facet by the data it represents.

My question, is there a possibility to adjust this space manually? Since some of my facets are so small, it is no longer possible to read the labels in the facets. I made a little reproducible example to show what I mean.

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')

So depending on your screen, the my long label facet gets compressed and you can no longer read the label.

I found a post on the internet which seems to do exactly what I want to do, but this seems to no longer work in ggplot2. The post is from 2010.

https://kohske.wordpress.com/2010/12/25/adjusting-the-relative-space-of-a-facet-grid/

He suggests to use facet_grid(fac1 + fac2 ~ fac3 + fac4, widths = 1:4, heights = 4:1), so widths and heights to adjust each facet size manually.


回答1:


You can adjust the widths of a ggplot object using grid graphics

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)

With complex graphs with many elements, it can be slightly cumbersome to determine which width it is that you want to alter. In this instance it was grid column 4 that needed to be expanded, but this will vary for different plots. There are several ways to determine which one to change, but a fairly simple and good way is to use gtable_show_layout from the gtable package.

gtable_show_layout(gt)

produces the following image:

in which we can see that the left hand facet is in column number 4. The first 3 columns provide room for the margin, the axis title and the axis labels+ticks. Column 5 is the space between the facets, column 6 is the right hand facet. Columns 7 through 12 are for the right hand facet labels, spaces, the legend, and the right margin.

An alternative to inspecting a graphical representation of the gtable is to simply inspect the table itself. In fact if you need to automate the process, this would be the way to do it. So lets have a look at the 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]

The relevant bits are

#         cells       name  
# ( 7- 7, 4- 4)  panel-1-1      
# ( 9- 9, 4- 4)  panel-2-1              
# ( 6- 6, 4- 4)  strip-t-1

in which the names panel-x-y refer to panels in x, y coordinates, and the cells give the coordinates (as ranges) of that named panel in the table. So, for example, the top and bottom left-hand panels both are located in table cells with the column ranges 4- 4. (only in column four, that is). The left-hand top strip is also in cell column 4.

If you wanted to use this table to find the relevant width programmatically, rather than manually, (using the top left facet, ie "panel-1-1" as an example) you could use

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



回答2:


In case you are interested in modifying ggplot2 in more and other ways, I recommend the vignette:

vignette("extending-ggplot2")

Now for your problem at hand, I think the shortcut of a clean solution goes as follows:

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
}

Continuing in new code block to stop the scrolling:

# 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')

I say shortcut because you could of course write your own version of facet_grid_new in addition, allowing you to pass the values c(1,4) from above flexibly as extra params.
And of course you could make your own ggproto object inheriting from FacetGrid...


Edit:

Another simple way of making this more flexible would be to add a custom option, e.g. like:

options(facet_size_manual = list(width = c(1,4), height = NULL))

This could then be used inside the custom draw_panels method somehow like this:

if (!is.null(facet_width <- getOption("facet_size_manual")$width))
  widths <- facet_width



回答3:


Ah yes very sad that functionality to set widths and heights in facet_grid is gone.

Another possible workaround without ggplotGrob is to set the text angle in theme(strip.text.x=element_text(angle...)) and facet text wrapping in facet_grid(... labeller=label_wrap_gen(width...)), e.g.

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



来源:https://stackoverflow.com/questions/49110877/how-to-adjust-facet-size-manually

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!