Làm thế nào để sửa đổi cốt truyện Matrix Correlation này?

Question

tôi có các mã sau để hiển thị một ma trận tương quan,

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) 

Tôi muốn thay đổi cốt truyện như:

1. có chấm xanh nhỏ như

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

2. Bao gồm một biểu đồ của các mục trên đường chéo (như được thấy trong enter link description here)

3. Hiển thị mối tương quan và p-giá trị như

   r=0.9; 
   p=0.001; 
   

với các giá trị không sao.

Có một đường phù hợp được hiển thị cho ô phân tán của dữ liệu được ghép nối. Phương pháp được sử dụng cho khớp nối là gì? Dòng nào được xác định phù hợp như các mã được hiển thị ở trên? Và làm thế nào để thay đổi phương pháp lắp ghép?

Answer 1

Trang trợ giúp cho hàm pairs() cung cấp cho bạn ví dụ về cách xác định các bảng theo lô.

Đối với trường hợp cụ thể của bạn:

Changed panel.cor() chức năng hiển thị cho dòng văn bản - p-giá trị và hệ số tương quan.

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

Đối panel.smooth() chức năng được xác định cex=, col= và pch= đối số.

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

Để thêm biểu đồ, panel.hist() chức năng cần được xác định (lấy từ tập tin giúp đỡ của 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", ...) 
} 

cuối cùng cốt truyện:

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

Answer 2

Modified Scatter Lô Matrix

1. %% Đã sửa đổi chức năng cho biểu đồ;

   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. %% Điều chỉnh hồi quy Chức năng với 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. %% Đã sửa đổi chức năng tương quan với 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) 
   } 
   

Để có thể vẽ ma trận phân tán, bạn cũng cần phải cài đặt "Times New Roman" font. Để làm điều đó, hãy làm theo các bước dưới đây;

4. %% Cài đặt tất cả phông chữ vào RStudio. Điều này là quan trọng để cải thiện chất lượng của cốt truyện!

   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. %% Cuối cùng, vẽ hình của bạn bằng chức năng pairs;

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

6. %% Kiểm tra sản phẩm cuối cùng; enter image description here