Question

我使用read.csv函数导入了9列数据，调用对象myData并使用pair函数绘制它，如下所示。

  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替代方案更好，我不确定但是......它严重依赖于其他一些帖子，例如this question on adding colour to panel plot background和the answer to this question on obtaining a colour gradient.

# 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()函数。然后根据pearson系数创建热图颜色代码，最后更改背景。

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

使用'corrgram'包很容易，它包含'panel.pts'和'panel.shade'功能。我将这两个函数合并为一个名为“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)

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

3 个答案: