tchakravarty tchakravarty - 3 months ago 107
R Question

R: grid.arrange marginal plots to ggplot2 "heatmap" (geom_tile)

I want to add two bar charts to the top and right of a heatmap representing the marginal distributions along the two dimensions of the bivariate distribution that the heatmap represents.

Here is some code:

library(gridExtra)
library(ggExtra)
library(cowplot)

# generate some data
df_hm = cbind(
expand.grid(
rows = sample(letters, 10),
cols = sample(LETTERS, 10)
),
value = rnorm(100)
)

# plot the heatmap
gg_hm = df_hm %>%
ggplot(aes(x = rows, y = cols, fill = value)) +
geom_tile() +
theme(legend.position = "bottom")

gg_rows = df_hm %>%
group_by(rows) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = rows,y = value)) +
geom_bar(stat = "identity", position = "dodge")

gg_cols = df_hm %>%
group_by(cols) %>%
summarize(value = mean(value)) %>%
ggplot(aes(x = cols, y = value))+
geom_bar(stat = "identity", position = "dodge") +
coord_flip()

gg_empty = df_hm %>%
ggplot(aes(x = cols, y = value)) +
geom_blank() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
line = element_blank(),
panel.background = element_blank())

# try this with grid.arrange
grid.arrange(gg_rows, gg_empty, gg_hm, gg_cols,
ncol = 2, nrow = 2, widths = c(3, 1), heights = c(1, 3))


which produces this:
enter image description here

What I want to be able to do is to move the graphs to align as indicated by the red arrows:
- the y-axis of (1, 1) should line up with the y-axis of (2, 1)
- the x-axis of (2, 1) should line up with the x-axis of (2, 2)

Answer

gtable is extremely useful. scales provides tools to format the axis ticks, to achieve alignment between the text y.ticks of the heatmap (X, F, ...) and the numeric y.ticks of the barplot on top, by formatting the former to a fixed width of 5 chars (to be adapted for your specific barplot).

require(ggplot2)
require(gtable)
require(grid)
library(dplyr)
library(scales)


## To format heatmap y.ticks with appropriate width (5 chars),
## to align with gg_rows y.tics
ytickform <- function(x){
    lab <- sprintf("%05s",x)
}

set.seed(123)
## generate some data
df_hm = cbind(
  expand.grid(
    rows = sample(letters, 10), 
    cols = sample(LETTERS, 10)
  ), 
  value = rnorm(100)
)

# plot the heatmap
gg_hm = df_hm %>% 
    ggplot(aes(x = rows, y = cols, fill = value)) + 
    geom_tile() + 
    scale_y_discrete(label=ytickform) +
    theme(legend.position = "bottom",
          plot.margin = unit(c(3,3,3,3), "mm"))

gg_rows = df_hm %>% 
    group_by(rows) %>% 
    summarize(value = mean(value)) %>% 
    ggplot(aes(x = rows,y = value)) + 
    geom_bar(stat = "identity", position = "dodge") +
    theme(plot.margin = unit(c(3,3,3,3), "mm"))


gg_cols = df_hm %>% 
    group_by(cols) %>% 
    summarize(value = mean(value)) %>% 
    ggplot(aes(x = cols, y = value))+ 
    geom_bar(stat = "identity", position = "dodge") + 
    coord_flip() +
    theme(plot.margin = unit(c(3,3,3,3), "mm"))

## extract legend from heatmap
g <- ggplotGrob(gg_hm)$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]

## plot heatmap without legend
g <- ggplotGrob(gg_hm + theme(legend.position="none"))

## add column and put column barplot within
g <- gtable_add_cols(g, unit(5,"cm"))
g <- gtable_add_grob(g, ggplotGrob(gg_cols), 
                     t = 1, l=ncol(g), b=nrow(g), r=ncol(g))

## add row and put legend within
g <- gtable_add_rows(g, unit(1,"cm"))
g <- gtable_add_grob(g, legend, 
                     t = nrow(g), l=1, b=nrow(g), r=ncol(g)-1)

## add row on top and put row barplot within
g <- gtable_add_rows(g, unit(5,"cm"), 0)
g <- gtable_add_grob(g, ggplotGrob(gg_rows),
                     t = 1, l=1, b=1, r=5) 

grid.newpage()
grid.draw(g)

References:

Align ggplot2 plots vertically

http://www.cookbook-r.com/Graphs/Axes_(ggplot2)/#tick-mark-label-text-formatters

https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs