Nested facets in ggplot2 spanning groups
The answer to this lies within the grid
and gtable
packages. Everything in the plot is laid out in a particular order and you can find where everything is if you dig a little.
library('gtable')
library('grid')
library('magrittr') # for the %>% that I love so well
# First get the grob
z <- ggplotGrob(p)
The ultimate goal of this operation is to overlay the top facet label, but the trick is that both of these facets exist on the same row in the grid space. They are a table within a table (look at the rows with the name "strip", also take note of the zeroGrob
; these will be useful later):
z
## TableGrob (13 x 14) "layout": 34 grobs
## z cells name grob
## 1 0 ( 1-13, 1-14) background rect[plot.background..rect.522]
## 2 1 ( 7- 7, 4- 4) panel-1-1 gTree[panel-1.gTree.292]
...
## 20 3 ( 7- 7,12-12) axis-r-1 zeroGrob[NULL]
## 21 3 ( 9- 9,12-12) axis-r-2 zeroGrob[NULL]
## 22 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip]
## 23 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip]
## 24 2 ( 6- 6, 8- 8) strip-t-3 gtable[strip]
## 25 2 ( 6- 6,10-10) strip-t-4 gtable[strip]
## 26 2 ( 7- 7,11-11) strip-r-1 gtable[strip]
## 27 2 ( 9- 9,11-11) strip-r-2 gtable[strip]
...
## 32 8 ( 3- 3, 4-10) subtitle zeroGrob[plot.subtitle..zeroGrob.519]
## 33 9 ( 2- 2, 4-10) title zeroGrob[plot.title..zeroGrob.518]
## 34 10 (12-12, 4-10) caption zeroGrob[plot.caption..zeroGrob.520]
If you zoom in to the first strip, you can see the nested structure:
z$grob[[22]]
## TableGrob (2 x 1) "strip": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) strip absoluteGrob[strip.absoluteGrob.451]
## 2 2 (2-2,1-1) strip absoluteGrob[strip.absoluteGrob.475]
For each grob, we have an object that lists the order in which it's plotted (z), the position in the grid (cells), a label (name), and a geometry (grob).
Since we can create gtables within gtables, we are going to use this to plot over our original plot. First, we need to find the positions in the plot that need replacing.
# Find the location of the strips in the main plot
locations <- grep("strip-t", z$layout$name)
# Filter out the strips (trim = FALSE is important here for positions relative to the main plot)
strip <- gtable_filter(z, "strip-t", trim = FALSE)
# Gathering our positions for the main plot
top <- strip$layout$t[1]
l <- strip$layout$l[c(1, 3)]
r <- strip$layout$r[c(2, 4)]
Once we have the positions, we need to create a replacement table. We can do this with a matrix of lists (yes, it's weird. Just roll with it). This matrix needs to have three columns and two rows in our case because of the two facets and the gap between them. Since we are just going to replace data in the matrix later, we're going to create one with zeroGrob
s:
mat <- matrix(vector("list", length = 6), nrow = 2)
mat[] <- list(zeroGrob())
# The separator for the facets has zero width
res <- gtable_matrix("toprow", mat, unit(c(1, 0, 1), "null"), unit(c(1, 1), "null"))
The mask is created in two steps, covering the first facet group and then the second. In the first part, we are using the location we recorded earlier to grab the appropriate grob from the original plot and add it on top of our replacement matrix res
, spanning the entire length. We then add that matrix on top of our plot.
# Adding the first layer
zz <- res %>%
gtable_add_grob(z$grobs[[locations[1]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(z, ., t = top, l = l[1], b = top, r = r[1], name = c("add-strip"))
# Adding the second layer (note the indices)
pp <- gtable_add_grob(res, z$grobs[[locations[3]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(zz, ., t = top, l = l[2], b = top, r = r[2], name = c("add-strip"))
# Plotting
grid.newpage()
print(grid.draw(pp))
ggplot2: have common facet bar in outer facet panel in 3-way plot
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:
Make text labels span multiple ggplot facet grid panes
Use clip = "off"
from coord_cartesian
:
library(ggplot2)
library(ggrepel)
ggplot(df, aes(x, y, label = label)) +
geom_point() +
facet_grid(cols = vars(group)) +
geom_text_repel() +
coord_cartesian(clip = "off")
If this is not enough, one other option is to use multilining with stringr::str_wrap
:
library(stringr)
library(dplyr)
df %>%
mutate(label_wrapped = str_wrap(label, width = 20)) %>%
ggplot(aes(x, y, label = label_wrapped)) +
geom_point() +
facet_grid(cols = vars(group)) +
geom_text_repel() +
coord_cartesian(clip = 'off')
data
set.seed(2)
df <- data.frame(
x = rep(1:3, 5),
y = runif(15),
label = paste0("very very very long label ", 1:15),
group = do.call(c, lapply(paste0("group ", 1:5), function(x) rep(x, 3)))
)
Combine multiple facet strips across columns in ggplot2 facet_wrap
Here's a reprex of a somewhat pedestrian way to do it in grid. I have made the "parent" facet somewhat darker to emphasise the nesting, but if you prefer the color to match just change the rectGrob
fill color to "gray85".
# Set up plot as per example
library(tidyverse)
library(gtable)
library(grid)
idx = 1:16
p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
mutate(y=rnorm(n=n())) %>%
ggplot(aes(x=x,y=y)) +
geom_jitter() +
facet_wrap(~id + id2, nrow = 4, ncol=8)
g <- ggplot_gtable(ggplot_build(p1))
# Code to produce facet strips
stript <- grep("strip", g$layout$name)
grid_cols <- sort(unique(g$layout[stript,]$l))
t_vals <- rep(sort(unique(g$layout[stript,]$t)), each = length(grid_cols)/2)
l_vals <- rep(grid_cols[seq_along(grid_cols) %% 2 == 1], length = length(t_vals))
r_vals <- rep(grid_cols[seq_along(grid_cols) %% 2 == 0], length = length(t_vals))
labs <- levels(as.factor(p1$data$id))
for(i in seq_along(labs))
{
filler <- rectGrob(y = 0.7, height = 0.6, gp = gpar(fill = "gray80", col = NA))
tg <- textGrob(label = labs[i], y = 0.75, gp = gpar(cex = 0.8))
g <- gtable_add_grob(g, filler, t = t_vals[i], l = l_vals[i], r = r_vals[i],
name = paste0("filler", i))
g <- gtable_add_grob(g, tg, t = t_vals[i], l = l_vals[i], r = r_vals[i],
name = paste0("textlab", i))
}
grid.newpage()
grid.draw(g)
And to demonstrate changing the rectGrob
to 50% height and "gray85":
Or if you wanted you could assign a different fill for each cycle of the loop:
Obviously the above method might take a few tweaks to fit other plots with different numbers of levels etc.
Created on 2020-07-04 by the reprex package (v0.3.0)
arranging columns and sub-columns in ggplot2 using facet_wrap?
You can multiply the factors used for columns and subcolumns.
library(ggplot2)
ggplot(mtcars, aes(disp, mpg)) +
geom_point() +
facet_wrap(~ cyl * gear, labeller = label_both)
The labeller
label_both
here also is useful as it adds the variable name before the value in the facet header.
Facetting by groups with ggplot2: code yields a single graph with no facets
So, the problem is because you are missing the quotes in the vector you are comparing against with %in%
. But the reason you were getting error messages is a bit more complex than that. You must have objects in your workspace named var11
, var12
, etc.
Starting with a clean workspace:
require(reshape2)
dat = data.frame(ID = rnorm(10), var11 = rnorm(10),
var12 = rnorm(10), var21 = rnorm(10), var22 = rnorm(10),
var13 = rnorm(10), var23 = rnorm(10))
df.m = melt(dat, id.vars = 1)
If I do this, I get an error message when I run transform:
dfm2 = transform(df.m, facet=ifelse(variable %in% c(var11, var12), 'One',
ifelse(variable %in% c(var21, var22), 'Two', 'Three')))
Error in match(x, table, nomatch = 0L) : object 'var11' not found
Now I create some vector objects with the same names in my workspace:
var11 = 1
var12 = 2
var21 = 1
var22 = 2
var13 = 1
dfm2 = transform(df.m, facet=ifelse(variable %in% c(var11, var12), 'One',
ifelse(variable %in% c(var21, var22), 'Two', 'Three')))
Wah-lah, no error message and one level for the facet
variable instead of three. Essentially, you never had any matches so the last level (Three
) is assigned to everything.
You need those quotes to refer to a character vector instead of the objects.
transform(df.m, facet=ifelse(variable %in% c("var11", "var12"), 'One',
ifelse(variable %in% c("var21", "var22"), 'Two', 'Three')))
ggplot2: More complex faceting
This will put a new strip to the right of the orignal strip, and to the left of the legend.
library(ggplot2)
library(gtable)
library(grid)
p <- ggplot(mtcars, aes(mpg, wt, colour = factor(vs))) + geom_point()
p <- p + facet_grid(cyl ~ gear)
# Convert the plot to a grob
gt <- ggplotGrob(p)
# Get the positions of the right strips in the layout: t = top, l = left, ...
strip <-c(subset(gt$layout, grepl("strip-r", gt$layout$name), select = t:r))
# New column to the right of current strip
gt <- gtable_add_cols(gt, gt$widths[max(strip$r)], max(strip$r))
# Add grob, the new strip, into new column
gt <- gtable_add_grob(gt,
list(rectGrob(gp = gpar(col = NA, fill = "grey85", size = .5)),
textGrob("Number of Cylinders", rot = -90, vjust = .27,
gp = gpar(cex = .75, fontface = "bold", col = "black"))),
t = min(strip$t), l = max(strip$r) + 1, b = max(strip$b), name = c("a", "b"))
# Add small gap between strips
gt <- gtable_add_cols(gt, unit(1/5, "line"), max(strip$r))
# Draw it
grid.newpage()
grid.draw(gt)
Related Topics
Expand Rows by Date Range Using Start and End Date
Assign Multiple Objects to .Globalenv from Within a Function
How to Order Data by Value Within Ggplot Facets
How to Delete Rows from a Dataframe That Contain N*Na
Call Apply-Like Function on Each Row of Dataframe With Multiple Arguments from Each Row
Gradient of N Colors Ranging from Color 1 and Color 2
How to Install Packages in Latest Version of Rstudio and R Version.3.1.1
All Levels of a Factor in a Model Matrix in R
How to Put Labels Over Geom_Bar For Each Bar in R With Ggplot2
Custom Legend For Multiple Layer Ggplot
How to Get Week Numbers from Dates
Find How Many Times Duplicated Rows Repeat in R Data Frame
Count the Number of All Words in a String
R: Gsub, Pattern = Vector and Replacement = Vector
Find Which Season a Particular Date Belongs To
Group by Multiple Columns in Dplyr, Using String Vector Input
Merging Two Data Frames Using Fuzzy/Approximate String Matching in R