7

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

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;
    

价值观不是明星。

配对数据的散点图显示了一条拟合线。拟合的方法是什么?哪一行被定义为如上所示的代码?以及如何改变拟合方法?

4

2 回答 2

35

该功能的帮助页面为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)

在此处输入图像描述

于 2013-03-07T12:46:24.783 回答
0

修改的散点图矩阵

  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”字体。为此,请按照以下步骤操作;

  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. %% 检查最终产品; 在此处输入图像描述

于 2018-02-07T11:28:52.723 回答