在R中的矩阵散点图上将值叠加为热图

Question

我已经使用调用对象myData的read.csv函数导入了9列数据，并使用pairs函数将其绘制如下。

  pairs(myData[,c(1:9)], 
  lower.panel = panel.smooth,
  diag.panel = NULL,
  pch=1, cex= 1,  
  cex.labels = 1,
  cex.axis = 1,
  gap = 0.35, 
  font.labels = NULL,
  col="Black")

我希望将不同散点图的人的相关性作为热图放在矩阵散点图上，作为单独的散点图背景色。 计算皮尔逊相关性所需的函数如下

cor(myData, method = "pearson")

该函数给出了我需要的数字（用于构建热图），但是我不知道如何根据生成的人员值在lower.panel参数中为各个图着色。

Answer 1

我认为我有一个使用基本图形应该可以很好地解决的问题。 它是否比我不确定的评论中提到的Corrgram替代方案更好，但是...它在很大程度上依赖于其他几篇文章，例如此问题，有关在面板图背景上添加颜色，以及此问题的答案，关于获取颜色梯度。

# Sample data to work with
data(iris)

# create a custom panel function that colours panels based on bg (taken from the first 
# linked question. I've just added a line to add a loess smoother, as per your code

mypanel <- function(x, y, ...){
  count <<- count+1
  bg <- color[count]
  ll <- par("usr")
  rect(ll[1], ll[3], ll[2], ll[4], col=bg)
  lines(lowess(x, y), col = "red")
  points(x, y, cex=0.5)
}

# get the values for the pearson correlations
corres <- cor(iris[1:4], method = "pearson")[lower.tri(cor(iris[1:4])) == T]

# create a colour ramp between two colours, for as many values as you have panels.
colfunc <- colorRampPalette(c("gray90", "gray20"))
color <- colfunc(length(corres))

# reorder that colour vector based on the rank of the correlation values
# (so the "highest" colour matches the highest value etc.)
color <- color[order(corres)]

# counter used in panel function
count <- 0

# plot the pairs plot using "mypanel" on lower.panel rather than panel.smooth
pairs(iris[,c(1:4)], 
      lower.panel = mypanel,
      diag.panel = NULL,
      pch=1, cex= 1,  
      cex.labels = 1,
      cex.axis = 1,
      gap = 0.35, 
      font.labels = NULL,
      col="Black")

结果就是这个情节。 希望在colourRampPalette中摆弄颜色应该足以满足您的需求。

希望这是有用的。

Answer 2

您可以尝试ggpairs。 在那里更改背景色比较容易。 想法是像pairs()函数那样绘制数据。 然后根据皮尔逊系数创建一个热图颜色代码，最后更改背景。

library(ggplot2)
library(GGally)
# iris as testdata

# The plot with smooth lines and points in the upper panel. 
p <- ggpairs(iris[-5], upper=list(continuous="points"), lower=list(continuous="smooth_loess"), diag=list(continuous="barDiag"))

# Create a heatmap color map
# correlations
pr <- cor(iris[-5])
# set breaks
breaks <-  seq(-1,1.0,0.01)
# binning
pr_b <- .bincode(pr, breaks, include.lowest = T)
# transform the pearsons in colors using redblue() palette
pr_b <- matrix(factor(pr_b, levels = 1:length(breaks), labels = rev(redblue(length(breaks)))), p$nrow)
pr
             Sepal.Length Sepal.Width Petal.Length Petal.Width
Sepal.Length    1.0000000  -0.1175698    0.8717538   0.8179411
Sepal.Width    -0.1175698   1.0000000   -0.4284401  -0.3661259
Petal.Length    0.8717538  -0.4284401    1.0000000   0.9628654
Petal.Width     0.8179411  -0.3661259    0.9628654   1.0000000
pr_b
     [,1]      [,2]      [,3]      [,4]     
[1,] "#FF0303" "#E0E0FF" "#FF2121" "#FF3030"
[2,] "#E0E0FF" "#FF0303" "#9191FF" "#A1A1FF"
[3,] "#FF2121" "#9191FF" "#FF0303" "#FF0A0A"
[4,] "#FF3030" "#A1A1FF" "#FF0A0A" "#FF0303"

# Update the background color using a for loop. The diagonal slots are overwritten by an empty plot
for(i in 1:p$nrow) {
  for(j in 1:p$ncol){
    p[i,j] <- p[i,j] + 
      theme(panel.background= element_rect(fill=pr_b[i,j]))
    if(i == j){
      p[i,j] <-ggplot()+ annotate("text",5,5,label=colnames(iris)[i]) + theme_void()
  }
}}

# The plot
p 

Answer 3

使用带有“ panel.pts”和“ panel.shade”功能的“ corrgram”包可以轻松完成此操作。 我将这两个函数合并为一个名为“ panel.shadepoints”的函数，并定义了具有较浅颜色的色带，以便仍可以看到这些点。

panel.shadepoints <- function(x, y, corr=NULL, col.regions, cor.method, ...){

  # If corr not given, try to calculate it
  if(is.null(corr)) {
    if(sum(complete.cases(x,y)) < 2) {
      warning("Need at least 2 complete cases for cor()")
      return()
    } else {
      corr <- cor(x, y, use='pair', method=cor.method)
    }
  }

  ncol <- 14
  pal <- col.regions(ncol)
  col.ind <- as.numeric(cut(corr, breaks=seq(from=-1, to=1, length=ncol+1),
                            include.lowest=TRUE))
  usr <- par("usr")
  # Solid fill
  rect(usr[1], usr[3], usr[2], usr[4], col=pal[col.ind], border=NA)

  # Overlay points
  plot.xy(xy.coords(x, y), type="p", ...)

  # Boounding box needs to plot on top of the shading, so do it last.
  box(col='lightgray')
}

data(iris)
redblue<-colorRampPalette(c("pink","gray90","skyblue"))
corrgram(iris, panel=panel.shadepoints, col=redblue)