Adjust facet width by different number of groups in grouped barplot-CodePudding

I'd like to facet_wrap some geom_bar graphs that have the same number of groups on the y-axis, but a different number of "dodged" groups on each x-axis category. While I can adjust the width of bars on the graph so they are the same between facets, is there a way to condense the facet width to avoid empty space in panels where there are fewer groups?

Here is what I mean...

data(mtcars)
mtcars$car <- rownames(mtcars)

g1 <- gather(mtcars, parameter, reading, c(1,3:7))
g1$gear = factor(g1$gear)
g1$am = factor(g1$am)
g1$cyl = factor(g1$cyl)

g2 <- ggplot(g1, aes(x=am,y=reading, fill=gear))  
  geom_bar(position = position_dodge2(preserve="single"), stat = "summary") 
  geom_point(position=position_jitterdodge(jitter.width = 0.1, dodge.width = 0.7))  
  facet_grid(. ~ cyl, scales = "free", space = "free_x")
g2

Which yields...

Basically I'm looking to adjust the width of the third panel on the right so that it avoids empty space and is narrower than the left two panels. Any ideas?

Thanks in advance!

CodePudding user response：

The short answer first... the BLUF or more trendy TL;DR (keep reading beyond that to see how I got there).

This isn't a perfect match. However, you can adjust it as much as you desire or require to achieve the desired output.

library(grid)
g3 <- ggplotGrob(g2)
bW <- list() # to collect the "before" width
bX <- list() # to collect the "before" x position start of column
invisible(lapply(1:length(g3), 
                 function(j) {
                   if(length(g3$grobs[[j]]$children) > 5) {
                     i <- g3$grobs[[j]]$children
                     k <- i[grepl("rect", names(i))] %>% 
                       gsub("^.*\\[(.*)\\].", "\\1", .)
                     bW[length(bW)   1] <<- list(setNames(i[[k]]$width[[1]], k))
                     bX[length(bX)   1] <<- list(setNames(list(c(i[[k]]$x)), k))
                   }
                 }))
bW <- unlist(bW)  # before widths
bw <- min(bW) * 2 # new width of third facet's columns
g3$grobs[[4]]$children[[names(bW)[3]]]$width[[1]] <- unit(bw, "native")
g3$grobs[[4]]$children[[names(bW)[3]]]$width[[2]] <- unit(bw, "native")    
                  # new x start position to accommodate wider columns
g3$grobs[[4]]$children[[names(bW)[3]]]$x[[1]] <- unit(flatten(bX)[[1]][[1]], "native")
g3$grobs[[4]]$children[[names(bW)[3]]]$x[[2]] <- unit(flatten(bX)[[1]][[3]], "native")
                  # close up unused space
g3$widths[[9]] <- unit(1.1, "null")
grid.draw(g3)

You can use the grid library.

First, create a grob object for grid library.

library(grid)
library(tidyverse)

g3 <- ggplotGrob(g2)

You'll have three gTree grobs because there are three plots in this grob.

Because you have columns and points, I looked for grobs that had children with names that contained geom_rect and geom_point. Once I found one, I counted the number of children and used that count to look for the others. There will be at least another child for the panel (background) and the gTree. In this case, there are actually 6 children for each plot grob.

So you know, this lapply was built iteratively, after I found what I was looking for, I had to work with the grob to find out how I could access the different elements. (Understanding how this is built could be useful, should you try to apply this to different data or different graphs.)

This code creates a list of column widths and the position on the x-axis the column needs to start in the units specified.

