Jak zmodyfikować ten wykres macierzy korelacji?

Question

mam następujące kody aby wyświetlić macierz korelacji,

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) 

Chcę zmodyfikować wykres jak:

1. Mają mniejsze niebieskie kropki jako

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

2. Obejmują histogram wpisów na przekątnej (jak widać w enter link description here)

3. Wyświetlanie korelację i p-wartość jako

   r=0.9; 
   p=0.001; 
   

z wartościami nie gwiazdy.

Na wykresie punktowym sparowanych danych wyświetlana jest linia dopasowania. Jaka jest metoda zastosowana do dopasowania? Która linia definiuje dopasowanie jako kody pokazane powyżej? A jak zmienić metodę dopasowania?

Answer 1

Strona pomocy dla funkcji pairs() podaje przykład jak definiować panele do wydruku.

dla konkretnego przypadku:

Zmieniono panel.cor() funkcję pokazać linii tekstu - p-wartości i współczynników korelacji.

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

Dla panel.smooth() funkcji zdefiniowanej przez cex=, col= i pch= argumenty.

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

Aby dodać histogramy, panel.hist() funkcje powinny być zdefiniowane (wzięte z pliku pomocy 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", ...) 
} 

Finał działki:

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

Answer 2

Modified Scatter Plot Matrix

1. %% Zmodyfikowana funkcja histogramu;

   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. %% zmodyfikowanej funkcji regresji o 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. %% zmodyfikowanej funkcji korelacji z 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) 
   } 
   

Aby móc wykreślić matrycę Scatterplot, trzeba także zainstalować "Times New Roman" font. Aby to zrobić, wykonaj poniższe czynności;

4. %% Zainstaluj wszystkie czcionki w RStudio. Jest to ważne, aby poprawić jakość fabuły!

   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. %% Wreszcie wykreślić swoją postać z pairs funkcji;

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

6. %% Sprawdź produkt końcowy; enter image description here