Nothing
################################################################################
### Part of the R package "biostatUZH".
### Free software under the terms of the GNU General Public License (version 2
### or later) a copy of which is available at http://www.R-project.org/Licenses
###
### A fork of ellipse::plotcorr() by Duncan Murdoch
###
### Copyright (C) 2015 Sebastian Meyer
################################################################################
"plotcorr" <-
function (corr, outline = TRUE, col = TRUE,
lower.panel = "ellipse", upper.panel = "number", diag.panel = NULL,
bty = "n", axes = FALSE, xlab = "", ylab = "", asp = 1,
cex.lab = par("cex.lab"), cex = 0.75*par("cex"), mar = 0.1 + c(2,2,4,2), ...)
{
savepar <- par(pty = "s", mar = mar)
on.exit(par(savepar))
if (is.null(corr)) return(invisible())
if ((!is.matrix(corr)) || (round(min(corr, na.rm = TRUE), 6) < -1)
|| (round(max(corr, na.rm = TRUE), 6) > 1))
stop("Need a correlation matrix")
plot.new()
par(new = TRUE)
rowdim <- dim(corr)[1]
coldim <- dim(corr)[2]
rowlabs <- dimnames(corr)[[1]]
collabs <- dimnames(corr)[[2]]
if (is.null(rowlabs)) rowlabs <- 1:rowdim
if (is.null(collabs)) collabs <- 1:coldim
rowlabs <- as.character(rowlabs)
collabs <- as.character(collabs)
col <- if (isTRUE(col)) {
colorRampPalette(c("blue", "white", "red"))(11)[5*corr + 6]
} else {
rep(col, length.out = length(corr))
}
dim(col) <- dim(corr)
if (!is.null(lower.panel)) {
lower.panel <- match.arg(lower.panel, choices = c("ellipse", "number"))
}
if (!is.null(upper.panel)) {
upper.panel <- match.arg(upper.panel, choices = c("ellipse", "number"))
}
if (!is.null(diag.panel)) {
diag.panel <- match.arg(diag.panel, choices = c("ellipse", "number"))
}
cols <- 1:coldim
rows <- 1:rowdim
maxdim <- max(length(rows), length(cols))
plt <- par('plt')
xlabwidth <- max(strwidth(rowlabs[rows],units='figure',cex=cex.lab))/(plt[2]-plt[1])
xlabwidth <- xlabwidth*maxdim/(1-xlabwidth)
ylabwidth <- max(strwidth(collabs[cols],units='figure',cex=cex.lab))/(plt[4]-plt[3])
ylabwidth <- ylabwidth*maxdim/(1-ylabwidth)
plot(c(-xlabwidth-0.5, maxdim + 0.5), c(0.5, maxdim + 1 + ylabwidth),
type = "n", bty = bty, axes = axes, xlab = "", ylab = "", asp = asp,
cex.lab = cex.lab, ...)
text(rep(0, length(rows)), length(rows):1, labels = rowlabs[rows], adj = 1, cex = cex.lab)
text(cols, rep(length(rows) + 1, length(cols)), labels = collabs[cols],
srt = 90, adj = 0, cex = cex.lab)
mtext(xlab,1,0)
mtext(ylab,2,0)
mat <- diag(c(1, 1))
plotcorrInternal <- function()
{
panel <- if (i == j) diag.panel else if (i > j) lower.panel else upper.panel
if (is.null(panel)) return()
if (panel == "ellipse") {
mat[1, 2] <- corr[i, j]
mat[2, 1] <- mat[1, 2]
ell <- ellipse::ellipse(mat, t = 0.43)
ell[, 1] <- ell[, 1] + j
ell[, 2] <- ell[, 2] + length(rows) + 1 - i
polygon(ell, col = col[i, j])
if (outline) lines(ell)
} else {
text(j + 0.3, length(rows) + 1 - i, round(10 * corr[i, j], 0),
adj = 1, cex = cex)
}
}
for (i in 1:dim(corr)[1]) {
for (j in 1:dim(corr)[2]) {
plotcorrInternal()
}
}
invisible()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.