如何将 3 列数据框中的数据绘制为 R 中的热图？答案

【问题标题】：How to plot data from a 3 columns dataframe as a heatmap plot in R?如何将 3 列数据框中的数据绘制为 R 中的热图？
【发布时间】：2020-03-22 08:05:18
【问题描述】：

我是 R 新手，非常感谢您的帮助。我有一个 3 列 df，看起来像这样：

> head(data)
          V.hit    J.hit  frequency
1 IGHV1-62-3*00 IGHJ2*00 0.51937442
2   IGHV5-17*00 IGHJ3*00 0.18853542
3    IGHV3-5*00 IGHJ1*00 0.09777304
4    IGHV2-9*00 IGHJ3*00 0.03040866
5   IGHV5-12*00 IGHJ4*00 0.02900040
6   IGHV5-12*00 IGHJ2*00 0.00910554

例如，这只是数据的一部分。我想创建一个热图，以便 X 轴为“V.hit”，Y 轴为“J.hit”，热图的值将是频率（我对频率感兴趣V+j 的每个组合）。我尝试使用此代码进行插值：

library(akima)
newData <- with(data, interp(x = `V hit`, y = `J hit`, z = frequency))

但我收到此错误：

Error in interp.old(x, y, z, xo, yo, ncp = 0, extrap = FALSE, duplicate = duplicate,  : 
  missing values and Infs not allowed

所以我不知道如何处理它。我想实现这个最终输出：

> head(fld)
# A tibble: 6 x 5
  ...1        `IGHJ1*00` `IGHJ2*00` `IGHJ3*00` `IGHJ4*00`
  <chr>            <dbl>      <dbl>      <dbl>      <dbl>
1 IGHV10-1*00  0.00233     0.00192   NA          0.000512
2 IGHV1-14*00 NA          NA          0.00104   NA       
3 IGHV1-18*00 NA           0.000914  NA         NA       
4 IGHV1-18*00 NA          NA          0.000131  NA       
5 IGHV1-19*00  0.0000131  NA         NA         NA       
6 IGHV1-26*00 NA           0.000214  NA         NA

而“NA”的单元格将被分配为“0”。然后我假设我将能够使用热图函数来创建我的热图。任何帮助将不胜感激！

【问题讨论】：

可能xtabs 是您所需要的：它可以让您创建列联表。将NAs 替换为0s。看看这里：rdocumentation.org/packages/stats/versions/3.6.2/topics/xtabs

标签： r heatmap

【解决方案1】：

这是一个使用geom_tile() 的想法。您的数据称为foo。我使用complete() 创建了所有可能的 V.hit 和 J.hit 组合。对于缺失值，我要求complete() 使用0 来填充。然后，我使用 geom_tile() 生成以下图形。如有必要，您可能需要考虑级别的顺序。

library(tidyverse)

complete(foo, V.hit, nesting(J.hit), fill = list(frequency = 0)) %>% 
ggplot(aes(x = J.hit, y = V.hit, fill = frequency)) +
geom_tile()

【讨论】：

哇，非常感谢您的快速帮助！！！此代码中的哪个函数负责插值？我只是要求我的基本理解:)
@LigalMaimon 你的意思是颜色插值？

【解决方案2】：

在基础 R 中，我们可以将 @GregSnow 的 solution 用于频率热图的相关矩阵。

首先，我们将cut 向量分成四分位数（quantile 中的默认值）并获取因子值。

dat$freq.fac <- cut(dat$frequency, quantile(dat$frequency, na.rm=TRUE), include.lowest=T)

第二次准备颜色，我们只需复制因子列并使用内置heat.colors 重新调整它们的水平，并将零值设为白色。

dat <- within(dat, {
  freq.col <- freq.fac
  levels(freq.col) <- c(heat.colors(length(levels(dat$freq.fac)), rev=T), "#FFFFFF")
          })

第三，分别对NAs 或零值应用白色。

dat$freq.col[is.na(dat$freq.col)] <- "#FFFFFF"
dat$frequency[is.na(dat$frequency)] <- 0

第四，申请xtabs并创建一个颜色矩阵，然后匹配颜色和级别。

dat.x <- xtabs(frequency ~ v.hit + j.hit, dat)
col.m <- matrix(dat$freq.col[match(dat$frequency, as.vector(dat.x))], nrow=nrow(dat.x))

最后使用rasterImage 函数进行绘图。

op <- par(mar=c(.5, 4, 4, 3)+.1)  ## adapt outer margins
plot.new()
plot.window(xlim=c(0, 5), ylim=c(0, 5))
rasterImage(col.m, 0, 1, 5, 5, interpolate=FALSE)
rect(0, 1, 5, 5)  ## frame it with a box
## numbers in the cells
text(col(round(dat.x, 3)) - .5, 5.45 - row(round(dat.x, 3))*.8, round(dat.x, 3))
mtext("Frequency heatmap", 3, 2, font=2, cex=1.2)  ## title
mtext(rownames(dat.x), 2, at=5.45 -(1:5)*.8, las=2)  ## y-axis
mtext(colnames(dat.x), 3, at=(1:5)-.5)  ## y-axis (upper)
## a legend
legend(-.15, .75, legend=c("Frequency:\t", 0, paste("<", seq(.25, 1, .25))), horiz=TRUE, 
      pch=c(NA, rep(22, 5)), col=1, pt.bg=c(NA, levels(dat$freq.col)[c(5, 1:4)]), 
      bty="n", xpd=TRUE, cex=.75, text.font=2)
par(op)  ## reset margins

产量

玩具数据：

dat <- structure(list(v.hit = structure(c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 
        3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
        4L, 5L), .Label = c("A", "B", "C", "D", "E"), class = "factor"), 
            j.hit = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
            3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L
            ), .Label = c("F", "G", "H", "I", "J"), class = "factor"), 
            frequency = c(NA, NA, 0.717618508264422, NA, NA, 0.777445221319795, 
            NA, 0.212142521282658, 0.651673766085878, 0.125555095961317, 
            NA, 0.386114092543721, 0.0133903331588954, NA, 0.86969084572047, 
            0.34034899668768, 0.482080115471035, NA, 0.493541307048872, 
            0.186217601411045, 0.827373318606988, NA, 0.79423986072652, 
            0.107943625887856, NA)), row.names = c(NA, -25L), class = "data.frame")

【讨论】：

【解决方案3】：

如果变量相关，您可以使用线性模型进行插值。


mdl <- lm(z ~ ., df)

out <- NULL
for(x in seq(min(df$x), max(df$x), (max(df$x) - min(df$x)/100) )){
    tmp <- c()
    for(y in seq(min(df$y), max(df$y), (max(df$y) - min(df$y)/100) )){
        h <- predict(
            mdl,
            data.frame(x = x, y = y)
        )
        tmp = c(tmp, h)
    }
    if(is.null(out)){
        out = as.matrix(tmp)
    }else{
        out = cbind(out, tmp)
    }
}

fig <- plot_ly(z = out, colorscale = "Hot", type = "heatmap")
fig <- fig %>% layout(
    title = "Interpolated Heatmap of Z Given x, y",
    xaxis = list(
        title = "x"
    ),
    yaxis = list(
        title = "y"
    )
)
fig

【讨论】：