如何修改此相关矩阵图？

Question

我有以下代码来显示相关矩阵，

panel.cor <- function(x, y, digits=2, prefix="", cex.cor)
{
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- abs(cor(x, y))
    txt <- format(c(r, 0.123456789), digits=digits)[1]
    txt <- paste(prefix, txt, sep="")
    if(missing(cex.cor)) cex <- 0.8/strwidth(txt)

    test <- cor.test(x,y)
    # borrowed from printCoefmat
    Signif <- symnum(test$p.value, corr = FALSE, na = FALSE,
                  cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
                  symbols = c("***", "**", "*", ".", " "))

    text(0.5, 0.5, txt, cex = cex * r)
    text(.8, .8, Signif, cex=cex, col=2)
}
pairs(USJudgeRatings[,c(2:3,6,1,7)],
  lower.panel=panel.smooth, upper.panel=panel.cor)

我想像这样修改剧情：

1. 具有较小的蓝点

    pairs(USJudgeRatings[,c(2:3,6,1,7)], main="xxx", pch=18, col="blue", cex=0.8) 

2. 包括对角线上条目的直方图（如此处的输入链接说明所示 ）

3. 将相关性和p值显示为

    r=0.9; p=0.001; 

价值观不是明星。

显示一条拟合线，用于配对数据的散点图。 拟合的方法是什么？ 上面显示的代码将配件定义在哪一行？ 以及如何更改拟合方法？

Answer 1

pairs()函数的帮助页面为您提供了如何定义要绘制的面板的示例。

对于您的特定情况：

更改了panel.cor()函数以显示为文本行-p值和相关系数。

panel.cor <- function(x, y, digits=2, cex.cor)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- abs(cor(x, y))
  txt <- format(c(r, 0.123456789), digits=digits)[1]
  test <- cor.test(x,y)
  Signif <- ifelse(round(test$p.value,3)<0.001,"p<0.001",paste("p=",round(test$p.value,3)))  
  text(0.5, 0.25, paste("r=",txt))
  text(.5, .75, Signif)
}

对于panel.smooth()函数，定义了cex= ， col=和pch=参数。

panel.smooth<-function (x, y, col = "blue", bg = NA, pch = 18, 
                        cex = 0.8, col.smooth = "red", span = 2/3, iter = 3, ...) 
{
  points(x, y, pch = pch, col = col, bg = bg, cex = cex)
  ok <- is.finite(x) & is.finite(y)
  if (any(ok)) 
    lines(stats::lowess(x[ok], y[ok], f = span, iter = iter), 
          col = col.smooth, ...)
}

要添加直方图，应定义panel.hist()函数（取自pairs()帮助文件）

panel.hist <- function(x, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...)
}

最终情节：

pairs(USJudgeRatings[,c(2:3,6,1,7)],
          lower.panel=panel.smooth, upper.panel=panel.cor,diag.panel=panel.hist)

Answer 2

修改后的散点图矩阵

1. %%修改直方图的功能；

    panel.hist <- function(x, ...) { usr <- par("usr"); on.exit(par(usr)) par(usr = c(usr[1:2], 0, 1.5) ) par(cex.axis=2, family="Times New Roman", face="bold", size=12, cex.lab=1, cex.main=1, cex.sub=1) h <- hist(x, plot = FALSE) breaks <- h$breaks; nB <- length(breaks) y <- h$counts; y <- y/max(y) rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...) } 

2. %%使用panel.smooth修改了回归函数；

    panel.smooth<-function (x, y, col = "black", bg = NA, pch = 16, cex = 2, col.smooth = "red", span = 2/3, iter = 3, ...) { points(x, y, pch = pch, col = col, bg = bg, cex = cex) ok <- is.finite(x) & is.finite(y) if (any(ok)) lines(stats::lowess(x[ok], y[ok], f = span, iter = iter), col = col.smooth, ...) } 

3. %%使用panel.cor修改的相关函数；

    panel.cor <- function(x, y, digits=2, cex.cor) { usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) r <- abs(cor(x, y)) txt <- format(c(r, 0.123456789), digits=digits)[1] test <- cor.test(x,y) Signif <- ifelse(round(test$p.value,3)<0.001,"p < 0.001",paste("p = ",round(test$p.value,3))) text(0.5, 0.25, paste("r = ",txt), cex = 2.5, family="Times New Roman", face="bold", size=12) text(.5, .75, Signif, cex = 2.5, family="Times New Roman", face="bold", size=12) } 

为了能够绘制散点图矩阵，还需要安装“ Times New Roman”字体。 为此，请按照以下步骤操作；

4. %%将所有字体安装到RStudio中。 这对于提高地块的质量很重要！

    install.packages("extrafont") # Install fonts library(extrafont) # Install library font_import() # Import all fonts loadfonts(device="win") # Register fonts for Windows bitmap output fonts() # Finish the process 

5. %%最后，用pairs函数绘制图形。

     pairs(qq1, lower.panel=panel.smooth, upper.panel=panel.cor ,diag.panel=panel.hist, cex = 2, cex.labels = 2, cex.main = 2) 

6. %%检查最终产品； 在此处输入图片说明