如何修改此相关矩阵图？

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. 包括一个对角线条目的直方图（如enter link description here所示）

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=参数。

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

Answer 2

修改散点图矩阵：

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()功能应该被定义

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()帮助文件中取出）

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

为了能够绘制散点图矩阵，你还需要安装“宋体”字体。要做到这一点，请按照以下步骤操作;

1. %%将所有字体安装到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 
   

2. %%最后，绘制与pairs功能你的身影;

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

3. %%检查最终产品; enter image description here