如何在heatmap中创建预注释的rowide列

Question

我有以下数据：

dat <- structure(list(GO = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 3L, 3L, 3L, 4L, 5L, 5L, 5L, 5L, 5L, 5L), .Label = c("apoptotic process", 
"metabolic process", "negative regulation of apoptotic process", 
"positive regulation of apoptotic process", "signal transduction"
), class = "factor"), ProbeGene = structure(c(14L, 15L, 2L, 12L, 
7L, 11L, 16L, 8L, 19L, 13L, 3L, 1L, 18L, 4L, 10L, 5L, 9L, 17L, 
20L, 6L), .Label = c("1416787_at Acvr1", "1418835_at Phlda1", 
"1419282_at Ccl12", "1423240_at Src", "1424896_at Gpr85", "1434186_at Lpar4", 
"1434670_at Kif5a", "1440374_at Pde1c", "1440681_at Chrna7", 
"1440803_x_at Tacr3", "1442017_at LOC101056574", "1448815_at Ogg1", 
"1448821_at Tyr", "1451338_at Nisch", "1454721_at Arel1", "1456300_at Ilvbl", 
"1456989_at Oxgr1", "1457580_at Chd8", "1457827_at Arsj", "1460657_at Wnt10a"
), class = "factor"), foo = c(1.412475312, 1.413647397, 1.41297239, 
-0.707106781, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781), bar = c(-0.645532476, -0.741475951, 
-0.655185417, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781, -0.707106781, -0.707106781, -0.707106781, 
-0.707106781, -0.707106781, -0.707106781), aux = c(-0.766942837, 
-0.672171445, -0.757786973, 1.414213562, 1.414213562, 1.414213562, 
1.414213562, 1.414213562, 1.414213562, 1.414213562, 1.414213562, 
1.414213562, 1.414213562, 1.414213562, 1.414213562, 1.414213562, 
1.414213562, 1.414213562, 1.414213562, 1.414213562)), .Names = c("GO", 
"ProbeGene", "foo", "bar", "aux"), row.names = c(50L, 35L, 45L, 
74L, 61L, 101L, 96L, 68L, 69L, 75L, 113L, 127L, 109L, 135L, 150L, 
152L, 183L, 190L, 197L, 191L), class = "data.frame")

看起来像这样（它们按GO列排序）：

> dat
                                          GO               ProbeGene        foo        bar        aux
50                         apoptotic process        1451338_at Nisch  1.4124753 -0.6455325 -0.7669428
35                         apoptotic process        1454721_at Arel1  1.4136474 -0.7414760 -0.6721714
45                         apoptotic process       1418835_at Phlda1  1.4129724 -0.6551854 -0.7577870
74                         metabolic process         1448815_at Ogg1 -0.7071068 -0.7071068  1.4142136
61                         metabolic process        1434670_at Kif5a -0.7071068 -0.7071068  1.4142136
101                        metabolic process 1442017_at LOC101056574 -0.7071068 -0.7071068  1.4142136
96                         metabolic process        1456300_at Ilvbl -0.7071068 -0.7071068  1.4142136
68                         metabolic process        1440374_at Pde1c -0.7071068 -0.7071068  1.4142136
69                         metabolic process         1457827_at Arsj -0.7071068 -0.7071068  1.4142136
75                         metabolic process          1448821_at Tyr -0.7071068 -0.7071068  1.4142136
113 negative regulation of apoptotic process        1419282_at Ccl12 -0.7071068 -0.7071068  1.4142136
127 negative regulation of apoptotic process        1416787_at Acvr1 -0.7071068 -0.7071068  1.4142136
109 negative regulation of apoptotic process         1457580_at Chd8 -0.7071068 -0.7071068  1.4142136
135 positive regulation of apoptotic process          1423240_at Src -0.7071068 -0.7071068  1.4142136
150                      signal transduction      1440803_x_at Tacr3 -0.7071068 -0.7071068  1.4142136
152                      signal transduction        1424896_at Gpr85 -0.7071068 -0.7071068  1.4142136
183                      signal transduction       1440681_at Chrna7 -0.7071068 -0.7071068  1.4142136
190                      signal transduction        1456989_at Oxgr1 -0.7071068 -0.7071068  1.4142136
197                      signal transduction       1460657_at Wnt10a -0.7071068 -0.7071068  1.4142136
191                      signal transduction        1434186_at Lpar4 -0.7071068 -0.7071068  1.4142136
> 

我想要做的是创建一个行侧颜色的热图，表示GO列。最后它看起来像这样（我手动添加蓝色列）：

我坚持使用以下代码：

library(gplots)
dat.tmp <- dat
dat.tmp$GO <- NULL
rownames(dat.tmp) <- dat.tmp$ProbeGene
dat.tmp$ProbeGene <- NULL
heatmap.2(as.matrix(dat.tmp),margin=c(5,15),dendrogram="none",trace="none",scale="row")

Answer 1

这将是一种方法，虽然它与你所拥有的不完全相同：

# Note the Rowv=TRUE argument to prevent reordering of rows
heatmap.2(as.matrix(dat.tmp),margin=c(5,15),dendrogram="none",trace="none",scale="row",
          Rowv=FALSE, RowSideColors=as.character(as.numeric(dat$GO)))

legend("topright",      
    legend = unique(dat$GO),
    col = unique(as.numeric(dat$GO)), 
    lty= 1,             
    lwd = 5,           
    cex=.7
    )

Answer 2

您需要使用RowSideColours参数。但是，这不会自己添加文本。不幸的是，这并不是一件容易的事情。我在这里“eye”“。

library(gplots)
dat.tmp <- dat
dat.tmp$GO <- NULL
rownames(dat.tmp) <- dat.tmp$ProbeGene
dat.tmp$ProbeGene <- NULL

# Create a colour vector
colours <- colorRampPalette(c("steelblue", "lightblue"))(5)[dat$GO]

# Use RowSideColors
heatmap.2(as.matrix(dat.tmp), margin=c(5,15),
          dendrogram="none",trace="none",scale="row",
          RowSideColors = colours, Rowv = FALSE)

# Add text
get.uni <- !duplicated(dat$GO)
text(x = rep(0.1, 5), y = c(0.8,  0.55,  0.3,  0.18, 0), 
     labels = dat$GO[get.uni],
     las = 2, col = "black", cex = 0.5, xpd = TRUE)

这给你一些看起来像这样的东西：

因此，您需要使用@Frank建议的图例，或者您需要根据您拥有/想要的设备尺寸自行调整它。

修改

通过lmat播放布局，你可以得到（我认为）更漂亮的结果。

lmat <- rbind(c(5,3,4), c(1,1,2))
lhei <- c(0.25, 0.75)
lwid <- c(1, 1, 4)

heatmap.2(as.matrix(dat.tmp), margin=c(5,15),
          dendrogram="none",trace="none",scale="row",
          RowSideColors = colours, Rowv = FALSE,
          lmat = lmat, lhei = lhei, lwid = lwid)

get.uni <- !duplicated(dat$GO)
text(x = rep(0.1, 5), y = c(0.8,  0.55,  0.3,  0.2, 0), 
     labels = dat$GO[get.uni],
     las = 2, col = "black", cex = 0.7, xpd = TRUE)

这又需要一些调整 - 特别是颜色键。