Overall Label for Facets

2019-01-14 19:53发布

问题:

Here is some minimal code to generate a graph with two sets of facets.

library("ggplot2", quietly = TRUE, warn.conflicts = FALSE)
library("RColorBrewer", quietly = TRUE, warn.conflicts = FALSE)
val.a <- rnorm(10)
val.b <- rnorm(10)
val.c <- c("A","B","A","A","B","B","B","B","A","B")
val.d <- c("D","D","E","D","E","E","E","D","D","E")
val.e <- rnorm(10)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)
ggplot(maya, aes(x=val.a, y=val.b)) +
  geom_point(shape=20,size=3, aes(colour=val.e)) +
  facet_grid(val.c~val.d) +
  xlab("Leonardo") + ylab("Michaelangelo") +
  scale_colour_gradientn(colours=brewer.pal(9,"YlGnBu"), name="Splinter")

I can't figure out how to add an overall facet label so that the names Donatello and Raphael are on the top and right hand side axis.

I saw some similar solutions on SO, but I can't make heads or tails of the code. Please would you suggest an answer to my conundrum?

Similar question here, but it fails for me if I have more than two facets. The labels show up somewhere inside the graph. Is there a way to make this work for the general case?

So I tried rawr's solution at the link above, and it ended up at the same place for multiple columns. Here's the code updated to rawr's solution, but it's producing the labels in unexpected (for me because I don't understand the solution) places.

library("ggplot2", quietly = TRUE, warn.conflicts = FALSE)
library("RColorBrewer", quietly = TRUE, warn.conflicts = FALSE)
val.a <- rnorm(20)
val.b <- rnorm(20)
val.c <- c("A","B","C","D","E","F","G","H","I","J")
val.d <- c("A","B","C","D","E","F","G","H","I","J")
val.e <- rnorm(20)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)
p <- ggplot(maya, aes(x=val.a, y=val.b)) + geom_point(shape=20,size=3, aes(colour=val.e)) + facet_grid(val.c~val.d) + xlab("Leonardo") + ylab("Michaelangelo") + scale_colour_gradientn(colours=brewer.pal(9,"YlGnBu"), name="Splinter")
z <- ggplotGrob(p)

library(grid)
library(gtable)
# add label for right strip
z <- gtable_add_cols(z, unit(z$width[[7]], 'cm'), 7)
z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = gray(0.5))),
                          textGrob("Variable 1", rot = -90, gp = gpar(col = gray(1)))),
                     4, 8, 6, name = paste(runif(2)))

# add label for top strip
z <- gtable_add_rows(z, unit(z$heights[[3]], 'cm'), 2)
z <- gtable_add_grob(z, 
                     list(rectGrob(gp = gpar(col = NA, fill = gray(0.5))),
                          textGrob("Variable 2", gp = gpar(col = gray(1)))),
                     3, 4, 3, 6, name = paste(runif(2)))

# add margins
z <- gtable_add_cols(z, unit(1/8, "line"), 7)
z <- gtable_add_rows(z, unit(1/8, "line"), 3)

# draw it
grid.newpage()
grid.draw(z)

Please would someone kindly point out to me the part of the code that's telling it how wide the general facet label should be?

回答1:

This is fairly general. The current locations of the top and right strips are given in the layout data frame. This solution uses those locations to position the new strips. The new strips are constructed so that heights, widths, background colour, and font size and colour are the same as in current strips. There are some explanations below.

# Packages
library(ggplot2)
library(RColorBrewer)
library(grid)
library(gtable)

# Data
val.a <- rnorm(20)
val.b <- rnorm(20)
val.c <- c("A","B","C","D","E","F","G","H","I","J")
val.d <- c("A","B","C","D","E","F","G","H","I","J")
val.e <- rnorm(20)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)

# Base plot
p <- ggplot(maya, aes(x = val.a, y = val.b)) + 
   geom_point(shape = 20,size = 3, aes(colour = val.e)) + 
   facet_grid(val.c ~ val.d) + 
   xlab("Leonardo") + ylab("Michaelangelo") + 
   scale_colour_gradientn(colours = brewer.pal(9,"YlGnBu"), name = "Splinter")

# Labels 
labelR = "Variable 1"
labelT = "Varibale 2"

# Get the ggplot grob
z <- ggplotGrob(p)

# Get the positions of the strips in the gtable: t = top, l = left, ...
posR <- subset(z$layout, grepl("strip-r", name), select = t:r)
posT <- subset(z$layout, grepl("strip-t", name), select = t:r)

# Add a new column to the right of current right strips, 
# and a new row on top of current top strips
width <- z$widths[max(posR$r)]    # width of current right strips
height <- z$heights[min(posT$t)]  # height of current top strips

z <- gtable_add_cols(z, width, max(posR$r))  
z <- gtable_add_rows(z, height, min(posT$t)-1)

# Construct the new strip grobs
stripR <- gTree(name = "Strip_right", children = gList(
   rectGrob(gp = gpar(col = NA, fill = "grey85")),
   textGrob(labelR, rot = -90, gp = gpar(fontsize = 8.8, col = "grey10"))))

stripT <- gTree(name = "Strip_top", children = gList(
   rectGrob(gp = gpar(col = NA, fill = "grey85")),
   textGrob(labelT, gp = gpar(fontsize = 8.8, col = "grey10"))))

# Position the grobs in the gtable
z <- gtable_add_grob(z, stripR, t = min(posR$t)+1, l = max(posR$r) + 1, b = max(posR$b)+1, name = "strip-right")
z <- gtable_add_grob(z, stripT, t = min(posT$t), l = min(posT$l), r = max(posT$r), name = "strip-top")

# Add small gaps between strips
z <- gtable_add_cols(z, unit(1/5, "line"), max(posR$r))
z <- gtable_add_rows(z, unit(1/5, "line"), min(posT$t))

# Draw it
grid.newpage()
grid.draw(z)



标签: r ggplot2 gtable