在 R 中使用 ggplot 将 geom_tile 移动到绘图区域之外？

Question

I recently asked this question about plotting outside of the plot area using geom_tile and ggplot and I received an excellent answer. But I was wondering how I could tweak the results of the previous answer and manually move the extra bars that are being plotted.

For example, below is the code I'm using to create the plot. I'm using the patchwork package to add the extra geom_tile bars to outside of the plotting area, like so:

library(colorspace)
library(ggplot2)
library(patchwork)
library(tidyverse)

# create data
df <- data.frame(
  a = paste0("a", c(1,1,1,2,2,2,3,3,3)),
  b = paste0("b", c(1,2,3,1,2,3,1,2,3)),
  c = c(-10, 3, 5, -2, 9, 1, -5, -2, 0)
)

# create some extra data to plot
extraBars <- rnorm(6)

# From discrete to continuous
df$a <- match(df$a, sort(unique(df$a)))
df$b <- match(df$b, sort(unique(df$b)))

# create labels
labels_a <- paste0("a", 1:length(df$a))
labels_b <- paste0("b", 1:length(df$b))

# set limits and colour palette 
intLims <- range(df$c)
limitsInt <- c(floor(intLims[1]), ceiling(intLims[2]))
intPal = rev(diverging_hcl(palette = "Blue-Red 3", n = 100))

# some preprcessing
NoOfa <- length(unique(df$a))
NoOfb <- length(unique(df$b))
NoOfd<- length(extraBars)

# main heatmap plot
p_main <- ggplot(df, aes(a, b)) +
  geom_tile(aes(fill = c)) +
  scale_y_continuous(breaks = c(1:length(labels_b)), labels = labels_b) +
  scale_x_continuous(breaks = c(1:length(labels_a)), labels = labels_a) +
  scale_fill_gradientn(
    limits = limitsInt,
    colors = intPal,
    guide = guide_colorbar(
      frame.colour = "black",
      ticks.colour = "black"
    ),
    name = "C"
  ) +
  theme_classic() +
  labs(x = "a", y = "b")



# bottom bar
p_bottom <- ggplot() +
  geom_tile(
    data = tibble(a = 1:NoOfa, extraBars = extraBars[(NoOfb + 1):NoOfd]),
    aes(x = a, y = 0, fill = extraBars)
  ) +
  scale_fill_gradientn(
    limits = limitsInt,
    colors = intPal,
    guide = guide_colorbar(
      frame.colour = "black", ticks.colour = "black"
    )
  ) +
  theme_void() +
  theme(legend.position = "none")

# left bar
p_left <- ggplot() +
  geom_tile(
    data = tibble(b = 1:NoOfb, extraBars = extraBars[1:NoOfb]),
    aes(x = 0, y = b, fill = extraBars)
  ) +
  scale_fill_gradientn(
    limits = limitsInt,
    colors = intPal,
    guide = guide_colorbar(
      frame.colour = "black",
      ticks.colour = "black"
    ),
    name = "extraBars"
  ) +
  theme_void()

# add them all together
p <- p_left + p_main + plot_spacer() + p_bottom +
  plot_layout(
    guides = "collect",
    heights = c(1, 0.07),
    widths = c(0.07, 1)
  )
p

This creates a plot like this:

However, what I would like to do is to swap the extra bars around the edge with the axis title labels. Below is a mock-up I created in photoshop to explain what Im trying to achieve:

I was wondering how I could achieve this?

Answer 1

One approach you could use is to place your colored bars outside the plot with grobs (Grid Objects) and use annotation_custom to add them to the plot. Using your example, I'll show you how you could do this. Just like your example, you would have to map the colors for the bars manually, but I'm not going to cover that here. The purpose here is to only demonstrate how you would go about creating the grobs in general and adding them to the plot.

In principle, it's pretty similar to the approach with patchwork . First you want to define the grobs themselves, then you add them to the plot via annotation_custom() and fiddle with the positioning. It's hard to explain exactly how and where you should move them around - in my experience with grobs I find I have to fiddle quite a lot with exact placement. Here's the general code and result.

library(grid)
library(gridExtra)
library(ggpubr)   # we use the convenient text_grob() function from here

# define your grobs
bottom_grob <- rectGrob(x=1:3, y=1, gp=gpar( fill=rainbow(6)[1:3], alpha=0.5 ))
left_grob <- rectGrob(x=1, y=1:3, gp=gpar( fill=rainbow(6)[4:6], alpha=0.5 ))
bottom_textgrob <- text_grob(x=1:3, y=0,label=round(extraBars[1:3],2), size=10)
left_textgrob <- text_grob(x=1, y=1:3, label=round(extraBars[4:6],2), size=10, rot=90)

# add to the plot
the_plot <- 
  ggplot(df, aes(a, b)) +
  geom_tile(aes(fill = c)) +
  scale_y_continuous(breaks = c(1:length(labels_b)), labels = labels_b) +
  scale_x_continuous(breaks = c(1:length(labels_a)), labels = labels_a) +
  scale_fill_gradientn(
    limits = limitsInt,
    colors = intPal,
    guide = guide_colorbar(
      frame.colour = "black",
      ticks.colour = "black"
    ),
    name = "C"
  ) +
  theme_classic() +
  theme(
    axis.title.x = element_text(margin=margin(t=30)),
    axis.title.y = element_text(margin=margin(r=30))
  ) +
  labs(x = "a", y = "b") +
  coord_cartesian(clip="off") +
  annotation_custom(grob=left_grob, xmin=0.02, xmax=0.15, ymin=0, ymax=1) +
  annotation_custom(grob=bottom_grob, xmin=0, xmax=1, ymin=-0.1, ymax=0.1) +
  annotation_custom(grob=bottom_textgrob, xmin=0, xmax=1, ymin=0.1, ymax=0.1) +
  annotation_custom(grob=left_textgrob, xmin=0, xmax=0.15, ymin=0, ymax=1)

the_plot

A few important notes about the code above:

• Note that you can provide vectors to the values for grob creation. We do this to create more than one rectangle by providing a vector of positions for x or y.
• I move the x axis title "down" and y axis title "to the left" by adding a margin to the theme element for each. This gives space for the grob.
• You must include turn off clipping by indicating clip="off" in one of the coord_* functions. This allows the stuff (grobs) to appear outside the panel of the plot (the place in-between the min and max x and y values).

Rainbow colors are only used to demonstrate more clearly what's going on, but you might want to map those to the particular value associated with extraBars or another color scale. What you see is that there is not a second legend... but honestly the extra legend makes things quite confusing in my mind. It's probably better to either make the outer bars all one color and/or just place the text value on top of them like I'm showing you here. I think it gets the same message across, but that's also a matter of opinion.

Hope this helps and gives you something to work from.