如何將 3 列數據框中的數據繪制為 R 中的熱圖？

Question

我是 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”。 然后我假設我將能夠使用熱圖函數來創建我的熱圖圖。 任何幫助將非常感激！

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

Answer 2

在基礎 R 中，我們可以將@GregSnow的相關矩陣解決方案調整為頻率熱圖。

首先，我們cut向量切成四分位數（ quantile位數中的默認值）並獲得因子值。

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

其次准備顏色，我們只需復制因子列並使用內置heat.colors和白色為零值heat.colors調整它們。

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

第三，分別將白色應用於NA或零值。

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

Answer 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