具有不同调色板的 R 热图

Question

我正在尝试使用不同的调色板在 R 中创建一个简单的热图。我想使用渐变，以便将低于阈值 N 的所有数字指定为一种颜色（例如紫色），并将所有高于阈值的数字指定为另一种颜色（例如橙色）。数字离阈值越远，颜色应该越深。

这是一个示例数据集：

Division,COL1,COL2,COL3,COL4,COL5,COL6,COL7
Division 1,31.9221884012222,75.8181694429368,97.0480443444103,96.295954938978,70.5677134916186,63.0451830103993,93.0396212730557
Division 2,85.7012346852571,29.0621076244861,16.9130333233625,94.6443660184741,19.9103083927184,61.9562198873609,72.3791105207056
Division 3,47.1665125340223,99.4153356179595,8.51091076619923,79.1276383213699,41.915355855599,7.45079894550145,24.6946100145578
Division 4,66.0743870772421,24.6163331903517,78.694460215047,42.04714265652,50.2694897353649,73.0409651994705,87.3745442833751
Division 5,29.6664374880493,35.4036891367286,19.2967326845974,5.48460693098605,32.4517334811389,15.5926876701415,76.0523204226047
Division 6,95.4969164915383,8.63230894319713,61.7535551078618,24.5590241160244,25.5453423131257,56.397921172902,44.4693325087428
Division 7,87.5015622004867,28.7770316936076,56.5095080062747,34.6680747810751,28.1923673115671,65.0204187724739,13.795713102445
Division 8,70.1077231671661,72.4712177179754,38.4903231170028,36.1821102909744,97.0875509083271,17.184783378616,78.2292529474944
Division 9,47.3570406902581,90.2257485780865,65.6037972308695,77.0234781783074,25.6294377148151,84.900529962033,82.5080851092935
Division 10,58.0811711959541,0.493217632174492,58.5604055318981,53.5780876874924,9.12552657537162,20.313960686326,78.1371118500829
Division 11,34.6708688884974,76.711881859228,22.6064443588257,22.1724311355501,5.48891355283558,79.1159523651004,56.8405059166253
Division 12,33.6812808644027,44.1363711375743,70.6362190190703,3.78900407813489,16.6075889021158,9.12654218263924,39.9711143691093

这里是一个简单的 sn-p 从上述数据生成热图

data <- read.csv("dataset.csv", sep=",")
row.names(data) <- data$Division
data <- data[,2:7]
data_matrix <- data.matrix(data) 
heatmap(data_matrix, Rowv=NA, Colv=NA, col = heat.colors(256), scale="column", margins=c(5,10))

如何修改以上代码产生：

• 50 以上的所有数字的颜色渐变（橙色）（数字离 50 越远，颜色越深）
• 颜色渐变（紫色）适用于 50 以下的所有数字（数字距离 50 越远，颜色越深）
• 很高兴（但可选）在网格单元格中写入数值
• 很高兴拥有（但可选），为网格单元使用不同的颜色，该颜色正好是阈值数（在本例中为 50）

[[编辑]]

刚刚看到这个question on SO，好像很像。答案使用 ggplot（我没有经验），到目前为止，我无法使 ggplot 解决方案适应我稍微复杂的数据。

Answer 1

我发现这个线程非常有用，也从here 中汲取了一些想法，但出于我的目的，我需要概括一些东西并想使用 RColorBrewer 包。当我正在研究它时，Brewer 博士（以 Color Brewer 闻名）在我的办公室停下来告诉我，我需要在较小的颜色中断中进行插值，而不仅仅是选择端点。我认为其他人可能会觉得这很有用，所以我在这里发布我的功能以供后代使用。

该函数接受您的数据向量、发散的 colorBrewer 调色板的名称以及您的配色方案的中心点（默认为 0）。它输出一个包含 2 个对象的列表：一个 classIntervals 对象和一个颜色向量：该函数设置为插入总共 100 种颜色，但可以小心修改。

diverge.color <- function(data,pal_choice="RdGy",centeredOn=0){
  nHalf=50
  Min <- min(data,na.rm=TRUE)
  Max <- max(data,na.rm=TRUE)
  Thresh <- centeredOn
  pal<-brewer.pal(n=11,pal_choice)
  rc1<-colorRampPalette(colors=c(pal[1],pal[2]),space="Lab")(10)
  for(i in 2:10){
    tmp<-colorRampPalette(colors=c(pal[i],pal[i+1]),space="Lab")(10)
    rc1<-c(rc1,tmp)
  }
  rb1 <- seq(Min, Thresh, length.out=nHalf+1)
  rb2 <- seq(Thresh, Max, length.out=nHalf+1)[-1]
  rampbreaks <- c(rb1, rb2)
  cuts <- classIntervals(data, style="fixed",fixedBreaks=rampbreaks)
  return(list(cuts,rc1))
}

在我的工作中，我使用这个方案来使用 spplot 绘制一个栅格层 (rs)，如下所示：

brks<-diverge.color(values(rs))
spplot(rs,col.regions=brks[[2]],at=brks[[1]]$brks,colorkey=TRUE))

Answer 2

这应该可以帮助您完成大部分工作。 （请注意，如果您希望绘制的颜色与单元格的实际（而不是重新调整的）值相对应，则需要设置 scale="none"）。

ncol <- 100

## Make a vector with n colors
cols <- RColorBrewer:::brewer.pal(11,"PuOr")  # OR c("purple","white","orange")  
rampcols <- colorRampPalette(colors = cols, space="Lab")(ncol)
rampcols[(n/2) + 1] <- rgb(t(col2rgb("green")), maxColorValue=256) 

## Make a vector with n+1 breaks
rampbreaks <- seq(0, 100, length.out = ncol+1)

## Try it out
heatmap(data_matrix, Rowv = NA, Colv = NA, scale="none",
        col = rampcols, breaks = rampbreaks)

编辑

为了更好地控制阈值的位置，我建议创建两个单独的调色板——一个用于小于阈值的值，一个用于高于阈值的值——然后将它们“缝合”在一起。尝试这样的事情，为Min、Max、Thresh 等设置不同的值：

nHalf <- 50

Min <- 0
Max <- 100
Thresh <- 50

## Make vector of colors for values below threshold
rc1 <- colorRampPalette(colors = c("purple", "white"), space="Lab")(nHalf)    
## Make vector of colors for values above threshold
rc2 <- colorRampPalette(colors = c("white", "orange"), space="Lab")(nHalf)
rampcols <- c(rc1, rc2)
## In your example, this line sets the color for values between 49 and 51. 
rampcols[c(nHalf, nHalf+1)] <- rgb(t(col2rgb("green")), maxColorValue=256) 

rb1 <- seq(Min, Thresh, length.out=nHalf+1)
rb2 <- seq(Thresh, Max, length.out=nHalf+1)[-1]
rampbreaks <- c(rb1, rb2)

heatmap(data_matrix, Rowv = NA, Colv = NA, scale="none",
        col = rampcols, breaks = rampbreaks)