bW <- list() # to collect the "before" width
bX <- list() # to collect the "before" x position start of column
invisible(lapply(1:length(g4), 
                 function(j) {
                   if(length(g4[[j]]$children) > 5) { # grobs with more than 5 kids
                     i <- g4[[j]]$children             # extract children
                     k <- i[grepl("rect", names(i))] %>%  # get name
                       gsub("^.*\\[(.*)\\].", "\\1", .)
                     message("results of k ", k, " for ", j)
                     message("width is ")                 
                     message(print(i[[k]]$width))
                     message("x is ")
                     message(print(i[[k]]$x))
                                              # capture before widths and x positions
                     bW[length(bW)   1] <<- list(setNames(i[[k]]$width[[1]], k))
                     bX[length(bX)   1] <<- list(setNames(list(c(i[[k]]$x)), k))
                   }
                 }))

With the 'before' list of column widths, I want the smallest value & 2. The sizes of the columns are relative to the plot width, so if we're going to reduce the unused plot space, you need to make the columns wider first. I used the 4-column plot column widths times 2. However if you understand the relative nature, this isn't going to be perfect. (It's going to be 'close' to what you wanted.)

Since there are two columns, a width with units needs to be designated for each one. And most important... inspecting what you're expecting.

bW <- unlist(bW)
# geom_rect.rect.11892 geom_rect.rect.11894 geom_rect.rect.11896 
#            0.1840909            0.1840909            0.2045455  

bw <- min(bW) * 2 # new column width, before rendering plot more narrow
# [1] 0.3681818 

g3$grobs[[4]]$children[[names(bW)[3]]]$width       # before
# [1] 0.204545454545455native 0.204545454545455native 
g3$grobs[[4]]$children[[names(bW)[3]]]$width[[1]] <- unit(bw, "native")
g3$grobs[[4]]$children[[names(bW)[3]]]$width[[2]] <- unit(bw, "native")
g3$grobs[[4]]$children[[names(bW)[3]]]$width       # after
# [1] 0.368181818181818native 0.368181818181818native

If we left it like this, the columns wouldn't be centered anymore. That's why we also collected x.

So far, it looks like this.

There will be an x value for each column. So really, we want to start where the 1st and 3rd columns start in the first two facets.

flatten(bX)
# $geom_rect.rect.12931
# [1] 0.07840909 0.28295455 0.53295455 0.73750000
# 
# $geom_rect.rect.12933
# [1] 0.07840909 0.28295455 0.53295455 0.73750000
# 
# $geom_rect.rect.12935
# [1] 0.1704545 0.6250000
#  

g3$grobs[[4]]$children[[names(bW)[3]]]$x       # before
# [1] 0.170454545454545native 0.625native      # use the first plot, 1st column position
g3$grobs[[4]]$children[[names(bW)[3]]]$x[[1]] <- unit(flatten(bX)[[1]][[1]], "native")
                                               # use the first plot, 3rd column position
g3$grobs[[4]]$children[[names(bW)[3]]]$x[[2]] <- unit(flatten(bX)[[1]][[3]], "native")
g3$grobs[[4]]$children[[names(bW)[3]]]$x       # after
# [1] 0.0784090909090909native 0.532954545454545native

Now the columns are centered.

Now that they're wider and centered, we can change the real estate this plot takes. Remember...it's all relative sizing.

You can see the widths like this:

g3$widths

But the output is not meaningful! The best way I can say that you can make sense of what this is telling you is with two additional calls. When you call for the layout in the first line of code, you'll get a table of values that may not mean all that much, what you get from the second call is a table indicating how it's all broken down. For example, you'll see 8-9 in the space where the third facet goes. At the top and bottom of each facet, you'll see 2.2null. This is the size we need to change.

g3$layout
gtable::gtable_show_layout(g3)

So now that we know each plot is 2.2null, we can go back to the widths output and look for the third time 2.2null is called. Since you're looking for more or less half the space, for half the columns, I chose to use 1.1.

g3$widths[[9]] <- unit(1.1, "null")
g3$widths
#  [1] 5.5points           0cm                 1grobwidth         
#  [4] 0.691935845800368cm 2.2null             5.5points          
#  [7] 2.2null             5.5points           1.1null            
# [10] 0cm                 0cm                 11points           
# [13] 1.36216308454538cm  0points             5.5points           
grid.draw(g3)