Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

ggplot2: have common facet bar in outer facet panel in 3-way plot

Tags:

r

ggplot2

I have the following code:

label_rev <- function(labels, multi_line = TRUE, sep = ": ") {
     label_both(rev(labels), multi_line = multi_line, sep = sep)
  }
require(ggplot2)
p <- ggplot(data = mtcars, aes(wt, mpg)) + geom_point()
p + facet_grid(vs + cyl ~ gear, labeller = label_rev)

I get the following figure: enter image description here

Here is my dilemma: I would like the outerstrip of vs:0 to be only one panel encompassing the three facets (cyl:4, 6, 8) and the outstrip of vs:1 to be one panel encompassing the three facets (cyl:4, 6, 8).

Is it possible to do this using ggplot2?

Thanks again in advance for any help!

like image 633
user3236841 Avatar asked Sep 30 '16 22:09

user3236841


People also ask

What is facet in ggplot2?

The facet approach partitions a plot into a matrix of panels. Each panel shows a different subset of the data. This R tutorial describes how to split a graph using ggplot2 package.

How do I rearrange facets in ggplot2?

To reorder the facets accordingly of the given ggplot2 plot, the user needs to reorder the levels of our grouping variable accordingly with the help of the levels function and required parameter passed into it, further it will lead to the reordering of the facets accordingly in the R programming language.

What is the difference between Facet_wrap and Facet_grid?

The facet_grid() function will produce a grid of plots for each combination of variables that you specify, even if some plots are empty. The facet_wrap() function will only produce plots for the combinations of variables that have values, which means it won't produce any empty plots.

What is the function of Facet_grid () in Ggplot ()?

facet_grid() forms a matrix of panels defined by row and column faceting variables. It is most useful when you have two discrete variables, and all combinations of the variables exist in the data. If you have only one variable with many levels, try facet_wrap() .


2 Answers

I took the liberty to edit and generalise the function given here by Sandy Muspratt so that it allows for two-way nested facets, as well as expressions as facet headers if labeller=label_parsed is specified in facet_grid().

library(ggplot2)
library(grid)
library(gtable)
library(plyr)    

