R：grid.arange marginal plots to ggplot2 "heatmap"（geom_tile）

Question

ヒートマップが表す2変量分布の2次元に沿った限界分布を表すヒートマップの2つの棒グラフを追加したいとします。ここで

は、いくつかのコードは次のとおりです。

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)) 

この生成する：

を私が行うことができるようにしたいどのような赤い矢印で示すように整列するために、グラフを移動することです： - （1,1）のy軸は、（2,1）のy軸と一致する必要があります。 - （2,1）のx軸は、（2,2）のx軸と一致する必要があります。

Answer 1

gtableは極端ですely有用です。 scalesは、ヒートマップ（X、F、...）のテキストy.tickとその上のバープロットの数値y.ticksの間のアラインメントを実現するために、軸のティックをフォーマットするツールを提供します。 5つの文字（あなたの特定のバープロットに合わせて）。

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) 

参考文献：

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

Answer 2

私はレナートのビトロによって受け入れ答えを試してみましたが、アライメントが私のマシン上で動作しませんでした。しかし、私はその後、ずっと簡単な解決策を見つけました：eggパッケージ（CRANで利用可能）。 eggは、というバージョンのggarrangeを提供しています。これは、同様の引数をとりますが、軸をうまく整列させます。 OPのコードでは、ちょうどlibrary(egg)、library(dplyr)を追加して、grid.arrangeをggarrange（eggをinstall.packages("egg")にインストールしたもの）に置き換えただけです。

全コード：

library(gridExtra) 
library(cowplot) 
library(egg) 
library(dplyr) 

# 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()) 

ggarrange(
    gg_rows, gg_empty, gg_hm, gg_cols, 
    nrow = 2, ncol = 2, widths = c(3, 1), heights = c(1, 3) 
) 

出力：優れている