#' Plot a Matrix of Correlations
#'
#' Plot a matrix of correlations using white ellipses
#' (representing the measured correlation) overlaid on colored circles.
#' @param r
#' A matrix of correlations (need not be symmetrical) with values ranging
#' from -1 to 1.
#' @param addtext
#' A logical scalar indicating whether the value of each correlation
#' should be written over the ellipses, default TRUE.
#' @param atcex
#' A numeric scalar giving the magnification of the added ellipse text
#' relative to that set in \code{\link{par}},
#' default NULL results in atcex=8/maximum dimension of \code{r}.
#' @param incdiag
#' A logical scalar indicating whether to plot circles for the diagonal
#' values of the matrix (if symmetric), default FALSE.
#' @param rorder
#' A logical scalar indicating whether the columns and rows of the matrix
#' should be reordered using seriation, default TRUE.
#' @param plot
#' A logical scalar indicating whether the plot should be drawn, default TRUE.
#' @param ...
#' Additional parameters to \code{\link{par}}.
#' @details
#' Correlation is represented as a white ellipse over a colored circle, sized
#' so that the proportion of the colored circle visible beyond the ellipse is
#' equal to the squared correlation (r^2). The color of each circle ranges
#' from cyan (for r = -1) to magenta (for r = 1) through white (for r = 0).
#' Similarly, the transparency of each printed correlation value (if
#' addtext=TRUE) ranges from 1 (for r = 0) to 0 (for |r| = 1).
#' @return
#' A list of with two vector of integers (the same length as each dimension
#' of \code{r}) representing the linear order suggested by seriation.
#' @export
#' @seealso
#' \code{\link[ellipse]{plotcorr}} on which the idea for the function was
#' based, \code{\link[seriation]{seriate}}, and
#' \code{\link[plotrix]{draw.ellipse}}.
#' @import
#' plotrix seriation MASS
#' @examples
#' # example using a symmetric matrix
#' sr <- cor(swiss)
#' sord <- plotcor(sr)
#' sr[sord[[1]], sord[[2]]]
#' # example using an asymmetric matrix
#' lr <- cor(longley)[1:3, 4:7]
#' lord <- plotcor(lr)
#' lr[lord[[1]], lord[[2]]]
plotcor <- function(r, addtext=TRUE, atcex=NULL, incdiag=FALSE,
rorder=TRUE, plot=TRUE, ...) {
# round to the nearest hundredth
rr <- round(r, 2)
dimr <- dim(r)
sym <- isSymmetric(r)
# get rid of diagonal numbers
if (!incdiag & sym) {
diag(rr) <- NA
}
rrf <- format(rr)
rrf[grep("NA", rrf)] <- ""
rra <- abs(rr)
nx <- dimr[2]
ny <- dimr[1]
if (is.null(atcex)) {
atcex <- 8/max(nx, ny)
}
namzx <- dimnames(rr)[[2]]
namzy <- dimnames(rr)[[1]]
# order rows/columns
ordx <- 1:nx
ordy <- 1:ny
if (rorder) {
# the seriate() function prints out % explained variance for method="PCA"
# I used capture.output to avoid having this print to the screen
dummy <- capture.output(ser <- seriate((1-r)/2, method="PCA"))
ordy <- rev(get_order(ser, 1))
ordx <- rev(get_order(ser, 2))
}
if (sym) {
ordx <- rev(ordy)
}
if (plot) {
# categorize correlations from -1 to 1 by 0.01
brks <- seq(-1, 1, 0.01)
rcat <- apply(rr, 2, cut, breaks=brks, labels=FALSE)
# assign colors on the cyan-magenta scale
colz <- apply(rcat, 2, function(x) cm.colors(length(brks))[x])
par(xaxs="i", yaxs="i", mar=c(0.1, 7, 7, 0.1), ...)
eqscplot(1, 1, type="n", xlim=c(0.5, nx+0.5), ylim=c(0.5, ny+0.5),
xlab="", ylab="", axes=FALSE)
for(i in 1:nx) {
for(j in 1:ny) {
io <- ordx[i]
jo <- ordy[j]
draw.ellipse(i, j, a=0.5, b=0.5, col=colz[jo, io], border=NA)
draw.ellipse(i, j, a=0.5, b=(1-rr[jo, io]^2)/2,
angle=45*c(-1, 1)[1+(rr[jo, io]>0)], col="white", border=NA)
if (addtext & !is.na(rra[jo, io])) {
text(i, j, rrf[jo, io], cex=atcex, col=rgb(0, 0, 0, alpha=rra[jo, io]))
}
}}
axis(3, at=1:nx, labels=namzx[ordx], las=2, tick=FALSE)
axis(2, at=1:ny, labels=namzy[ordy], las=2, tick=FALSE)
}
list(rev(ordy), ordx)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.