## The function to get overlapping strip labels
OverlappingStripLabels = function(plot) {

  # Get the ggplot grob
  pg = ggplotGrob(plot)

  ### Collect some information about the strips from the plot
  # Get a list of strips
  stripr = lapply(grep("strip-r", pg$layout$name), function(x) {pg$grobs[[x]]})

  stript = lapply(grep("strip-t", pg$layout$name), function(x) {pg$grobs[[x]]})

  # Number of strips
  NumberOfStripsr = sum(grepl(pattern = "strip-r", pg$layout$name))
  NumberOfStripst = sum(grepl(pattern = "strip-t", pg$layout$name))

  # Number of columns
  NumberOfCols = length(stripr[[1]])
  NumberOfRows = length(stript[[1]])

  # Panel spacing
  plot_theme <- function(p) {
    plyr::defaults(p$theme, theme_get())
  }
  PanelSpacing = plot_theme(plot)$panel.spacing

  # Map the boundaries of the new strips
  Nlabelr = vector("list", NumberOfCols)
  mapr = vector("list", NumberOfCols)
  for(i in 1:NumberOfCols) {

    for(j in 1:NumberOfStripsr) {
      Nlabelr[[i]][j] = getGrob(grid.force(stripr[[j]]$grobs[[i]]), gPath("GRID.text"), grep = TRUE)$label
    }

    mapr[[i]][1] = TRUE
    for(j in 2:NumberOfStripsr) {
      mapr[[i]][j] = as.character(Nlabelr[[i]][j]) != as.character(Nlabelr[[i]][j-1])#Nlabelr[[i]][j] != Nlabelr[[i]][j-1]
    }
  }

  # Map the boundaries of the new strips
  Nlabelt = vector("list", NumberOfRows)
  mapt = vector("list", NumberOfRows)
  for(i in 1:NumberOfRows) {

    for(j in 1:NumberOfStripst) {
      Nlabelt[[i]][j] = getGrob(grid.force(stript[[j]]$grobs[[i]]), gPath("GRID.text"), grep = TRUE)$label
    }

    mapt[[i]][1] = TRUE
    for(j in 2:NumberOfStripst) {
      mapt[[i]][j] = as.character(Nlabelt[[i]][j]) != as.character(Nlabelt[[i]][j-1])#Nlabelt[[i]][j] != Nlabelt[[i]][j-1]
    }
  }


  ## Construct gtable to contain the new strip
  newStripr  = gtable(heights = unit.c(rep(unit.c(unit(1, "null"), PanelSpacing), NumberOfStripsr-1), unit(1, "null")), 
                     widths = stripr[[1]]$widths)
  ## Populate the gtable  
  seqTop = list()
  for(i in NumberOfCols:1) {  
    Top = which(mapr[[i]] == TRUE)
    seqTop[[i]] = if(i == NumberOfCols) 2*Top - 1 else  sort(unique(c(seqTop[[i+1]], 2*Top - 1)))  
    seqBottom = c(seqTop[[i]][-1] -2, (2*NumberOfStripsr-1))
    newStripr = gtable_add_grob(newStripr, lapply(stripr[(seqTop[[i]]+1)/2], function(x) x[[1]][[i]]), l = i, t = seqTop[[i]], b = seqBottom)
  }

  mapt <- mapt[NumberOfRows:1]
  Nlabelt <- Nlabelt[NumberOfRows:1]
  ## Do the same for top facets
  newStript  = gtable(heights = stript[[1]]$heights,
                      widths = unit.c(rep(unit.c(unit(1, "null"), PanelSpacing), NumberOfStripst-1), unit(1, "null")))
  seqTop = list()
  for(i in NumberOfRows:1) {  
    Top = which(mapt[[i]] == TRUE)
    seqTop[[i]] = if(i == NumberOfRows) 2*Top - 1 else  sort(unique(c(seqTop[[i+1]], 2*Top - 1)))  
    seqBottom = c(seqTop[[i]][-1] -2, (2*NumberOfStripst-1))
    # newStript = gtable_add_grob(newStript, lapply(stript[(seqTop[[i]]+1)/2], function(x) x[[1]][[i]]), l = i, t = seqTop[[i]], b = seqBottom)
    newStript = gtable_add_grob(newStript, lapply(stript[(seqTop[[i]]+1)/2], function(x) x[[1]][[(NumberOfRows:1)[i]]]), t = (NumberOfRows:1)[i], l = seqTop[[i]], r = seqBottom)
  }

  ## Put the strip into the plot
  # Get the locations of the original strips
  posr = subset(pg$layout, grepl("strip-r", pg$layout$name), t:r)
  post = subset(pg$layout, grepl("strip-t", pg$layout$name), t:r)

  ## Use these to position the new strip
  pgNew = gtable_add_grob(pg, newStripr, t = min(posr$t), l = unique(posr$l), b = max(posr$b))
  pgNew = gtable_add_grob(pgNew, newStript, l = min(post$l), r = max(post$r), t=unique(post$t))
  grid.draw(pgNew)

  return(pgNew)
}


# Initial plot
p <- ggplot(data = mtcars, aes(wt, mpg)) + geom_point() +
  facet_grid(vs + cyl ~ am + gear, labeller = label_both) +
  theme_bw() +
  theme(panel.spacing=unit(.2,"lines"),
        strip.background=element_rect(color="grey30", fill="grey90"))

## Draw the plot
grid.newpage()
grid.draw(OverlappingStripLabels(p))

Here is an example: enter image description here

like image 39
Yo B. Avatar answered Sep 20 '22 16:09

Yo B.


This can now easily be done with facet_nested() from the ggh4x package

library(ggplot2)
library(ggh4x)
p <- ggplot(data = mtcars, aes(wt, mpg)) + geom_point()
p + 
  facet_nested(vs + cyl ~ am + gear, labeller = label_both) +
  theme(panel.spacing = unit(0,"line")) 

Created on 2020-03-25 by the reprex package (v0.3.0)

like image 53
Tung Avatar answered Sep 21 '22 16:09

Tung