Nothing
# File hydropairs.R
# Part of the hydroTSM R package, https://github.com/hzambran/hydroTSM ;
# https://CRAN.R-project.org/package=hydroTSM
# Copyright 2009-2017 Mauricio Zambrano-Bigiarini
# Distributed under GPL 2 or later
################################################################################
# 'hydropairs' : Visualization of a Correlation Matrix #
################################################################################
# Author : Mauricio Zambrano-Bigiarini #
################################################################################
# Started: 29-Jul-2009 #
################################################################################
# On top the (absolute) value of the correlation plus the result of the cor.test as points.
# On botttom, the bivariate scatterplots, with a fitted line
# On diagonal, histograms (from '?pairs')
# Original idea taken from: http://addictedtor.free.fr/graphiques/graphcode.php?graph=137
# Histogram panles was taken form the R help of the original 'pairs' function
# x : a numeric vector, matrix or data frame
# dec : decimals places to be used for showing the correlation values
# use : an optional character string giving a method for computing
# covariances in the presence of missing values. This must be
# (an abbreviation of) one of the strings '"everything"',
# '"all.obs"', '"complete.obs"', '"na.or.complete"', or
# '"pairwise.complete.obs"'.
# method: a character string indicating which correlation coefficient
# (or covariance) is to be computed. One of '"pearson"'
# (default), '"kendall"', or '"spearman"', can be abbreviated.
hydropairs <- function(x, dec=3, use="pairwise.complete.obs", method="pearson",... ) {
# Checking that the user provied a valid argument for 'x'
if ( is.na( match( class(x), c("matrix", "data.frame") ) ) )
stop("Invalid argument: 'class(x)' must be in c('data.frame')")
panel.cor <- function(x, y, digits=dec, prefix="", cex.cor)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- abs(cor(x, y, method= method, use= use))
txt <- format(c(r, 0.123456789), digits=dec)[1]
txt <- paste(prefix, txt, sep="")
if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
test <- cor.test(x,y)
# borrowed from printCoefmat
Signif <- symnum(test$p.value, corr = FALSE, na = FALSE,
cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
symbols = c("***", "**", "*", ".", " "))
text(0.5, 0.5, txt, cex = cex * r)
text(.8, .8, Signif, cex=cex, col=2)
} # 'panel.cor' END
panel.hist <- 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="cyan", ...)
} # 'panel.hist' END
# 'font.labels' =2 : bold font for the variables
# 'cex.labels' controls the size of the fonts
pairs(x, lower.panel=panel.smooth, upper.panel=panel.cor,
diag.panel=panel.hist, ...)
} # 'hydropairs' END
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.