R中带有原始值的热图

Question

我有这个数据框：

df <- data.frame(PatientID = c("3454","345","5","348","567","79"),
                 clas1 = c(1, 0, 5, NA, NA, 4),
                 clas2 = c(4, 1, 0, 3, 1, 0),
                 clas3 = c(1, NA, 0, 5, 5, 5), stringsAsFactors = F)

我想创建一个热图，x 轴为患者 ID，y 轴为 clas1、clas2 和 clas3。热图中表示的值将是每个“类”的原始值。在这里我贴一张我想要的图

我很抱歉，因为我没有更多可用的颜色来表示这一点，但这只是一个示例，可以使用任何色标。 重要的是我想区分零和 NA，因此理想情况下 NA 有自己的颜色或显示为白色（空）。

我希望这是可以理解的。

不过有什么问题可以问

非常感谢！

Answer 1

df <- data.frame(PatientID = c("3454","345","5","348","567","79"),
                 clas1 = c(1, 0, 5, NA, NA, 4),
                 clas2 = c(4, 1, 0, 3, 1, 0),
                 clas3 = c(1, NA, 0, 5, 5, 5), stringsAsFactors = F)
library(tidyverse)
df %>% pivot_longer(!PatientID) %>%
  ggplot(aes(x= PatientID, y = name, fill = value)) +
  geom_tile()

^{由reprex package (v2.0.0) 于 2021-05-25 创建}

Answer 2

这是一个带有 ``heatmap` 的基本 R 选项

heatmap(t(`row.names<-`(as.matrix(df[-1]), df$PatientID)))

# Which is like
# x <- as.matrix(df[-1]
# row.names(x) <- df$PatientID
# heatmap(t(x))

Answer 3

准备数据

我将提供 4 个选项，在所有四个选项中，您需要分配行名并删除 id 列。即：

df <- data.frame(PatientID = c("3454","345","5","348","567","79"),
                 clas1 = c(1, 0, 5, NA, NA, 4),
                 clas2 = c(4, 1, 0, 3, 1, 0),
                 clas3 = c(1, NA, 0, 5, 5, 5), stringsAsFactors = F)
rownames(df) <- df$PatientID
df$PatientID <- NULL
df

输出是：

> df
     clas1 clas2 clas3
3454     1     4     1
345      0     1    NA
5        5     0     0
348     NA     3     5
567     NA     1     5
79       4     0     5

基础 R

使用基础 R（体面的输出）：

heatmap(as.matrix(df))

gplots

使用 gplots（有点难看，但要控制的参数更多）：

library(gplots)
heatmap.2(as.matrix(df))

热图

使用 heatmaply，您可以为树状图使用更好的默认值（它还以更“最佳”的方式组织它们）。

您可以了解更多关于包here的信息。

静态

带有热图的静态热图（更好的默认值，恕我直言）

library(heatmaply)
ggheatmap(df)

现在有彩色树状图

library(heatmaply)
ggheatmap(df, k_row = 3, k_col = 2)

没有树状图：

library(heatmaply)
ggheatmap(df, dendrogram = F)

互动

带有 heatmaply 的交互式热图（悬停工具提示和缩放功能 - 它是交互式的！）：

library(heatmaply)
heatmaply(df)

您可以使用静态 ggheatmap 执行任何操作，也可以使用交互式 heatmaply 版本执行任何操作。

Answer 4

这是另一种选择：

df <- data.frame(PatientID = c("3454","345","5","348","567","79"),
                 clas1 = c(1, 0, 5, NA, NA, 4),
                 clas2 = c(4, 1, 0, 3, 1, 0),
                 clas3 = c(1, NA, 0, 5, 5, 5), stringsAsFactors = F)


# named vector for heatmap
cols <-  c("0" = "white",
           "1" = "green", 
           "2" = "orange", 
           "3" = "yellow", 
           "4" = "pink",
           "5" = "black",
           "99" = "grey")
labels_legend <- c("0" = "0",
                   "1" = "1", 
                   "2" = "2", 
                   "3" = "3", 
                   "4" = "4", 
                   "5" = "5",
                   "99" = "NA")

df1 <- df %>% 
  pivot_longer(
    cols = starts_with("clas"),
    names_to = "names",
    values_to = "values"
  ) %>% 
  mutate(PatientID = factor(PatientID, levels = c("3454", "345", "5", "348", "567", "79")))

ggplot(
  df1, 
  aes(factor(PatientID),  factor(names))) +
  geom_tile(aes(fill= factor(values))) +
  # geom_text(aes(label = values), size = 5, color = "black") + # text in tiles
  scale_fill_manual(
    values = cols, 
    breaks = c("0", "1", "2", "3", "4", "5", "99"),
    labels = labels_legend,
    aesthetics = c("colour", "fill"),
    drop = FALSE
  ) +
  scale_y_discrete(limits=rev) +
  coord_equal() +
  theme(line = element_blank(),
        title = element_blank()) +
  theme(legend.direction = "horizontal", legend.position = "bottom")