R/pairsDAFS.R

In dafs: Data Analysis for Forensic Scientists

pairsDAFS = function(x,...){
    panel.smooth.mod = function (x, y, col = par("col"), bg = NA, pch = par("pch"),
    cex = 1, col.smooth = "gray45", 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, lwd = 2.5, ...)
    }

    panel.hist.mod = 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 = "gray80", ...)
    }

    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)
         text(0.5, 0.5, txt, cex = cex * r)
     }

    pairs(x, upper.panel = panel.smooth.mod, lower.panel = panel.cor,
        diag.panel = panel.hist.mod, ...)
}