Skip to content

Instantly share code, notes, and snippets.

@isezen
Created May 5, 2020 07:30
Show Gist options
  • Save isezen/28a2d4197abd9cece6b98970bea7513d to your computer and use it in GitHub Desktop.
Save isezen/28a2d4197abd9cece6b98970bea7513d to your computer and use it in GitHub Desktop.
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment