Jak zmodyfikować Wykres macierzy korelacji?

Mam następujące Kody do wyświetlania macierzy 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ć fabułę tak:

  1. Mają mniejsze niebieskie kropki jako 

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

  2. Dołącz histogram wpisów na przekątnej (jak widać w Wpisz tutaj Opis linku)

  3. Wyświetl korelację i wartość p jako 

    r=0.9;
p=0.001;

Z wartościami, a nie gwiazdami.

Wyświetlana jest linia dopasowania dla wykresu punktowego pary data. Jaka jest metoda montażu? Która linia jest zdefiniowana jako kod pokazany powyżej? Jak zmienić sposób montażu?

Author: Léo Léopold Hertz 준영, 2013-03-07
Source

2 answers

Strona pomocy dla funkcji pairs() daje przykład jak zdefiniować panele do wykresu.

Dla Twojego konkretnego przypadku:

Zmieniono funkcję panel.cor(), aby pokazywać wiersze wartości tekstu - P i współczynniki 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 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, należy zdefiniować funkcje panel.hist() (pobrane 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", ...)
}

Końcowa fabuła: 

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

Tutaj wpisz opis obrazka

 34
Author: Didzis Elferts,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2013-03-07 12:46:24

Zmodyfikowana Macierz Wykresu Punktowego

  1. % % zmodyfikowana funkcja dla 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. % % zmodyfikowana funkcja regresji z 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. % % zmodyfikowana funkcja 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, musisz również zainstalować czcionkę "Times New Roman". Aby to zrobić, wykonaj poniższe kroki;

  1. %% zainstaluj wszystkie czcionki w RStudio. Jest to ważne, aby poprawić jakość działki!

    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. %% na koniec wykreśl swoją figurę za pomocą funkcji pairs; 

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

  3. %% Sprawdź produkt końcowy; Tutaj wpisz opis obrazka

 0
Author: cgtydmrc,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-02-07 14:47:46