pairs_plot.R

nrm <- function(x, min = 0, max = 1, range_x = range(x)) {
  a <- (max - min)/(max(range_x) - min(range_x))
  b <- max - a * max(range_x)
  a * x + b
}
panel <- function(x, y, ...) {
  ok <- is.finite(x) & is.finite(y)
  if (any(ok)) {
    xx <- x[ok]; yy <- y[ok]
    if (par("xlog")) xx <- log10(xx)
    if (par("ylog")) yy <- log10(yy)
    fit <- lm(yy ~ xx)
    abline(fit, col = "Navy")
  }
  panel.smooth(x, y, ...)
}
upper.panel <- function(x, y, ...) {
  u <- par("usr")
  xl <- par("xlog")
  yl <- par("ylog")
  points(x, y, ...)
  panel.smooth(x, y, ...)
  panel(x, y, ...)
  xx <- if (xl) log10(x) else x
  yy <- if (yl) log10(y) else y
  r <- cor(xx, yy, use = "p")
  xx <- nrm(0, u[1], u[2], c(0, 1))
  yy <- nrm(0.9, u[3], u[4], c(0, 1))
  if (par("xlog")) xx <- 10^xx
  if (par("ylog")) yy <- 10^yy
  text(xx, yy, sprintf("r = %.2f", r), cex = 2, adj = -0.1, col = "blue")
}
diag.panel <- function(x, ...) {
  ylog <- par("ylog"); on.exit(par(ylog))
  xlog <- par("xlog"); u <- par("usr")
  par(ylog = FALSE)
  tryd <- try(d <- density(if (xlog) log10(x) else x, na.rm = TRUE), silent = TRUE)
  if (class(tryd) != "try-error") {
    if (xlog) d$x <- 10^d$x
    d$y <- nrm(d$y, u[3], u[4] * 0.8)
    lines(d$x, d$y, col = "dodgerblue4", xlog = xlog)
  }
  rug(x)
  axis(1, pretty(x), tcl = 0.5, tck = 0.04, lwd = 0.5, labels = FALSE, xlog = xlog)
}
pairs(airquality[1:4], panel = panel,
      upper.panel = upper.panel, diag.panel = diag.panel,
      cex = 0.7, pch = 20, gap = 0)