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=20) breaks <- h$breaks; nB <- length(breaks) y <- h$counts; y <- y/max(y) rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...) } 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, use="complete.obs")) rsigned=cor(x, y, use="complete.obs") p = cor.test(x, y, use="complate.obs")$p.value txt <- format(c(rsigned, 0.123456789), digits = digits)[1] txt <- paste0(prefix, txt) if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt) col="grey" if(p<.1){col="black"} if(p<.05){col="blue"} text(0.5, 0.5, txt, cex = cex.cor *(r+.2)/(r+1), col=col) } panel.cortest = function(x,y, digits=2, prefix="", cex.cor, ...){ usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) p <- signif(cor.test(x, y, use="complete.obs")$p.value,2) if(missing(cex.cor)) cex.cor <- 2 col="grey" if(p<.1){col="black"} if(p<.05){col="blue"} text(.5, .5, p, cex=cex.cor, col=col) } pairs(dat, lower.panel=panel.cor, diag.panel=panel.hist) pairs(dat, lower.panel=panel.cor, upper.panel = panel.cortest)