分类变量计数的热图

时间:2018-06-25 17:03:29

标签: r ggplot2 heatmap categorical-data pheatmap

我有一个项目数据框架,每个项目都有多个分类器列,它们是分类变量。

ID    test1    test2     test3
1     A        B         A
2     B        A         C
3     C        C         C
4     A        A         B
5     B        B         B
6     B        A         C

我想使用ggplot2为测试列的每种组合(test1 v test2,test1 v test3等)生成一个热图。 热图将在x侧的该测试的列中包含所有因子(在本例中为A,B,C),而在y侧具有其他测试的所有因子,并且该热图中的框应基于具有分类符组合的ID数量。

例如在上面的输入中,如果我们在test1和test2之间有热图,则位于test1的B和test2的A交点处的框将是最亮的,因为该组合有2个id。 我希望使用这些热图来分析哪些测试最适合该数据集,但是由于它们是分类变量,因此不能使用Pearson的R相关性。

我对ggplot很熟悉,这就是为什么我偏爱ggplot的原因,但是如果在pheatplot中更简单,那么我可以学习它。

2 个答案:

答案 0 :(得分:1)

您的问题尚不清楚,但是我认为您正在寻找类似的东西。我不是ggplot2人,所以我让别人提供该代码。

x <- read.table(text="ID    test1    test2     test3
                1     A        B         A
                2     B        A         C
                3     C        C         C
                4     A        A         B
                5     B        B         B
                6     B        A         C", stringsAsFactors=FALSE, header=T)

xl <- reshape2::melt(data = x, id.vars="ID", variable.name = "Test", value.name="Grade")
xl$Test_Gr <- apply(xl[,2:3], 1, paste0, collapse="_")

xw <- reshape2::dcast(xl, ID ~ Test_Gr, fun.aggregate = length)
xwm <- as.matrix(xw[,-1])
xc <- t(xwm) %*% xwm
colnames(xc) <- colnames(xw)[-1]
rownames(wc) <- colnames(xw)[-1]
gplots::heatmap.2(xc, trace="none", col = rev(heat.colors(15)))

enter image description here

答案 1 :(得分:1)

花一些时间来了解如何做到这一点,但我仍然不确定这是最好的方法。

数据:
dat = structure(list(ID = 1:6, 
                     test1 = c("A", "B", "C", "A", "B", "B"), 
                     test2 = c("B", "A", "C", "A", "B", "A"), 
                     test3 = c("A", "C", "C", "B", "B", "C")
                     ), 
                .Names = c("ID", "test1", "test2", "test3"), 
                 class = "data.frame", row.names = c(NA, -6L)
                )
图书馆
library(tidyverse)
library(ggthemes)
library(gridExtra)
一次创建2个因子的所有组合(也进行测试)
fcombs <- expand.grid(LETTERS[1:3], LETTERS[1:3], stringsAsFactors = F)
tcombs <- as.data.frame(combn(colnames(dat[,-1]), 2), stringsAsFactors = F)
lapply通过测试组合full_join,计算除NA s之外的每个组的长度
dtl <- lapply(tcombs, function(i){
        select(dat, ID, i) %>%
        full_join(x = fcombs, by = c("Var1" = i[1], Var2 = i[2])) %>%
        group_by(Var1, Var2) %>%
        mutate(N = sum(!is.na(ID)), ID = NULL) %>%
        ungroup()
  }
)
创建地块清单
pl <- lapply(seq_along(tcombs), function(i){
        gtitle = paste(tcombs[[i]], collapse = " ~ ")
        dtl[[i]] %>%
        ggplot(aes(x = Var1, y = Var2, fill = N)) +
        geom_tile() +
        theme_tufte() +
        theme(axis.title = element_blank()) +
        ggtitle(gtitle)
        }
      )
创建表列表({tableGrob个对象)
tbl <- lapply(tcombs, function(i) tableGrob(select(dat, ID, i),  
                                            theme = ttheme_minimal()))
将所有内容放入结果列表并进行绘图
resl <- c(pl, tbl)[c(1, 4, 2, 5, 3, 6)]

grid.arrange(grobs = resl, ncol = 2, nrow = 3)

heatmaps