R/pairs.mcmc.list.R

In datacloning/dclone: Data Cloning and MCMC Tools for Maximum Likelihood Methods

pairs.mcmc.list <-
function(x, n = 25, col = 1:length(x),
col.hist = "gold", col.image = terrain.colors(50),
density = TRUE, contour = TRUE, mean = TRUE, ...)
{
    #requireNamespace("MASS")
    ind <- t(matrix(1:(niter(x)*length(x)), niter(x), length(x)))
    dim(ind) <- NULL
    y <- as.matrix(x)[ind,]
    COL <- rep(col, niter(x))
    fun.lower0 <- function(x1, x2, ...) {
        d <- MASS::kde2d(x1, x2, n=n)
        if (density)
            image(d, col=col.image, add=TRUE)
        if (mean)
            abline(v=mean(x1),h=mean(x2))
        if (contour)
            contour(d,add=TRUE)
    }
    fun.upper <- function(x1, x2, ...) {
        if (mean)
            abline(v=mean(x1),h=mean(x2))
        points(x1,x2,col=COL,pch=".",...)
    }
    panel.hist.density <- function(x,...) {
        usr <- par("usr")
        on.exit(par(usr = usr))
        par(usr = c(usr[1:2], 0, 1.5) )
        h <- hist(x, n, plot = FALSE)
        breaks <- h$breaks
        nB <- length(breaks)
        y <- h$counts; y <- y/max(y)
        rect(breaks[-nB], 0, breaks[-1], y, col=col.hist, border=NA)
        d <- try(density(x,na.rm=TRUE,bw="nrd",adjust=1.2))
        if (!inherits(d, "try-error")) {
            d$y <- d$y/max(d$y)
            lines(c(mean(x),mean(x)), c(0,1))
            lines(d)
        }
        rug(x, side=3)
    }
    fun.lower <- if (contour || density)
        fun.lower0 else fun.upper
    pairs.default(y, labels=varnames(x), lower.panel=fun.lower,
        upper.panel=fun.upper, diag.panel=panel.hist.density)
    invisible(NULL)
}