fMultivar/ 0000755 0001751 0000144 00000000000 12046452327 012246 5 ustar hornik users fMultivar/MD5 0000644 0001751 0000144 00000003124 12046452327 012556 0 ustar hornik users bb4760a4a41aa2225869cbdad79b5cbe *ChangeLog
0aca9ff3ea2fdb6a8e4ef6f2c350e445 *DESCRIPTION
aa56635bed77a75b7edda3e0cd04815c *NAMESPACE
28904ec67ad108b7d933bed2d9602b65 *R/BivariateBinning.R
bf80eda2207641e1486de2649263b1cb *R/BivariateGridding.R
6728cc8658694dfd46b671e3e4c8c27b *R/MultivariateDistributions.R
bd48a64402251154d7afbd4777f466b6 *R/cauchy2d.R
33ebc9f0c61e57bf206752e2ab08a84d *R/density2d.R
dc89d7904bfd40ff3c1ef5c0fa96b2c0 *R/elliptical2d.R
4c3f51acecd49217a4fe9d51392f3bf4 *R/mvsnormDistribution.R
e6fe483c6db38c6eba55b045fa52df39 *R/mvstDistribution.R
c0ae6dd505d87ba282fc4415ae929df6 *R/norm2d.R
0b956cf8e243e6b48402b9db69f034fe *R/t2d.R
6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html
c21a9d4df2f42ea6b9cff25c61ccbf24 *inst/unitTests/Makefile
077d37383e501be8365cc12a07aad772 *inst/unitTests/runTests.R
91dc804dc9dced96868be30c047d1d02 *inst/unitTests/runit.BivariateBinning.R
f50aa6546fbb8a99e0cc1baf2bb5cbed *inst/unitTests/runit.BivariateDistributions.R
575bdb4f18b49212508b510479b0b631 *inst/unitTests/runit.BivariateGridding.R
f1531de66cb087e3ea1db8f38eb0790b *inst/unitTests/runit.MultivariateDistributions.R
488a639ab11340b0d82c8b01f6c5d341 *man/BivariateBinning.Rd
ecf09626afc1fdaadc23da25ce75d243 *man/BivariateGridding.Rd
4615455f3b1563a3f3cbcd4205793a27 *man/MultivariateDistributions.Rd
3490377df824bbe911bdc939d19ab7d5 *man/cauchy2d.Rd
9954a6d5a30f84329924b91ea3f69a8d *man/density2.Rd
8942a58e8d7ee1fd47c93711b0be6ce2 *man/elliptical2d.Rd
6372c404cde30ad821a4135f0532efad *man/norm2d.Rd
12fec7a4c2f41f4dcab5b24fe46d955a *man/t2d.Rd
ca566e590ec30abd0718c5375e1a446f *tests/doRUnit.R
fMultivar/tests/ 0000755 0001751 0000144 00000000000 11720123747 013407 5 ustar hornik users fMultivar/tests/doRUnit.R 0000644 0001751 0000144 00000001516 11370220757 015121 0 ustar hornik users #### doRUnit.R --- Run RUnit tests
####------------------------------------------------------------------------
### Origianlly follows Gregor Gojanc's example in CRAN package 'gdata'
### and the corresponding section in the R Wiki:
### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
### MM: Vastly changed: This should also be "runnable" for *installed*
## package which has no ./tests/
## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R :
if(require("RUnit", quietly = TRUE)) {
## --- Setup ---
wd <- getwd()
pkg <- sub("\\.Rcheck$", '', basename(dirname(wd)))
library(package=pkg, character.only = TRUE)
path <- system.file("unitTests", package = pkg)
stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
source(file.path(path, "runTests.R"), echo = TRUE)
}
fMultivar/R/ 0000755 0001751 0000144 00000000000 12046426447 012453 5 ustar hornik users fMultivar/R/t2d.R 0000644 0001751 0000144 00000010172 11370220757 013263 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BIVARIATE STUDENT-T DISTRIBUTION:
# pt2d Computes bivariate Student-t probability function
# dt2d Computes bivariate Student-t density function
# rt2d Generates bivariate Student-t random deviates
################################################################################
pt2d =
function(x, y = x, rho = 0, nu = 4)
{ # pnorm2d: A copy from R package "sn"
# Description:
# Computes bivariate Student-t probability function
# Arguments:
# x, y - two numeric values or vectors of the same length at
# which the probability will be computed.
# Example:
# pt2d(rnorm(5), rnorm(5), 0.5, 5)
# Value:
# returns a numeric vector of probabilities of the same length
# as the input vectors
# FUNCTION:
# Normal Limit:
if (nu == Inf) return(pnorm2d(x = x, y = y, rho = rho))
# Settings:
sigma = diag(2)
sigma[1, 2] = sigma[2, 1] = rho
X = cbind(x, y)
# Probaility:
ans = pmvst(X, dim = 2, mu = c(0, 0), Omega = sigma,
alpha = c(0, 0), df = nu)
attr(ans, "control") = c(rho = rho, nu = nu)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
dt2d =
function(x, y = x, rho = 0, nu = 4)
{ # A function implemented by Diethelm Wuertz
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# Description:
# Computes bivariate Student-t density function
# Example:
# dt2d(rnorm(5), rnorm(5), 0.5, 5)
# Note:
# Partly copied from contributed R package 'sn'
# FUNCTION:
# Normal Limit:
if (nu == Inf) return(dnorm2d(x = x, y = y, rho = rho))
# Argument:
xoy = (x^2 - 2*rho*x*y + y^2)/ (2*(1 - rho^2))
# Density:
density = (1 + 2*xoy/nu)^(-(nu+2)/2) / (2*pi*sqrt(1-rho^2))
attr(density, "control") = c(rho = rho, nu = nu)
# Return value:
density
}
# ------------------------------------------------------------------------------
rt2d =
function(n, rho = 0, nu = 4)
{ # A function implemented by Diethelm Wuertz
# Description:
# Generates bivariate Student-t random deviates
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# Note:
# Partly copied from contributed R package 'mvtnorm'
# Author Friedrich Leisch
# FUNCTION:
# Normal Limit:
if (nu == Inf) return(rnorm2d(n = n, rho = rho))
# Random Deviates:
ans = rnorm2d(n, rho)/sqrt(rchisq(n, nu)/nu)
attr(ans, "control") = c(rho = rho, nu = nu)
# Return Value:
ans
}
################################################################################
fMultivar/R/norm2d.R 0000644 0001751 0000144 00000021704 12046426447 014003 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BIVARIATE NORMAL DISTRIBUTION:
# pnorm2d Computes bivariate Normal probability function
# dnorm2d Computes bivariate Normal density function
# rnorm2d Generates bivariate normal random deviates
################################################################################
pnorm2d =
function(x, y = x, rho = 0)
{ # pnorm2d: A copy from R package "sn"
# Description:
# Computes bivariate Normal probability function
# Arguments:
# x, y - two numeric values or vectors of the same length at
# which the probability will be computed.
# Value:
# returns a numeric vector of probabilities of the same length
# as the input vectors
# FUNCTION:
# Probaility:
X = cbind(x, y)
ans = apply(X, 1, .pnorm2d, rho = rho)
attr(ans, "control") = c(rho = rho)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.pnorm2d =
function(X, rho = 0)
{ # pnorm2d: A copy from R package "sn"
# Description:
# Bivariate Normal probability function
# Arguments:
# x, y - two numeric values at which the probability will
# be computed.
# Value:
# returns a numeric vector of probabilities of the same length
# as the input vectors
# FUNCTION:
# Probability:
x = X[1]
y = X[2]
if (x == 0 & y == 0) {
return(0.25 + asin(rho)/(2 * pi))
}
p = 0.5 * (pnorm(x) + pnorm(y))
if (x == 0) {
p = p - 0.25 * sign(y)
} else {
if (is.finite(x)) {
Y = (y - rho * x)/(x * sqrt(1 - rho^2))
} else {
Y = -rho/sqrt(1-rho^2)
}
p = p - .TOwen(x, Y)
}
if (y == 0) {
p = p - 0.25 * sign(x)
} else {
if (is.finite(y)) {
X = (x - rho * y)/(y * sqrt(1 - rho^2))
} else {
X = -rho/sqrt(1-rho^2)
}
p = p - .TOwen(y, X)
}
if (is.finite(x) & is.finite(y)) {
if ((x * y < 0) | ((x * y == 0) & (x + y) < 0)) {
p = p - 0.5
}
}
# Return Value:
return(p)
}
# ------------------------------------------------------------------------------
.TInt =
function(h, a, jmax, cut.point)
{ # T.int: A copy from R package "sn"
# Note:
# Required by .pnorm2d and .TOwen
# FUNCTION:
.fui = function(h, i) (h^(2 * i))/((2^i) * gamma(i + 1))
seriesL = seriesH = NULL
i = 0:jmax
low = (h <= cut.point)
hL = h[low]
hH = h[!low]
L = length(hL)
if (L > 0) {
b = outer(hL, i, .fui)
cumb = apply(b, 1, cumsum)
b1 = exp(-0.5 * hL^2) * t(cumb)
matr = matrix(1, jmax + 1, L) - t(b1)
jk = rep(c(1, -1), jmax)[1:(jmax + 1)]/(2 * i + 1)
matr = t(matr * jk) %*% a^(2 * i + 1)
seriesL = (atan(a) - as.vector(matr))/(2 * pi)
}
if (length(hH) > 0) {
seriesH = atan(a) * exp(-0.5 * (hH^2) * a/atan(a)) *
(1 + 0.00868 * (hH^4) * a^4)/(2 * pi)
}
series = c(seriesL, seriesH)
id = c((1:length(h))[low], (1:length(h))[!low])
series[id] = series
# Return Value:
series
}
# ------------------------------------------------------------------------------
.TOwen =
function (h, a, jmax = 50, cut.point = 6)
{ # T.Owen: A copy from R package "sn"
# Note:
# Required by .pnorm2d
# FUNCTION:
if (!is.vector(a) | length(a) > 1)
stop("a must be a vector of length 1")
if (!is.vector(h))
stop("h must be a vector")
aa = abs(a)
ah = abs(h)
if (aa == Inf)
return(0.5 * pnorm(-ah))
if (aa == 0)
return(rep(0, length(h)))
na = is.na(h)
inf = (ah == Inf)
ah = replace(ah, (na | inf), 0)
if (aa <= 1) {
owen = .TInt(ah, aa, jmax, cut.point)
} else {
owen = 0.5 * pnorm(ah) + pnorm(aa * ah) * (0.5 - pnorm(ah)) -
.TInt(aa * ah, (1/aa), jmax, cut.point)
}
owen = replace(owen, na, NA)
owen = replace(owen, inf, 0)
ans = return(owen * sign(a))
# Return Value:
ans
}
# ------------------------------------------------------------------------------
dnorm2d =
function(x, y = x, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Arguments:
# x,y - two numeric vectors
# rho - the linear correlation, a numeric value between
# minus one and one.
# FUNCTION:
# Argument:
xoy = (x^2 - 2*rho*x*y + y^2)/ (2*(1 - rho^2))
# Density:
density = exp(-xoy) / ( 2*pi*sqrt(1-rho^2))
attr(density, "control") = c(rho = rho)
# Return Value:
density
}
# ------------------------------------------------------------------------------
.dnorm2d =
function(x, y = x, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Arguments:
# x,y - two numeric vectors
# rho - the linear correlation, a numeric value between
# minus one and one.
# Note:
# Partly copied from contributed R package 'mvtnorm'
# Author Friedrich Leisch
# FUNCTION
# Settings:
mean = c(0,0)
sigma = diag(2)
sigma[1,2] = sigma[2,1] = rho
log = FALSE
x = cbind(x, y)
# From mvtnorm - Check:
if (is.vector(x)) {
x = matrix(x, ncol = length(x))
}
if (missing(mean)) {
mean = rep(0, length = ncol(x))
}
if (missing(sigma)) {
sigma = diag(ncol(x))
}
if (ncol(x) != ncol(sigma)) {
stop("x and sigma have non-conforming size")
}
if (nrow(sigma) != ncol(sigma)) {
stop("sigma meanst be a square matrix")
}
if (length(mean) != nrow(sigma)) {
stop("mean and sigma have non-conforming size")
}
# From mvtnorm - Density:
distval = mahalanobis(x, center = mean, cov = sigma)
logdet = sum(log(eigen(sigma, symmetric = TRUE, only.values = TRUE)$values))
logretval = -(ncol(x)*log(2*pi) + logdet + distval)/2
if(log) return(logretval)
ans = exp(logretval)
attr(ans, "control") = c(rho = rho)
# Return value:
ans
}
# ------------------------------------------------------------------------------
rnorm2d =
function(n, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Description:
# Generates bivariate normal random deviates
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# Note:
# Partly copied from contributed R package 'mvtnorm'
# Author Friedrich Leisch
# FUNCTION
# Settings:
mean = c(0,0)
sigma = diag(2)
sigma[1,2] = sigma[2,1] = rho
# From mvtnorm - Random Numbers:
ev = eigen(sigma, symmetric = TRUE)$values
if (!all(ev >= -sqrt(.Machine$double.eps) * abs(ev[1])))
warning("sigma is numerically not positive definite")
sigsvd = svd(sigma)
ans = t(sigsvd$v %*% (t(sigsvd$u) * sqrt(sigsvd$d)))
ans = matrix(rnorm(n * ncol(sigma)), nrow = n) %*% ans
ans = sweep(ans, 2, mean, "+")
attr(ans, "control") = c(rho = rho)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.rnorm2d =
function(n, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Description:
# Alternative direct algorithm from Lindskog Master Thesis
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# FUNCTION:
# Random Deviates
x = matrix(c(1, rho, rho,1), 2)
V = NULL
U = chol(x)
siz = dim(x)[1]
for(i in 1:n) {
Z = rnorm(siz)
res = t(U)%*%Z
V = cbind(V,res)
}
rmn = t(V)
# Return Value:
rmn
}
################################################################################
fMultivar/R/mvstDistribution.R 0000644 0001751 0000144 00000010772 11370220757 016171 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# dmvst Multivariate Skew Sudent-t Density Function
# pmvst Multivariate Skew Sudent-t Probability Function
# rmvst Multivariate Skew Sudent-t Random Deviates
# REQUIREMENTS: DESCRIPTION:
# "mvtnorm" Contributed R - Package
# "sn" | "mnormt" Contributed R - Package
################################################################################
################################################################################
dmvst =
function(x, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim), df = 4)
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Sudent-t Density Function
# Arguments:
# FUNCTION:
# Settings:
xi = mu
ans = NA
# Univariate Case:
if (is.vector(x) & dim == 1) {
ans = dst(x, location = xi[1], scale = as.vector(Omega)[1],
shape = alpha[1], df = Inf)
}
# Multivariate Case:
if (is.matrix(x)) {
if (dim == ncol(x)) {
ans = dmst(x = x, xi = xi, Omega = Omega, alpha = alpha, df = df)
}
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("conflicting x and dim")
}
# Return Value:
as.vector(ans)
}
# ------------------------------------------------------------------------------
pmvst =
function(q, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim), df = 4)
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Sudent-t Probability Function
# Arguments:
# FUNCTION:
# Settings:
x = q
xi = mu
ans = NA
# Univariate Case:
if (is.vector(x) & dim == 1) {
ans = pst(x, location = xi[1], scale = as.vector(Omega)[1],
shape = alpha[1], df = df)
}
# Multivariate Case:
if (is.matrix(x)) {
if (dim == ncol(x)) {
ans = NULL
for (i in 1:nrow(x) ) {
ans = c(ans, pmst(x = x[i,], xi = xi, Omega = Omega,
alpha = alpha, df = df))
}
}
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("conflicting x and dim")
}
# Return Value:
as.vector(ans)
}
# ------------------------------------------------------------------------------
rmvst =
function(n, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim), df = 4)
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Sudent-t Random Number Generator
# Arguments:
# FUNCTION:
# Settings:
ans = NA
xi = mu
# Univariate Case:
if (dim == 1) {
ans = as.matrix(rst(n, location = xi[1],
scale = as.vector(Omega)[1], shape = alpha[1], df = df))
}
# Multivariate Case:
if (dim > 1) {
ans = rmst(n, xi = xi, Omega = Omega, alpha = alpha, df = df)
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("dim must be greater 1")
}
# Return Value:
rownames(ans) = as.character(1:n)
colnames(ans) = as.character(1:dim)
ans
}
################################################################################
fMultivar/R/mvsnormDistribution.R 0000644 0001751 0000144 00000011216 11370220757 016673 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# dmvsnorm Multivariate Skew Normal Density Function
# pmvsnorm Multivariate Skew Normal Probability Function
# rmvsnorm Multivariate Skew Normal Random Deviates
# REQUIREMENTS: DESCRIPTION:
# "mvtnorm" Contributed R - Package
# "sn" | "mnormt" Contributed R - Package
################################################################################
################################################################################
# Multivariate Skew Normal Distribution
dmvsnorm =
function(x, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim))
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Normal Density Function
# Note:
# Requires dsn() and dmsn() from R package sn
# FUNCTION:
# Settings:
xi = mu
ans = NA
# Univariate Case:
if (is.vector(x) & dim == 1) {
ans = dsn(x, location = xi[1], scale = as.vector(Omega)[1],
shape = alpha[1])
}
# Multivariate Case:
if (is.matrix(x)) {
if (dim == ncol(x)) {
ans = dmsn(x = x, xi = xi, Omega = Omega, alpha = alpha)
}
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("conflicting x and dim")
}
# Return Value:
as.vector(ans)
}
# ------------------------------------------------------------------------------
pmvsnorm =
function(q, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim))
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Normal Probability Function
# Algorithm:
# Note:
# Requires psn() and pmsn() from R package sn
# FUNCTION:
# Settings:
x = q
xi = mu
ans = NA
# Univariate Case:
if (is.vector(x) & dim == 1) {
ans = psn(x, location = xi[1], scale = as.vector(Omega)[1],
shape = alpha[1])
}
# Multivariate Case:
if (is.matrix(x)) {
if (dim == ncol(x)) {
ans = NULL
for (i in 1:nrow(x) ) {
ans = c(ans, pmsn(x = x[i,], xi = xi, Omega = Omega,
alpha = alpha))
}
}
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("conflicting x and dim")
}
# Return Value:
as.vector(ans)
}
# ------------------------------------------------------------------------------
rmvsnorm =
function(n, dim = 2, mu = rep(0, dim), Omega = diag(dim),
alpha = rep(0, dim))
{ # A function implemented by Diethelm Wuertz
# Description:
# Multivariate Skew Normal Random Number Generator
# Algorithm:
# Note:
# Requires rsn() and rmsn() from R package sn
# FUNCTION:
# Settings:
ans = NA
xi = mu
# Univariate Case:
if (dim == 1) {
ans = as.matrix(rsn(n, location = xi[1],
scale = as.vector(Omega)[1], shape = alpha[1]))
}
# Multivariate Case:
if (dim > 1) {
ans = rmsn(n, xi = xi, Omega = Omega, alpha = alpha)
}
# Check for conflicting Dimensions:
if (is.na(ans[1])) {
stop("dim must be greater 1")
}
# Return Value:
rownames(ans) = as.character(1:n)
colnames(ans) = as.character(1:dim)
ans
}
################################################################################
fMultivar/R/MultivariateDistributions.R 0000644 0001751 0000144 00000040066 11370220757 020030 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: PARAMETER ESTIMATION:
# fMV S4 Object of class 'fMV'
# mvFit Fits a MV Normal or Student-t Distribution
# print.fMV S3: Print method for objects of class 'fMV'
# plot.fMV S3: Plot method for objects of class 'fMV'
# summary.fMV S3: Summary method for objects of class 'fMV'
# .mvnormFit Fits a Multivariate Normal Distribution
# .mvstFit Fits a Multivariate Student-t Distribution
# .mvsnormPlot Plots for Multivariate Normal Distribution
# .mvstPlot Plots for Multivariate Student-t Distribution
# REQUIREMENTS: DESCRIPTION:
# "mvtnorm" Contributed R - Package
# "sn" | "mnormt" Contributed R - Package
################################################################################
################################################################################
# PARAMETER FIT:
setClass("fMV",
representation(
call = "call",
method = "character",
model = "list",
data = "data.frame",
fit = "list",
title = "character",
description = "character")
)
# ------------------------------------------------------------------------------
mvFit =
function(x, method = c("snorm", "st"), fixed.df = NA, title = NULL,
description = NULL, trace = FALSE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# FUNCTION:
# Fit:
if (method[1] == "snorm") {
# Normal Fit:
fit = .mvsnormFit(x = x, trace = trace, ...)
fit$df = Inf
}
if (method[1] == "st") {
# Student-t Fit:
fit = .mvstFit(x = x, fixed.df = fixed.df, trace = trace, ...)
}
# Add to fit:
fit$method = method[1]
class(fit) = "list"
# Model Slot:
model = list(beta = fit$beta, Omega = fit$Omega,
alpha = fit$alpha, df = fit$df)
# Title Slot:
if (is.null(title)) {
if (method[1] == "snorm")
title = "Multivariate Normal Distribution"
if (method[1] == "st")
title = "Multivariate Student-t Distribution"
}
# Description Slot:
if (is.null(description)) description = description()
# Return Value:
new("fMV",
call = as.call(match.call()),
method = as.character(method[1]),
model = model,
data = as.data.frame(x),
fit = fit,
title = as.character(title),
description = as.character(description) )
}
# ------------------------------------------------------------------------------
setMethod("show", "fMV",
function(object)
{ # A function implemented by Diethelm Wuertz
# Description:
# Arguments:
# FUNCTION:
# Extract fit:
fit = object@fit
# Print:
cat("\nCall:\n ")
print.default(fit$call)
cat("\nParameter Sstimates:\n")
print.default(fit$dp)
cat("\nParameter Errors:\n")
print.default(fit$se)
# cat("\nOptimization:\n")
# print.default(fit$optim)
})
# ------------------------------------------------------------------------------
plot.fMV =
function(x, which = "ask", ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Arguments:
# FUNCTION:
# Plot:
if (x@fit$method == "snorm") {
# Multivariate Skew Normal Distribution:
return(.mvsnormPlot(x = x@fit, which = which, ...))
}
if (x@fit$method == "st") {
# Multivariate Skew Student-t Distribution:
return(.mvstPlot(x = x@fit, which = which, ...))
}
}
# ------------------------------------------------------------------------------
summary.fMV =
function(object, which = "ask", doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Arguments:
# FUNCTION:
# Print:
print(x = object, ...)
# Plot:
if (doplot) plot(x = object, which = which, doplot, ...)
# Return Value:
invisible(object)
}
################################################################################
# INERNAL FUNCTIONS:
.mvsnormFit =
function(x, trace = FALSE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Function
# Arguments:
# FUNCTION:
# Settings:
y = x
y.name = deparse(substitute(y))
y.names = dimnames(y)[[2]]
y = as.matrix(y)
colnames(y) = y.names
k = ncol(y)
freq = rep(1, nrow(y))
n = sum(freq)
X = rep(1, nrow(y))
X = as.matrix(X)
m = ncol(X)
dimnames(y) = list(NULL, outer("V", as.character(1:k), paste, sep = ""))
y.names = as.vector(dimnames(y)[[2]])
qrX = qr(X)
# Fit:
mle = msn.mle(X = X, y = y, freq = freq, trace = trace, ...)
mle$call = match.call()
mle$y = y
mle$y.names = y.names
# Parameters:
mle$beta = beta = mle$dp$beta
mle$xi = xi = X %*% beta
mle$Omega = Omega = mle$dp$Omega
mle$alpha = alpha = mle$dp$alpha
# Test:
# dev.norm = msn.dev(c(qr.coef(qrX, y), rep(0, k)), X, y, freq)
# test = dev.norm + 2 * mle$logL
# p.value = 1 - pchisq(test, k)
# mle$test.normality = list(LRT = test, p.value = p.value)
# Save for Plot:
Xb = qr.fitted(qrX, y)
res = qr.resid(qrX, y)
mle$k = k
mle$n = n
mle$pp = qchisq((1:n)/(n + 1), k)
mle$rad.n = apply((y - Xb) * ((y - Xb) %*% solve(var(res))), 1, sum)
mle$rad.sn = apply((y - xi) * ((y - xi) %*% solve(Omega)), 1, sum)
# Return Value:
class(mle) = "snFit"
mle
}
# ------------------------------------------------------------------------------
.mvstFit =
function(x, fixed.df = NA, trace = FALSE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Function
# Arguments:
# FUNCTION:
# Settings:
y = as.matrix(x)
k = ncol(y)
y.name = deparse(substitute(y))
dimnames(y) = list(NULL, outer("V", as.character(1:k), paste, sep = ""))
y.names = dimnames(y)[[2]]
freq = rep(1, nrow(y))
n = sum(freq)
X = as.matrix(rep(1, nrow(y)))
qrX = qr(X)
m = ncol(X)
# Fit:
mle = mst.mle(X = X, y = y, freq = freq, fixed.df = fixed.df,
trace = trace, ...)
mle$call = match.call()
mle$y = y
mle$y.names = y.names
# Parameters:
mle$beta = beta = mle$dp$beta
mle$xi = xi = X %*% beta
mle$Omega = Omega = mle$dp$Omega
mle$alpha = alpha = mle$dp$alpha
mle$df = df = mle$dp$df
# Save for Plot:
Xb = qr.fitted(qrX, y)
res = qr.resid(qrX, y)
mle$k = k
mle$n = n
mle$pp = k * qf((1:n)/(n + 1), k, df)
mle$rad.n = as.vector(apply(res * (res %*% solve(var(res))), 1, sum))
mle$rad.sn = as.vector(apply((y - xi)*((y - xi) %*% solve(Omega)), 1, sum))
# Return Value:
class(mle) = "stFit"
mle
}
# ------------------------------------------------------------------------------
.mvsnormPlot =
function(x, which = "ask", ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Plot Function
# Arguments:
# x - the slot @fit from an object of class "fMV"
# FUNCTION:
# Settings:
dim = ncol(x$y)
# Plot Title:
plot1Title = "Scatterplots"
if (dim == 1) plot1Title = "Histogram Plot"
# Plot:
interactivePlot(
x = x,
choices = c(
plot1Title,
"Normal QQ-Plot",
"Skew-Normal QQ-Plot",
"Normal PP-Plot",
"Skew-Normal PP-Plot"),
plotFUN = c(
".mvsnorm.plot.1",
".mvsnorm.plot.2",
".mvsnorm.plot.3",
".mvsnorm.plot.4",
".mvsnorm.plot.5"),
which = which)
# Return Value:
invisible(x)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.1 <-
function(x)
{
# Plot:
dim = x$k
if(dim == 1) .mvsnorm.plot.1A(x) else .mvsnorm.plot.1B(x)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.1A <-
function(x)
{
# Plot:
z = x
y0 <- z$y
xi0 <- apply(z$xi, 2, mean)
y0 <- as.vector(y0)
x <- seq(min(pretty(y0, 10)), max(pretty(y0, 10)), length = 100)
omega <- sqrt(diag(z$Omega))
dp0 <- c(xi0, omega, z$alpha)
xlab <- z$y.name
hist(y0, prob = TRUE, breaks = "FD", xlab = xlab,
ylab = "density", border = "white", col = "steelblue4",
main = z$y.name)
lines(x, dsn(x, dp0[1], dp0[2], dp0[3]))
if (length(y0) < 201)
points(y0, rep(0, z$n), pch = 1)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.1B <-
function(x)
{
# Plot:
opt = options()
options(warn = -1)
pairs(
x$y,
labels = x$y.names,
panel = function(x, y, Y, y.names, xi, Omega, alpha) {
for (i in 1:length(alpha)) {
if (all(Y[, i] == x))
Ix = i
if (all(Y[, i] == y))
Iy = i }
points(x, y)
marg = msn.marginal(xi, Omega, alpha, c(Ix, Iy))
xi.marg = marg$xi
Omega.marg = marg$Omega
alpha.marg = marg$alpha
x1 = seq(min(x), max(x), length = 30)
x2 = seq(min(y), max(y), length = 30)
dsn2.plot(x1, x2, xi.marg, Omega.marg, alpha.marg,
add = TRUE, col = "steelblue4")},
Y = x$y,
y.names = dimnames(x$y)[[2]],
xi = apply(x$xi, 2, mean),
Omega = x$Omega,
alpha = x$alpha)
options(opt)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.2 <-
function(x)
{
# Plot:
plot(x$pp, sort(x$rad.n), pch = 1, ylim = c(0, max(x$rad.n, x$rad.sn)),
xlab = "Chi-square Percentiles",
ylab = "Mahalanobis Distances")
abline(0, 1, lty = 3)
title(main = "Normal QQ-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.3 <-
function(x)
{
# Plot:
plot(x$pp, sort(x$rad.sn), pch = 1, ylim = c(0, max(x$rad.n, x$rad.sn)),
xlab = "Percentiles of chi-square distribution",
ylab = "Mahalanobis distances")
abline(0, 1, lty = 3)
title(main = "Skew-Normal QQ-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.4 <-
function(x)
{
# Plot:
plot((1:x$n)/(x$n + 1), sort(pchisq(x$rad.n, x$k)),
xlab = "", ylab = "")
abline(0, 1, lty = 3)
title(main = "Normal PP-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvsnorm.plot.5 <-
function(x)
{
# Plot:
plot((1:x$n)/(x$n + 1), sort(pchisq(x$rad.sn, x$k)),
xlab = "", ylab = "")
abline(0, 1, lty = 3)
title(main = "Skew-Normal PP-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvstPlot =
function(x, which = "ask", ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Plot Function
# Arguments:
# x - the slot @fit from an object of class "fMV"
# FUNCTION:
# Settings:
dim = ncol(x$y)
# Plot Title:
plot1Title = "Scatterplots"
if (dim == 1) plot1Title = "Histogram Plot"
# Plot:
plot1Title = "Scatterplots"
if (dim == 1) plot1Title = "Histogram Plot"
interactivePlot(
x = x,
choices = c(
plot1Title,
"Normal QQ-Plot",
"Skew-Normal QQ-Plot",
"Normal PP-Plot",
"Skew-Normal PP-Plot"),
plotFUN = c(
".mvst.plot.1",
".mvst.plot.2",
".mvst.plot.3",
".mvst.plot.4",
".mvst.plot.5"),
which = which)
# Return Value:
invisible(x)
}
# ------------------------------------------------------------------------------
.mvst.plot.1 <-
function(x)
{
# Plot:
dim = x$k
if(dim == 1) .mvst.plot.1A(x) else .mvst.plot.1B(x)
}
# ------------------------------------------------------------------------------
.mvst.plot.1A <-
function(x)
{
# Plot:
z = x
y0 <- z$y
xi0 <- apply(z$xi, 2, mean)
y0 <- as.vector(y0)
x <- seq(min(pretty(y0, 10)), max(pretty(y0, 10)), length = 100)
omega <- sqrt(diag(z$Omega))
dp0 <- c(xi0, omega, z$alpha, z$df)
xlab <- z$y.name
hist(y0, prob = TRUE, breaks = "FD", xlab = xlab,
ylab = "density", border = "white", col = "steelblue4",
main = z$y.name)
lines(x, dst(x, dp0[1], dp0[2], dp0[3], dp0[4]))
if (length(y0) < 201)
points(y0, rep(0, z$n), pch = 1)
}
# ------------------------------------------------------------------------------
.mvst.plot.1B <-
function(x)
{
# Plot:
opt = options()
options(warn = -1)
pairs(
x$y,
labels = x$y.names,
panel = function(x, y, Y, y.names, xi, Omega, alpha, df) {
for (i in 1:length(alpha)) {
if (all(Y[, i] == x))
Ix = i
if (all(Y[, i] == y))
Iy = i }
points(x, y)
marg = msn.marginal(xi, Omega, alpha, c(Ix, Iy))
xi.marg = marg$xi
Omega.marg = marg$Omega
alpha.marg = marg$alpha
x1 = seq(min(x), max(x), length = 30)
x2 = seq(min(y), max(y), length = 30)
dst2.plot(x1, x2, xi.marg, Omega.marg, alpha.marg,
df, add = TRUE, col = "steelblue4")} ,
Y = x$y,
y.names = dimnames(x$y)[[2]],
xi = apply(x$xi, 2, mean),
Omega = x$Omega,
alpha = x$alpha,
df = x$df)
options(opt)
}
# ------------------------------------------------------------------------------
.mvst.plot.2 <-
function(x)
{
# Plot:
plot(x$pp, sort(x$rad.n), pch = 1, ylim = c(0, max(x$rad.n, x$rad.sn)),
xlab = "Chi-square Percentiles",
ylab = "Mahalanobis Distances")
abline(0, 1, lty = 3)
title(main = "Normal QQ-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvst.plot.3 <-
function(x)
{
# Plot:
plot(x$pp, sort(x$rad.sn), pch = 1, ylim = c(0, max(x$rad.n, x$rad.sn)),
xlab = "Percentiles of chi-square distribution",
ylab = "Mahalanobis distances")
abline(0, 1, lty = 3)
title(main = "Skew-Normal QQ-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvst.plot.4 <-
function(x)
{
# Plot:
plot((1:x$n)/(x$n + 1), sort(pchisq(x$rad.n, x$k)),
xlab = "", ylab = "")
abline(0, 1, lty = 3)
title(main = "Normal PP-Plot", sub = x$y.name)
}
# ------------------------------------------------------------------------------
.mvst.plot.5 <-
function(x)
{
# Plot:
plot((1:x$n)/(x$n + 1), sort(pchisq(x$rad.sn, x$k)),
xlab = "", ylab = "")
abline(0, 1, lty = 3)
title(main = "Skew-Normal PP-Plot", sub = x$y.name)
}
################################################################################
fMultivar/R/elliptical2d.R 0000644 0001751 0000144 00000023261 11370220757 015145 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: ELLIPTICAL BIVARIATE DISTRIBUTIONS:
# delliptical2d Computes density for elliptical distributions
# .gfunc2d Generator Function for elliptical distributions
# .delliptical2dSlider Slider for bivariate densities
################################################################################
delliptical2d =
function(x, y = x, rho = 0, param = NULL, type = c("norm", "cauchy", "t",
"logistic", "laplace", "kotz", "epower"), output = c("vector", "list"))
{ # A function implemented by Diethelm Wuertz
# Description:
# Density function for bivariate elliptical distributions
# Arguments:
# x, y - two numeric vectors of the same length.
# rho - a anumeric value specifying the correlation.
# param - NULL, a numeric value, or a numeric vector adding
# additional parameters to the generator function.
# type - a character string denoting the type of distribution.
# This may be either
# "norm" for the normal distribution, or
# "cauchy" for the Cauchy distribution, or
# "t" for the Student-t distribution, or
# "logistic" for the logistic distribution, or
# "laplace" for the distribution, or
# "kotz" for the original Kotz distribution, or
# "epower" for the exponential power distribution
# FUNCTION:
# Type:
type = type[1]
# Settings:
if (is.list(x)) {
y = x$y
x = x$x
}
if (is.matrix(x)) {
y = x[, 2]
x = x[, 2]
}
# Add Default Parameters:
if (is.null(param)) {
if (type == "t") param = c(nu = 4)
if (type == "kotz") param = c(r = sqrt(2))
if (type == "epower") param = c(r = sqrt(2), s = 1/2)
}
# Density:
xoy = ( x^2 - 2*rho*x*y + y^2 ) / (1-rho^2)
lambda = .gfunc2d(param = param, type = type)[[1]]
density = lambda * .gfunc2d(x = xoy, param = param, type = type) /
sqrt(1 - rho^2)
# Add attributes:
if (is.null(param)) {
attr(density, "control") = unlist(list(type = type, rho = rho))
} else {
attr(density, "control") = unlist(list(type = type, rho = rho,
param = param))
}
# As List ?
if (output[1] == "list") {
N = sqrt(length(x))
x = x[1:N]
y = matrix(y, ncol = N)[1, ]
density = list(x = x, y = y, z = matrix(density, ncol = N))
}
# Return Value:
density
}
# ------------------------------------------------------------------------------
.gfunc2d =
function(x, param = NULL, type = c("norm", "cauchy", "t", "logistic",
"laplace", "kotz", "epower"))
{ # A function implemented by Diethelm Wuertz
# Description:
# Generator function for elliptical distributions
# Note:
# A copy from fExtremes 'gfunc'
# Arguments:
# x - a numeric vector
# param - NULL, a numeric value, or a numeric vector adding.
# additional parameters to the generator function.
# type - a character string denoting the type of distribution.
# This may be either
# "norm" for the normal distribution, or
# "cauchy" for the Cauchy distribution, or
# "t" for the Student-t distribution, or
# "logistic" for the logistic distribution, or
# "laplace" for the distribution, or
# "kotz" for the original Kotz distribution, or
# "epower" for the exponential power distribution
# Value:
# Returns a numeric vector "g(x)" for the generator computed at
# the x values taken from the input vector. If x is missing,
# the normalizing constant "lambda" will be returned.
# FUNCTION:
# Handle Missing x:
if (missing(x)) {
x = NA
output = "lambda"
} else {
output = "g"
}
# Get Type:
type = type[1]
# Get Parameters:
# if (is.null(param)) param = .ellipticalParam$param
# Create Generator:
if (type == "norm") {
g = exp(-x/2)
lambda = 1 / (2*pi)
param = NULL
}
if (type == "cauchy") {
g = ( 1 + x )^ (-3/2 )
lambda = 1 / (2*pi)
param = NULL
}
if (type == "t") {
if (is.null(param)) {
nu = 4
} else {
nu = param[[1]]
}
g = ( 1 + x/nu )^ ( -(nu+2)/2 )
lambda = 1/(2*pi)
param = c(nu = nu)
}
if (type == "logistic"){
g = exp(-x/2)/(1+exp(-x/2))^2
# lambda:
# integrate(function(x) { exp(-x)/(1+exp(-x))^2}, 0, Inf,
# subdivision = 10000, rel.tol = .Machine$double.eps^0.8)
# 0.5 with absolute error < 2.0e-13
lambda = 1 / pi
param = NULL
}
if (type == "laplace") { # or "double exponential"
# epower:
r = sqrt(2)
s = 1/2
g = exp(-r*(x/2)^s)
lambda = s * r^(1/s) / ( 2 * pi * gamma(1/s) )
param = NULL
}
if (type == "kotz") {
# epower: s = 1
if (is.null(param)) {
r = sqrt(2)
} else {
r = param
}
g = exp(-r*(x/2))
lambda = r/(2*pi)
param = c(r = r)
}
if (type == "epower") {
if (is.null(param)) {
r = sqrt(2)
s = 1/2
} else {
r = param[[1]]
s = param[[2]]
}
g = exp(-r*(x/2)^s)
lambda = s * r^(1/s) / ( 2 * pi * gamma(1/s) )
param = c(r = r, s = s)
}
# Output:
output = output[1]
if (output == "g") {
ans = g
} else if (output == "lambda") {
ans = lambda
}
# Add Control:
if (output == "g") {
attr(ans, "control") = c(type = type, lambda = as.character(lambda))
} else if (output == "lambda") {
if (is.null(param)) {
attr(ans, "control") = unlist(list(type = type))
} else {
attr(ans, "control") = unlist(list(type = type, param = param))
}
}
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.delliptical2dSlider =
function(B = 10, eps = 1.e-3)
{ # A function implemented by Diethelm Wuertz
# Description:
# Displays interactively perspective plots of density
#FUNCTION:
# Graphic Frame:
par(mfrow = c(1, 1), cex = 0.7)
# Internal Function:
refresh.code = function(...)
{
# Sliders:
Distribution = .sliderMenu(no = 1)
N = .sliderMenu(no = 2)
rho = .sliderMenu(no = 3)
nu = .sliderMenu(no = 4)
r = .sliderMenu(no = 5)
s = .sliderMenu(no = 6)
nlev = .sliderMenu(no = 7)
ncol = .sliderMenu(no = 8)
if (rho == +1) rho = rho - eps
if (rho == -1) rho = rho + eps
# Title:
Names = c("- Normal", "- Cauchy", "- Student t", "- Logistic",
"- Laplace", "- Kotz", "- Exponential Power")
Title = paste("Elliptical Density No:", as.character(Distribution),
Names[Distribution], "\nrho = ", as.character(rho))
if (Distribution == 3) Title = paste(Title, "nu =", as.character(nu))
if (Distribution >= 6) Title = paste(Title, "r =", as.character(r))
if (Distribution >= 7) Title = paste(Title, "s =", as.character(s))
# Plot:
xy= grid2d(x = seq(-5, 5, length = N))
Type = c("norm", "cauchy", "t", "logistic", "laplace", "kotz", "epower")
param = NULL
if (Distribution == 3) param = nu
if (Distribution == 6) param = r
if (Distribution == 7) param = c(r, s)
D = delliptical2d(x = xy, rho = rho, param = param,
type = Type[Distribution], output = "list")
image(D, col = heat.colors(ncol), xlab = "x", ylab = "y" )
contour(D, nlevels = nlev, add = TRUE)
title(main = Title)
# Reset Frame:
par(mfrow = c(1, 1), cex = 0.7)
}
# Open Slider Menu:
plot.names = c("Plot - levels", "... colors")
.sliderMenu(refresh.code,
names = c("Distribution", "N", "rho", "t: nu", "r", "s", plot.names),
minima = c( 1, 10, -1, 1, 0, 0, 10, 12),
maxima = c( 7, 100, +1, B, B, B, 100, 256),
resolutions = c( 1, 10, 0.1, 0.1, 0.1, 0.1, 10, 1),
starts = c( 1, 10, 0, 4, 1, 1, 10, 12))
}
################################################################################
fMultivar/R/density2d.R 0000644 0001751 0000144 00000017477 11370220757 014516 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# grid2d Returns from two vectors x-y grid coordinates
# density2d Returns 2D Kernel Density Estimates
# hist2d Returns 2D Histogram Counts
# integrate2d Integrates over a two dimensional unit square
################################################################################
grid2d =
function(x = (0:10)/10, y = x)
{ # A function implemented by Diethelm Wuertz
# Description:
# Creates from two vectors x-y grid coordinates
# Arguments:
# x, y - two numeric vectors defining the x and y coordinates.
# Value:
# returns a list with two vectors named $x and $y spanning the
# grid defined by the coordinates x and y.
# Example:
# > grid2d(1:3, 1:2)
# $x
# [1] 1 2 3 1 2 3
# $y
# [1] 1 1 1 2 2 2
# FUNCTION:
# Prepare for Input:
nx = length(x)
ny = length(y)
xoy = cbind(rep(x, ny), as.vector(matrix(y, nx, ny, byrow = TRUE)))
XY = matrix(xoy, nx * ny, 2, byrow = FALSE)
# Return Value:
list(x = XY[, 1], y = XY[, 2])
}
# ------------------------------------------------------------------------------
density2d =
function (x, y = NULL, n = 20, h = NULL, limits = c(range(x), range(y)))
{ # A function implemented by Diethelm Wuertz
# Description:
# Returns 2D Kernel Density Estimates
# Arguments:
# x, y - two vectors of coordinates of data. If y is NULL then x
# is assumed to be a two column matrix, where the first column
# contains the x data, and the second column the y data.
# n - Number of grid points in each direction.
# h - a vector of bandwidths for x and y directions. Defaults to
# normal reference bandwidth.
# limits - the limits of the rectangle covered by the grid.
# Value:
# A list with three elements x, y, and z. x and y are vectors
# spanning the two dimensioanl grid and z the corresponding
# matrix. The output can directly serve as input to the
# plotting functions image, contour and persp.
# Details:
# Two-dimensional kernel density estimation with an axis-aligned
# bivariate normal kernel, evaluated on a square grid.
# Note:
# Partly copied from R Package MASS, function 'kde2d'.
# Reference:
# Venables, W.N., Ripley, B. D. (2002);
# Modern Applied Statistics with S.
# Fourth edition, Springer.
# FUNCTION:
# Settings:
lims = limits
if (is.null(y)) {
y = x[, 2]
x = x[, 1]
}
# Bandwidth:
.bandwidth.nrd = function (x) {
r = quantile(x, c(0.25, 0.75))
h = (r[2] - r[1])/1.34
4 * 1.06 * min(sqrt(var(x)), h) * length(x)^(-1/5) }
# Kernel Density Estimator:
nx = length(x)
if (length(y) != nx) stop("Data vectors must be the same length")
gx = seq(lims[1], lims[2], length = n)
gy = seq(lims[3], lims[4], length = n)
if (is.null(h)) h = c(.bandwidth.nrd(x), .bandwidth.nrd(y))
h = h/4
ax = outer(gx, x, "-")/h[1]
ay = outer(gy, y, "-")/h[2]
z = matrix(dnorm(ax), n, nx) %*% t(matrix(dnorm(ay), n,
nx))/(nx * h[1] * h[2])
# Return Value:
list(x = gx, y = gy, z = z)
}
# ------------------------------------------------------------------------------
hist2d =
function(x, y = NULL, n = c(20, 20))
{ # A function implemented by Diethelm Wuertz
# Description:
# Returns 2D Histogram Counts
# Arguments:
# x, y - two vectors of coordinates of data. If y is NULL then x
# is assumed to be a two column matrix, where the first column
# contains the x data, and the second column the y data.
# n - number of bins in each dimension, may be a scalar or a 2
# element vector. The default value is 20.
# Value:
# A list with three elements x, y, and z. x and y are vectors
# spanning the two dimensioanl grid and z the corresponding
# matrix. The output can directly serve as input to the
# plotting functions image, contour and persp.
# Note:
# Partly copied from R Package gregmisc, function 'hist2d'.
# FUNCTION:
# 2D Histogram Counts:
if (is.null(y)) {
y = x[, 2]
x = x[, 1]
}
if (length(n) == 1) {
nbins = c(n, n)
} else {
nbins = n
}
nas = is.na(x) | is.na(y)
x.cuts = seq(from = min(x, y), to = max(x,y), length = nbins[1]+1)
y.cuts = seq(from = min(x, y), to = max(x,y), length = nbins[2]+1)
index.x = cut(x, x.cuts, include.lowest = TRUE)
index.y = cut(y, y.cuts, include.lowest = TRUE)
m = matrix(0, nrow=nbins[1], ncol = nbins[2],
dimnames = list( levels(index.x), levels(index.y) ) )
for ( i in 1:length(index.x) ) {
m[index.x[i], index.y[i] ] = m[index.x[i], index.y[i] ] + 1
}
xvals = x.cuts[1:nbins[1]]
yvals = y.cuts[1:nbins[2]]
# Return Value:
list(x = xvals, y = yvals, z = m)
}
# ------------------------------------------------------------------------------
integrate2d = function(fun, error = 1.0e-5, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# 2-dimension quadrature rule on [0,1]^2
# Arguments:
# fun - function to be integrated. The first argument requests
# the x values, the second the y values, and the remaining
# are reserved for additional parameters.
# ... - parameters passed to the function to be integrated
# Details:
# see: Abramowitz and Stegun, p. 892
# FUNCTION:
# Estimate a reasonable number of subintervals:
H = sqrt(sqrt(error))
n = ceiling(1/H + 1)
blocks = ceiling(log(n+1)/log(2))
n = 2^blocks-1
h = 1/(n-1)
# The error will be of order h^4:
error = h^4
# Create all grid coordinates:
x = y = h*seq(1, n-1, by = 2)
nx = ny = length(x)
xoy = cbind(rep(x, ny), as.vector(matrix(y, nx, ny, byrow = TRUE)))
XY = matrix(xoy, nx * ny, 2, byrow = FALSE)
# The integration rule:
rule = function(x, h, ...) {
X = x[1] + h*c( 0, -1, -1, 1, 1, -1, 1, 0, 0)
Y = x[2] + h*c( 0, -1, 1, -1, 1, 0, 0, -1, 1)
W = c( 16, 1, 1, 1, 1, 4, 4, 4, 4)/36
ans = sum( W * fun(X, Y, ...) )
}
# Result:
ans = (4*h^2)*sum(apply(XY, 1, rule, h = h, ...))
# Return Value:
list(value = ans, error = error, points = n)
}
################################################################################
fMultivar/R/cauchy2d.R 0000644 0001751 0000144 00000006754 11717226247 014314 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BIVARIATE CAUCHY DISTRIBUTION:
# pcauchy2d Computes bivariate Cauchy probability function
# dcauchy2d Computes bivariate Cauchy density function
# rcauchy2d Generates bivariate Cauchy random deviates
################################################################################
pcauchy2d =
function(x, y = x, rho = 0)
{ # A function Implemented by Diethelm Wuertz
# Description:
# Computes bivariate Cauchy probability function
# Arguments:
# x, y - two numeric values or vectors of the same length at
# which the probability will be computed.
# Example:
# pt2d(rnorm(5), rnorm(5), 0.5, 5)
# Value:
# returns a numeric vector of probabilities of the same length
# as the input vectors
# FUNCTION:
# Settings:
# Probaility:
ans = pt2d(x = x, y = y, rho = rho, nu = 1)
attr(ans, "control") = c(rho = rho)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
dcauchy2d =
function(x, y = x, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# Description:
# Computes bivariate Cauchy density function
# Note:
# Partly copied from contributed R package 'sn'
# FUNCTION:
# Density:
density = dt2d(x = x, y = y, rho = rho, nu = 1)
attr(density, "control") = c(rho = rho)
# Return value:
density
}
# ------------------------------------------------------------------------------
rcauchy2d =
function(n, rho = 0)
{ # A function implemented by Diethelm Wuertz
# Description:
# Generates bivariate Cauchy random deviates
# Arguments:
# n - number of random deviates to be generated
# rho - the linear correlation, a numeric value between
# minus one and one.
# Note:
# Partly copied from contributed R package 'mvtnorm'
# Author Friedrich Leisch
# FUNCTION:
# Random Deviates:
ans = rt2d(n = n, rho = rho, nu = 1)
attr(ans, "control") = c(rho = rho)
# Return Value:
ans
}
################################################################################
fMultivar/R/BivariateGridding.R 0000644 0001751 0000144 00000007743 11370220757 016162 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received A copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
# fEcofin::4A-BivariateGridding.R
################################################################################
# FUNCTION: GRID DATA:
# gridData Generates grid data set
# persp.gridData Generates perspective plot from a grid data object
# contour.gridData Generates contour plot from a grid data object
################################################################################
################################################################################
# FUNCTION: GRID DATA:
# gridData Generates grid data set
# persp.gridData Generates perspective plot from a grid data object
# contour.gridData Generates contour plot from a grid data object
gridData =
function(x = (-10:10)/10, y = x, z = outer(x, y, function(x, y) (x^2+y^2)) )
{ # A function implemented by Diethelm Wuertz
# Description:
# Generates a grid data set
# Arguments:
# x, y - two numeric vectors of grid pounts
# z - a numeric matrix or any other rectangular object which can
# be transformed by the function 'as.matrix' into a matrix
# object.
# Example:
# persp(as.gridData())
# FUNCTION:
# Grid Data:
data = list(x = x, y = y, z = as.matrix(z))
class(data) = "gridData"
# Return Value:
data
}
# ------------------------------------------------------------------------------
persp.gridData =
function(x, theta = -40, phi = 30, col = "steelblue", ticktype = "detailed",
...)
{ # A function implemented by Diethelm Wuertz
# Description:
# S3 method to generate a perspective plot from a grid data object
# Example:
# x = y = seq(-10, 10, length = 30)
# z = outer(x, y, function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r })
# data = list(x = x, y = y, z = z)
# class(data) = "gridData"
# persp(data)
# FUNCTION:
# Grid Data:
class(x) = "default"
persp(x, theta = theta, phi = phi, col = col, ticktype = ticktype, ...)
# Return Value:
invisible(NULL)
}
# ------------------------------------------------------------------------------
contour.gridData =
function(x, addImage = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# S3 method to generate a contour plot from a grid data object
# Example:
# x = y = seq(-10, 10, length = 30)
# z = outer(x, y, function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r })
# data = list(x = x, y = y, z = z)
# class(data) = "gridData"
# contour(data)
# FUNCTION:
# Grid Data:
class(x) = "default"
if (addImage) image(x, ...)
contour(x, add = addImage, ...)
box()
# Return Value:
invisible(NULL)
}
################################################################################
fMultivar/R/BivariateBinning.R 0000644 0001751 0000144 00000024433 11370220757 016012 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received A copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# squareBinning Square binning of irregularly spaced points
# plot S3 Method for plotting square binned points
# FUNCTION: DESCRIPTION:
# hexBinning Hexagonal binning of irregularly spaced points
# plot S3 Method for plotting hexagonal binned points
################################################################################
################################################################################
# FUNCTION: DESCRIPTION:
# squareBinning Square binning of irregularly spaced points
# plot S3 Method for plotting square binned points
squareBinning =
function(x, y = NULL, bins = 30)
{ # A function implemented by Diethelm Wuertz
# Description:
# Returns 2D Histogram Counts
# Arguments:
# x, y - two vectors of coordinates of data. If y is NULL then x
# is assumed to be a two column matrix, where the first column
# contains the x data, and the second column the y data.
# 'timeSeries' objects are also allowed as input.
# bins - number of bins in each dimension, may be a scalar or a 2
# element vector. The default value is 20.
# Value:
# A list with three elements x, y, and z. x and y are vectors
# spanning the two dimensioanl grid and z the corresponding
# matrix. The output can directly serve as input to the
# plotting functions image, contour and persp.
# Example:
# sB = squareBinning(x = rnorm(1000), y = rnorm(1000)); plot(sB)
# Note:
# Partly copied from R Package gregmisc, function 'hist2d'.
# FUNCTION:
# 2D Histogram Counts:
if (is.null(y)) {
x = as.matrix(x)
y = x[, 2]
x = x[, 1]
} else {
x = as.vector(x)
y = as.vector(y)
}
data = cbind(x, y)
# Bins:
n = bins
if (length(n) == 1) {
nbins = c(n, n)
} else {
nbins = n
}
# Binning:
xo = seq(min(x), max(x), length = nbins[1])
yo = seq(min(y), max(y), length = nbins[2])
xvals = xo[-1] - diff(xo)/2
yvals = yo[-1] - diff(yo)/2
ix = findInterval(x, xo)
iy = findInterval(y, yo)
xcm = ycm = zvals = matrix(0, nrow = nbins[1], ncol = nbins[2])
for (i in 1:length(x)) {
zvals[ix[i], iy[i]] = zvals[ix[i], iy[i]] + 1
xcm[ix[i], iy[i]] = xcm[ix[i], iy[i]] + x[i]
ycm[ix[i], iy[i]] = ycm[ix[i], iy[i]] + y[i]
}
# Reduce to non-empty cells:
u = v = w = ucm = vcm = rep(0, times = nbins[1]*nbins[2])
L = 0
for (i in 1:(nbins[1]-1)) {
for (j in 1:(nbins[2]-1)) {
if (zvals[i, j] > 0) {
L = L + 1
u[L] = xvals[i]
v[L] = yvals[j]
w[L] = zvals[i, j]
ucm[L] = xcm[i, j]/w[L]
vcm[L] = ycm[i, j]/w[L]
}
}
}
length(u) = length(v) = length(w) = L
length(ucm) = length(vcm) = L
ans = list(x = u, y = v, z = w, xcm = ucm, ycm = vcm, bins = bins,
data = data)
class(ans) = "squareBinning"
# Return Value:
ans
}
# ------------------------------------------------------------------------------
plot.squareBinning =
function(x, col = heat.colors(12), addPoints = TRUE, addRug = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Plot square binned data points
# FUNCTION:
# Binning:
X = x$x
Y = x$y
# Plot Center Points:
plot(X, Y, type = "n", ...)
# Create Hexagon Coordinates:
rx = min(diff(unique(sort(X))))/2
ry = min(diff(unique(sort(Y))))/2
u = c(-rx, rx, rx, -rx)
v = c( ry, ry, -ry, -ry)
# Create Color Palette:
N = length(col)
Z = x$z
zMin = min(Z)
zMax = max(Z)
Z = (Z - zMin)/(zMax - zMin)
Z = trunc(Z*(N-1)+1)
# Add Colored Hexagon Polygons:
for (i in 1:length(X)) {
polygon(u+X[i], v+Y[i], col = col[Z[i]], border = "white")
}
# Add Center of Mass Points:
if (addPoints) {
points(x$xcm, x$ycm, pch = 19, cex = 1/3, col = "black")
}
# Add rug:
if (addRug) {
rug(x$data[, 1], ticksize = 0.01, side = 3)
rug(x$data[, 2], ticksize = 0.01, side = 4)
}
# Return Value:
invisible(NULL)
}
################################################################################
# FUNCTION: DESCRIPTION:
# hexBinning Hexagonal binning of irregularly spaced points
# plot S3 Method for plotting hexagonal binned points
hexBinning =
function(x, y = NULL, bins = 30)
{ # A function implemented by Diethelm Wuertz
# Description:
# Does a hexagonal binning of data points
# Arguments:
# x, y - two vectors of coordinates of data. If y is NULL then x
# is assumed to be a two column matrix, where the first column
# contains the x data, and the second column the y data.
# 'timeSeries' objects are also allowed as input.
# bins - number of bins in each dimension, may be a scalar or a 2
# element vector. The default value is 20.
# Example:
# hB = hexBinning(x = rnorm(10000), y = rnorm(10000)); plot(hB)
# FUNCTION:
# Extract Series:
if (is.null(y)) {
x = as.matrix(x)
y = x[, 2]
x = x[, 1]
} else {
x = as.vector(x)
y = as.vector(y)
}
data = cbind(x, y)
# Set Parameters:
shape = 1
n = length(x)
xbnds = range(x)
ybnds = range(y)
jmax = floor(bins + 1.5001)
c1 = 2 * floor((bins *shape)/sqrt(3) + 1.5001)
imax = trunc((jmax*c1 -1)/jmax + 1)
lmax = jmax * imax
cell = cnt = xcm = ycm = rep(0, times = max(n, lmax))
xmin = xbnds[1]
ymin = ybnds[1]
xr = xbnds[2] - xmin
yr = ybnds[2] - ymin
c1 = bins/xr
c2 = bins*shape/(yr*sqrt(3.0))
jinc = jmax
lat = jinc + 1
iinc = 2*jinc
con1 = 0.25
con2 = 1.0/3.0
# Count Bins:
for ( i in 1:n ) {
sx = c1 * (x[i] - xmin)
sy = c2 * (y[i] - ymin)
j1 = floor(sx + 0.5)
i1 = floor(sy + 0.5)
dist1 = (sx-j1)^2 + 3.0*(sy-i1)^2
if( dist1 < con1) {
L = i1*iinc + j1 + 1
} else if (dist1 > con2) {
L = floor(sy)*iinc + floor(sx) + lat
} else {
j2 = floor(sx)
i2 = floor(sy)
test = (sx-j2 -0.5)^2 + 3.0*(sy-i2-0.5)^2
if ( dist1 <= test ) {
L = i1*iinc + j1 + 1
} else {
L = i2*iinc + j2 + lat
}
}
cnt[L] = cnt[L]+1
xcm[L] = xcm[L] + (x[i] - xcm[L])/cnt[L]
ycm[L] = ycm[L] + (y[i] - ycm[L])/cnt[L]
}
# Reduce to Non-Empty Cells:
nc = 0
for ( L in 1:lmax ) {
if(cnt[L] > 0) {
nc = nc + 1
cell[nc] = L
cnt[nc] = cnt[L]
xcm[nc] = xcm[L]
ycm[nc] = ycm[L]
}
}
bnd = c(imax, jmax)
bnd[1] = (cell[nc]-1)/bnd[2] + 1
length(cell) = nc
length(cnt) = nc
length(xcm) = nc
length(ycm) = nc
if(sum(cnt) != n) warning("Lost counts in binning")
# Compute Positions:
c3 = diff(xbnds)/bins
ybnds = ybnds
c4 = (diff(ybnds) * sqrt(3))/(2 * shape * bins)
cell = cell - 1
i = cell %/% jmax
j = cell %% jmax
y = c4 * i + ybnds[1]
x = c3 * ifelse(i %% 2 == 0, j, j + 0.5) + xbnds[1]
# Result:
ans = list(x = x, y = y, z = cnt, xcm = xcm, ycm = ycm, bins = bins,
data = data)
class(ans) = "hexBinning"
# Return Value:
ans
}
# ------------------------------------------------------------------------------
plot.hexBinning =
function(x, col = heat.colors(12), addPoints = TRUE, addRug = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Plot hexagonal binned data points
# Example:
# hexPlot(rnorm(1000), rnorm(1000), bins = 20)
# FUNCTION:
# Binning:
X = x$x
Y = x$y
# Plot Center Points:
plot(X, Y, type = "n", ...)
# Create Hexagon Coordinates:
rx = min(diff(unique(sort(X))))
ry = min(diff(unique(sort(Y))))
rt = 2*ry
u = c(rx, 0, -rx, -rx, 0, rx)
v = c(ry, rt, ry, -ry, -rt, -ry) / 3
# Create Color Palette:
N = length(col)
z = x$z
zMin = min(z)
zMax = max(z)
Z = (z - zMin)/(zMax - zMin)
Z = trunc(Z*(N-1)+1)
# Add Colored Hexagon Polygons:
for (i in 1:length(X)) {
polygon(u+X[i], v+Y[i], col = col[Z[i]], border = "white")
}
# Add Center of Mass Points:
if (addPoints) {
points(x$xcm, x$ycm, pch = 19, cex = 1/3, col = "black")
}
# Add rug:
if (addRug) {
rug(x$data[, 1], ticksize = 0.01, side = 3)
rug(x$data[, 2], ticksize = 0.01, side = 4)
}
# Return Value:
invisible(NULL)
}
################################################################################
fMultivar/NAMESPACE 0000644 0001751 0000144 00000003743 12046426034 013470 0 ustar hornik users
################################################
## import name space
################################################
import("methods")
import("sn")
import("timeDate")
import("timeSeries")
import("fBasics")
################################################
## S4 classes
################################################
exportClasses("fMV" )
exportMethods("$",
"$<-",
"+",
"-",
"[",
"[<-",
"cummax",
"cummin",
"cumprod",
"cumsum",
"dim",
"dim<-",
"dimnames",
"dimnames<-",
"is.na",
"names",
"names<-",
"show" )
################################################
## S3 classes
################################################
S3method("plot", "fMV")
S3method("plot", "hexBinning")
S3method("plot", "squareBinning")
S3method("summary", "fMV")
################################################
## functions
################################################
export(
".TInt",
".TOwen",
".delliptical2dSlider",
".dnorm2d",
".gfunc2d",
".mvsnorm.plot.1",
".mvsnorm.plot.1A",
".mvsnorm.plot.1B",
".mvsnorm.plot.2",
".mvsnorm.plot.3",
".mvsnorm.plot.4",
".mvsnorm.plot.5",
".mvsnormFit",
".mvsnormPlot",
".mvst.plot.1",
".mvst.plot.1A",
".mvst.plot.1B",
".mvst.plot.2",
".mvst.plot.3",
".mvst.plot.4",
".mvst.plot.5",
".mvstFit",
".mvstPlot",
".pnorm2d",
".rnorm2d",
"contour.gridData",
"dcauchy2d",
"delliptical2d",
"density2d",
"dmvsnorm",
"dmvst",
"dnorm2d",
"dt2d",
"grid2d",
"gridData",
"hexBinning",
"hist2d",
"integrate2d",
"mvFit",
"pcauchy2d",
"persp.gridData",
"pmvsnorm",
"pmvst",
"pnorm2d",
"pt2d",
"rcauchy2d",
"rmvsnorm",
"rmvst",
"rnorm2d",
"rt2d",
"squareBinning" )
fMultivar/man/ 0000755 0001751 0000144 00000000000 11720123747 013020 5 ustar hornik users fMultivar/man/t2d.Rd 0000644 0001751 0000144 00000003574 11370220757 014011 0 ustar hornik users \name{t2d}
\alias{t2d}
\alias{pt2d}
\alias{dt2d}
\alias{rt2d}
\title{Bivariate Student-t Distribution}
\description{
Density, distribution function, and random
generation for the bivariate Student-t
distribution.
}
\usage{
pt2d(x, y = x, rho = 0, nu = 4)
dt2d(x, y = x, rho = 0, nu = 4)
rt2d(n, rho = 0, nu = 4)
}
\arguments{
\item{n}{
the number of random deviates to be generated, an integer value.
}
\item{nu}{
the number of degrees of freedom, a numeric value ranging between
two and infinity, by default four.
}
\item{rho}{
the correlation parameter, a numeric value ranging between
minus one and one, by default zero.
}
\item{x, y}{
two numeric vectors defining the x and y coordinates.
}
}
\value{
\code{pt2d}
\cr
returns a two column matrix of probabilities for the bivariate
Student-t distribution function.\cr
\code{dt2d}
\cr
returns a two column matrix of densities for the bivariate
Student-t distribution function.\cr
\code{rt2d}
\cr
returns a two column matrix of random deviates generated from
the bivariate Student-t distribution function.
}
\references{
Azzalini A., (2004);
\emph{The sn Package};
R Reference Guide available from www.r-project.org.
Venables W.N., Ripley B.D., (2002);
\emph{Modern Applied Statistics with S},
Fourth Edition, Springer.
}
\author{
Adelchi Azzalini for the underlying pnorm2d function, \cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## Bivariate Student-t Density:
x = (-40:40)/10
X = grid2d(x)
z = dt2d(X$x, X$y, rho = 0.5, nu =6)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
persp(Z, theta = -40, phi = 30, col = "steelblue")
}
\keyword{math}
fMultivar/man/norm2d.Rd 0000644 0001751 0000144 00000003333 11370220757 014512 0 ustar hornik users \name{norm2d}
\alias{norm2d}
\alias{pnorm2d}
\alias{dnorm2d}
\alias{rnorm2d}
\title{Bivariate Normal Distribution}
\description{
Density, distribution function, and random
generation for the bivariate normal
distribution.
}
\usage{
pnorm2d(x, y = x, rho = 0)
dnorm2d(x, y = x, rho = 0)
rnorm2d(n, rho = 0)
}
\arguments{
\item{n}{
the number of random deviates to be generated, an integer value.
}
\item{rho}{
the correlation parameter, a numeric value ranging between
minus one and one, by default zero.
}
\item{x, y}{
two numeric vectors defining the x and y coordinates.
}
}
\value{
\code{pnorm2d}
\cr
returns a two column matrix of probabilities for the bivariate
normal distribution function.\cr
\code{dnorm2d}
\cr
returns a two column matrix of densities for the bivariate
normal distribution function.\cr
\code{rnorm2d}
\cr
returns a two column matrix of random deviates generated from
the bivariate normal distribution function.
}
\references{
Azzalini A., (2004);
\emph{The sn Package};
R Reference Guide available from www.r-project.org.
Venables W.N., Ripley B.D., (2002);
\emph{Modern Applied Statistics with S},
Fourth Edition, Springer.
}
\author{
Adelchi Azzalini for the underlying pnorm2d function, \cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## Bivariate Normal Density:
x = (-40:40)/10
X = grid2d(x)
z = dnorm2d(X$x, X$y, rho = 0.5)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
persp(Z, theta = -40, phi = 30, col = "steelblue")
}
\keyword{math}
fMultivar/man/MultivariateDistributions.Rd 0000644 0001751 0000144 00000033323 11370220757 020544 0 ustar hornik users \name{MultivariateDistribution}
\alias{MultivariateDistribution}
\alias{show,fMV-method}
\alias{fMV}
\alias{fMV-class}
\alias{dmvsnorm}
\alias{pmvsnorm}
\alias{rmvsnorm}
\alias{dmvst}
\alias{pmvst}
\alias{rmvst}
\alias{mvFit}
\alias{print.fMV}
\alias{plot.fMV}
\alias{summary.fMV}
\title{Multivariate Skew Normal and Student-t Distributions}
\description{
A collection and description of functions to compute
multivariate densities and probabilities from skew
normal and skew Student-t distribution functions.
Furthermore, multivariate random daviates can be
generated, and for multivariate data, the parameters
of the underlying distribution can be estimated
by the maximum log-likelihood estimation.
\cr
The functions are:
\tabular{ll}{
\code{dmvsnorm} \tab Multivariate Skew Normal Density, \cr
\code{pmvsnorm} \tab Multivariate Skew Normal Probability, \cr
\code{rmvsnorm} \tab Random Deviates from MV Skew Normal Distribution, \cr
\code{dmvst} \tab Multivariate Skew Student Density, \cr
\code{pmvst} \tab Multivariate Skew Student Probability, \cr
\code{rmvst} \tab Random Deviates from MV Skew Student Distribution, \cr
\code{mvFit} \tab Fits a MV Skew Normal or Student-t Distribution, \cr
\code{print} \tab S3 print method for an object of class 'fMV', \cr
\code{plot} \tab S3 Plot method for an object of class 'fMV', \cr
\code{summary} \tab S3 summary method for an object of class 'fMV'. }
These functions are useful for portfolio selection and optimization
if one likes to model the data by multivariate normal, skew normal,
or skew Student-t distribution functions.
}
\usage{
dmvsnorm(x, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim))
pmvsnorm(q, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim))
rmvsnorm(n, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim))
dmvst(x, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim), df = 4)
pmvst(q, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim), df = 4)
rmvst(n, dim = 2, mu = rep(0, dim), Omega = diag(dim), alpha = rep(0, dim), df = 4)
mvFit(x, method = c("snorm", "st"), fixed.df = NA, title = NULL,
description = NULL, trace = FALSE, \dots)
\S4method{show}{fMV}(object)
\method{plot}{fMV}(x, which = "ask", \dots)
\method{summary}{fMV}(object, which = "ask", doplot = TRUE, \dots)
}
\arguments{
\item{description}{
[mvFit] - \cr
a character string, assigning a brief description to an
\code{"fMV"} object.
}
\item{doplot}{
a logical value, by default TRUE. Should a plot be generated
and displayed?
}
\item{dim}{
[*mvsnorm][*mvst] - \cr
the colum dimension of the matrix \code{x}. If \code{x} is
specified as a vector, \code{dim=1} must be set to one.
}
\item{fixed.df}{
either \code{NA}, the default, or a numeric value assigning the
number of degrees of freedom to the model. In the case that
\code{fixed.df=NA} the value of \code{df} will be included in the
optimization process, otherwise not.
}
\item{method}{
[mvFit] - \cr
a string value specifying the method applied in the optimizing
process. This can be either \code{method="snorm"} or
\code{method="st"}, in the first case the parameters for a
skew normal distribution will be fitted and in the second case
the parameters for a skew Student-t distribution.
}
\item{mu, Omega, alpha, df}{
[*mvsnorm][*mvst] - \cr
the model parameters: \cr
\code{mu} a vector of mean values, one for each column, \cr
\code{Omega} the covariance matrix, \cr
\code{alpha} the skewness vector, and \cr
\code{df} the number of degrees of freedom which is a measure for
the fatness of the tails (excess kurtosis). \cr
For a symmetric distribution \code{alpha} is a vector of zeros.
For the normal distributions \code{df} is not used and set to
infinity, \code{Inf}. Note that all columns assume the same value
for \code{df}.
}
\item{n}{
[rmvsnorm][rmvst] - \cr
number of data records to be simulated, an integer value.
}
\item{object}{
[summary] - \cr
an object of class \code{fMV}.
}
\item{title}{
[mvFit] - \cr
a character string, assigning a title to an \code{"fMV"} object.
}
\item{trace}{
a logical, if set to \code{TRUE} the optimization process will
be traced, otherwise not. The default setting is \code{FALSE}.
}
\item{which}{
which of the five plots should be displayed? \code{which} can
be either a character string, \code{"all"} (displays all plots)
or \code{"ask"} (interactively asks which one to display), or a
vector of 5 logical values, for those elements which are set
\code{TRUE} the correponding plot will be displayed.
}
\item{x, q}{
[*mvsnorm][*mvst][mvFit] - \cr
a numeric matrix of quantiles (returns) or any other rectangular
object like a data.frame or a multivariate time series objects
which can be transformed by the function \code{as.matrix} to an
object of class \code{matrix}. If \code{x} is a vector, it will
be transformed into a matrix object with one column.
\cr
[plot][print] - \cr
An object of class \code{fMV}.
}
\item{\dots}{
optional arguments to be passed to the optimization or plotting
functions.
}
}
\details{
These are "easy-to-use" functions which allow quickly to simulate
multivariate data sets and to fit their parameters assuming a
multivariate skew normal or skew Student-t distribution. The functions
make use of the contributed R packages \code{sn} and \code{mtvnorm}.
For an extended functionality in modelling multivariate skew normal
and Student-t distributions we recommend to download and use the
functions from the original package \code{sn} which requires also the
package \code{mtvnorm}.
The algorithm for the computation of the normal and Student-t
distribution functions is described by Genz (1992) and (1993),
and its implementation by Hothorn, Bretz, and Genz (2001).
The parameter estimation is done by the maximum log-likelihood
estimation. The algorithm and the implemantation was done by
Azzalini (1985-2003).
The multivariate skew-normal distribution is discussed in detail
by Azzalini and Dalla Valle (1996); the \code{(Omega,alpha)}
parametrization adopted here is the one of Azzalini and
Capitanio (1999).
The family of multivariate skew-t distributions is an extension of
the multivariate Student's t family, via the introduction of a
shape parameter which regulates skewness; for a zero shape parameter
the skew Student-t distribution reduces to the usual t distribution.
When \code{df = Inf} the distribution reduces to the multivariate
skew-normal one.
The plot facilities have been completely reimplemented. The S3 plot
method allows for selective batch and interactive plots. The
argument \code{which} takes care for the desired operation.
The contributed R package \code{mvtnorm} is required, the contributed
R package \code{sn} is builtin, since it is not available on the
Debian Software Server.
}
\value{
\code{[dp]mvsnorm} \cr
\code{[dp]mvst}
\cr
return a vector of density and probability values computed from
the matrix \code{x}.
\cr
\code{mvFit}
\cr
returns a S4 object class of class \code{"fASSETS"}, with the following
slots:
\item{@call}{
the matched function call.
}
\item{@data}{
the input data in form of a data.frame.
}
\item{@description}{
allows for a brief project description.
}
\item{@fit}{
the results as a list returned from the underlying
fitting function.
}
\item{@method}{
the selected method to fit the distribution, either
\code{"snorm"}, or \code{"st"}.
}
\item{@model}{
the model parameters describing the fitted parameters in
form of a list, \code{model=list(mu, Omega, alpha, df}.
}
\item{@title}{
a title string.}
The \code{@fit} slot is a list with the following compontents:
(Note, not all are documented here).
\item{@fit$dp}{
a list containing the direct parameters beta, Omega, alpha.
Here, beta is a matrix of regression coefficients with
\code{dim(beta)=c(nrow(X), ncol(y))}, \code{Omega} is a
covariance matrix of order \code{dim}, \code{alpha} is
a vector of shape parameters of length \code{dim}.
}
\item{@fit$se}{
a list containing the components beta, alpha, info. Here,
beta and alpha are the standard errors for the corresponding
point estimates; info is the observed information matrix
for the working parameter, as explained below.
}
\item{@fit$optim}{
the list returned by the optimizer \code{optim}; see the
documentation of this function for explanation of its
components.
}
\code{print}
\cr
is the S3 print method for objects of class \code{"fMV"} returned
from the function \code{mvFit}. If shows a summary report of
the parameter fit.
\code{plot}
\cr
is the S3 plot method for objects of class \code{"fMV"} returned
from the function \code{mvFit}. Five plots are produced.
The first plot produces a scatterplot and in one dimension an
histogram plot with the fitted distribution superimposed.
The second and third plot represent a QQ-plots of Mahalanobis
distances. The first of these refers to the fitting
of a multivariate normal distribution, a standard statistical
procedure; the second gives the corresponding QQ-plot of
suitable Mahalanobis distances for the multivariate skew-normal
fit. The fourth and fivth plots are similar to the previous ones,
except that PP-plots are produced. The plots can be displayed
in several ways, depending an the argument \code{which}, for
details we refer to the arguments list above.
\code{summary}
\cr
is the S3 summary method for objects of class \code{"fMV"} returned
from the function \code{mvFit}. The summary method prints and plots
in one step the results as done by the \code{print} and \code{plot}
methods.
}
\references{
Azzalini A. (1985);
\emph{A Class of Distributions Which Includes the Normal Ones},
Scandinavian Journal of Statistics 12, 171--178.
Azzalini A. (1986);
\emph{Further Results on a Class of Distributions Which Includes
the Normal Ones},
Statistica 46, 199--208.
Azzalini A., Dalla Valle A. (1996);
\emph{The Multivariate Skew-normal Distribution},
Biometrika 83, 715--726.
Azzalini A., Capitanio A. (1999);
\emph{Statistical Applications of the Multivariate Skew-normal
Distribution},
Journal Roy. Statist. Soc. B61, 579--602.
Azzalini A., Capitanio A. (2003);
\emph{Distributions Generated by Perturbation of Symmetry with
Emphasis on a Multivariate Skew-t Distribution},
Journal Roy. Statist. Soc. B65, 367--389.
Genz A., Bretz F. (1999);
\emph{Numerical Computation of Multivariate t-Probabilities
with Application to Power Calculation of Multiple Contrasts},
Journal of Statistical Computation and Simulation 63, 361--378.
Genz A. (1992);
\emph{Numerical Computation of Multivariate Normal Probabilities},
Journal of Computational and Graphical Statistics 1, 141--149.
Genz A. (1993);
\emph{Comparison of Methods for the Computation of Multivariate
Normal Probabilities},
Computing Science and Statistics 25, 400--405.
Hothorn T., Bretz F., Genz A. (2001);
\emph{On Multivariate t and Gauss Probabilities in R},
R News 1/2, 27--29.
}
\author{
Torsten Hothorn for R's \code{mvtnorm} package, \cr
Alan Ganz and Frank Bretz for the underlying Fortran Code, \cr
Adelchi Azzalini for R's \code{sn} package, \cr
Diethelm Wuertz for the Rmetrics port.
}
\examples{
## rmvst -
par(mfcol = c(3, 1), cex = 0.7)
r1 = rmvst(200, dim = 1)
ts.plot(as.ts(r1), xlab = "r", main = "Student-t 1d")
r2 = rmvst(200, dim = 2, Omega = matrix(c(1, 0.5, 0.5, 1), 2))
ts.plot(as.ts(r2), xlab = "r", col = 2:3, main = "Student-t 2d")
r3 = rmvst(200, dim = 3, mu = c(-1, 0, 1), alpha = c(1, -1, 1), df = 5)
ts.plot(as.ts(r3), xlab = "r", col = 2:4, main = "Skew Student-t 3d")
## mvFit -
# Generate Grid Points:
n = 51
x = seq(-3, 3, length = n)
xoy = cbind(rep(x, n), as.vector(matrix(x, n, n, byrow = TRUE)))
X = matrix(xoy, n * n, 2, byrow = FALSE)
head(X)
# The Bivariate Normal Case:
Z = matrix(dmvsnorm(X, dim = 2), length(x))
par (mfrow = c(2, 2), cex = 0.7)
persp(x, x, Z, theta = -40, phi = 30, col = "steelblue")
title(main = "Bivariate Normal Plot")
image(x, x, Z)
title(main = "Bivariate Normal Contours")
contour(x, x, Z, add = TRUE)
# The Bivariate Skew-Student-t Case:
mu = c(-0.1, 0.1)
Omega = matrix(c(1, 0.5, 0.5, 1), 2)
alpha = c(-1, 1)
Z = matrix(dmvst(X, 2, mu, Omega, alpha, df = 3), length(x))
persp(x, x, Z, theta = -40, phi = 30, col = "steelblue")
title(main = "Bivariate Student-t Plot")
image(x, x, Z)
contour(x, x, Z, add = TRUE)
title(main = "Bivariate Student-t Contours")
}
\keyword{distribution}
fMultivar/man/elliptical2d.Rd 0000644 0001751 0000144 00000004755 11370220757 015672 0 ustar hornik users \name{elliptical2d}
\alias{elliptical2d}
\alias{delliptical2d}
\title{Bivariate Elliptical Densities}
\description{
Density function for bivariate elliptical
distributions.
}
\usage{
delliptical2d(x, y = x, rho = 0, param = NULL, type = c("norm", "cauchy", "t",
"logistic", "laplace", "kotz", "epower"), output = c("vector", "list"))
}
\arguments{
\item{output}{
output - a character string specifying how the output should be
formatted. By default a vector of the same length as \code{u}
and \code{v}. If specified as \code{"list"} then \code{u} and
\code{v} are expected to span a two-dimensional grid as outputted
by the function \code{grid2d} and the function returns a list with
elements \code{$x}, \code{y}, and \code{z} which can be directly
used for example by 2D plotting functions.
}
\item{param}{
additional parameters to specify the bivariate density function.
Only effective for the Kotz and Exponential Power distribution.
For the Kotz distribution we can specify a numeric value, by default
defined as \code{param=c(r=sqrt(2))}, and for the Exponential
Power distribution a numeric vector, by default defined as
\code{param=c(r=sqrt(2)),s=1/2}.
}
\item{rho}{
the correlation parameter, a numeric value ranging between
minus one and one, by default zero.
}
\item{type}{
the type of the elliptical copula. A character string selected
from: \code{"norm"}, \code{"cauchy"}, \code{"t"}, \code{"laplace"},
\code{"kotz"}, or \code{"epower"}.
}
\item{x, y}{
two numeric vectors defining the x and y coordinates. \cr
}
}
\value{
\code{delliptical2d}
\cr
returns a two column matrix of densities for the selected bivariate
elliptical distribution function.
}
\references{
Azzalini A., (2004);
\emph{The sn Package};
R Reference Guide available from www.r-project.org.
Venables W.N., Ripley B.D., (2002);
\emph{Modern Applied Statistics with S},
Fourth Edition, Springer.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## Kotz' Elliptical Density:
x = (-40:40)/10
X = grid2d(x)
z = delliptical2d(X$x, X$y, rho = 0.5, type = "kotz")
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
persp(Z, theta = -40, phi = 30, col = "steelblue")
}
\keyword{math}
fMultivar/man/density2.Rd 0000644 0001751 0000144 00000006364 11370220757 015061 0 ustar hornik users \name{density2d}
\alias{density2d}
\alias{grid2d}
\alias{density2d}
\alias{hist2d}
\alias{integrate2d}
\title{Bivariate Density Tools}
\description{
Grid generator, kernel density estimator,
histogram counter, and integrator for
bivariate distributions
}
\usage{
grid2d(x = (0:10)/10, y = x)
density2d(x, y = NULL, n = 20, h = NULL, limits = c(range(x), range(y)))
hist2d(x, y = NULL, n = c(20, 20))
integrate2d(fun, error = 1.0e-5, \dots)
}
\arguments{
\item{error}{
the error bound to be achieved by the integration formula.
A numeric value.
}
\item{fun}{
the function to be integrated. The first argument requests
the x values, the second the y values, and the remaining
are reserved for additional parameters. The integration is
over the unit square "[0,1]\^2".
}
\item{h}{
a vector of bandwidths for \code{x} and \code{y} directions.
Defaults to normal reference bandwidth.
}
\item{limits}{
the limits of the rectangle covered by the grid.
}
\item{n}{
n - an integer specifying the number of grid points in each
direction. The default value is 20.\cr
[hist2D] - \cr
In this case \code{n} may be a scalar or a two element vector.
The default value is 20.\cr
[rnorm2d] - \cr
the number of random deviates to be generated, an integer value.
}
\item{x, y}{
two numeric vectors defining the x and y coordinates. \cr
[density2D][hist2D] - \cr
two vectors of coordinates of data. If \code{y} is NULL then
\code{x} is assumed to be a two column matrix, where the first
column contains the \code{x} data, and the second column the
\code{y} data.
}
\item{\dots}{
parameters passed to the function to be integrated.
}
}
\value{
\code{grid2d}
\cr
returns a list with two vectors named \code{$x} and \code{$y} spanning
the grid defined by the coordinate vectors \code{x} and \code{y}.
\code{density2d}\cr
\code{hist2d}
\cr
returns a list with three elements \code{$x}, \code{$y}, and
\code{$z}. \code{x} and \code{y} are vectors spanning the two
dimensional grid and \code{z} the corresponding matrix. The
output can directly serve as input to the plotting functions
\code{image}, \code{contour} and \code{persp}.
\code{integrate2d}
\cr
returns a list with the \code{$value} of the integral over the
unit square [0,1]\^2, an \code{$error} estimate and the number
of grid \code{$points} used by the integration function.
}
\references{
Azzalini A., (2004);
\emph{The sn Package};
R Reference Guide available from www.r-project.org.
Venables W.N., Ripley B.D., (2002);
\emph{Modern Applied Statistics with S},
Fourth Edition, Springer.
Warnes G.R., (2004);
\emph{The gregmisc Package};
R Reference Guide available from www.r-project.org.
}
\author{
W.N. Venables and B.D. Ripley for the underlying kde2d function, \cr
Gregory R. Warnes for the underlying hist2d function, \cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\keyword{math}
fMultivar/man/cauchy2d.Rd 0000644 0001751 0000144 00000003355 11370220757 015017 0 ustar hornik users \name{cauchy2d}
\alias{cauchy2d}
\alias{pcauchy2d}
\alias{dcauchy2d}
\alias{rcauchy2d}
\title{Bivariate Cauchy Distribution}
\description{
Density, distribution function, and random
generation for the bivariate Cauchy
distribution.
}
\usage{
pcauchy2d(x, y = x, rho = 0)
dcauchy2d(x, y = x, rho = 0)
rcauchy2d(n, rho = 0)
}
\arguments{
\item{n}{
the number of random deviates to be generated, an integer value.
}
\item{rho}{
the correlation parameter, a numeric value ranging between
minus one and one, by default zero.
}
\item{x, y}{
two numeric vectors defining the x and y coordinates.
}
}
\value{
\code{pcauchy2d}
\cr
returns a two column matrix of probabilities for the bivariate
Cauchy distribution function.\cr
\code{dcauchy2d}
\cr
returns a two column matrix of densities for the bivariate
Cauchy distribution function.\cr
\code{rcauchy2d}
\cr
returns a two column matrix of random deviates generated from
the bivariate Cauchy distribution function.
}
\references{
Azzalini A., (2004);
\emph{The sn Package};
R Reference Guide available from www.r-project.org.
Venables W.N., Ripley B.D., (2002);
\emph{Modern Applied Statistics with S},
Fourth Edition, Springer.
}
\author{
Adelchi Azzalini for the underlying pnorm2d function, \cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## Bivariate Cauchy Density:
x = (-40:40)/10
X = grid2d(x)
z = dcauchy2d(X$x, X$y, rho = 0.5)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
persp(Z, theta = -40, phi = 30, col = "steelblue")
}
\keyword{math}
fMultivar/man/BivariateGridding.Rd 0000644 0001751 0000144 00000004133 11370220757 016666 0 ustar hornik users \name{BivariateGridding}
\alias{BivariateGridding}
\alias{gridData}
\alias{persp.gridData}
\alias{contour.gridData}
\title{Bivariate Gridded Data Sets}
\description{
A collection and description of functions which
allow to generate bivariate gridded data sets.
\cr
Grid Data Functions:
\tabular{ll}{
\code{gridData} \tab generates a grid data set of class 'gridData', \cr
\code{persp} \tab generates a perspective plot from a grid data set, \cr
\code{contour} \tab generates a contour plot from a grid data set.}
}
\usage{
gridData(x = (-10:10)/10, y = x, z = outer(x, y, function(x, y) (x^2+y^2) ) )
\method{persp}{gridData}(x, theta = -40, phi = 30, col = "steelblue",
ticktype = "detailed", \dots)
\method{contour}{gridData}(x, addImage = TRUE, \dots)
}
\arguments{
\item{addImage}{
[contour] - \cr
a logical flag indicating if an image plot should be underlayed
to the contour level plot.
}
\item{x, y, z}{
[gridData] - \cr
\code{x} and \code{y} are two numeric vectors of grid pounts
and \code{z} is a numeric matrix or any other rectangular object
which can be transformed by the function \code{as.matrix} into
a matrix object.
}
\item{theta, phi, col, ticktype}{
[persp] - \cr
tailored parameters passed the perspective plot function \code{persp}.
}
\item{\dots}{
[contour][persp] - \cr
additional arguments to be passed to the perspectice and countour
plot functions.
}
}
\value{
\code{gridData} - \cr
A list with at least three entries, \code{x}, \code{y} and \code{z}.
The returned values, can be directly used by the \code{persp.gridData()}
and \code{contour.gridData} 3D plotting methods.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port,\cr
H. Akima for the Fortran Code of the Akima spline interpolation routine.\cr
}
\examples{
## gridData -
# Grid Data Set
gD = gridData()
persp(gD)
contour(gD)
}
\keyword{programming}
fMultivar/man/BivariateBinning.Rd 0000644 0001751 0000144 00000004464 11370220757 016532 0 ustar hornik users \name{BivariateBinning}
\alias{BivariateBinning}
\alias{squareBinning}
\alias{hexBinning}
\alias{plot.squareBinning}
\alias{plot.hexBinning}
\title{Square and Hexagonal Data Binning}
\description{
A collection and description of functions which
allow to create histograms due to sqaure and
hexagonal binning.
\cr
Bivariate Binning Functions:
\tabular{ll}{
\code{squareBinning} \tab does a square binning of data points, \cr
\code{hexBinning} \tab does a hexagonal binning of data points}
}
\usage{
squareBinning(x, y = NULL, bins = 30)
hexBinning(x, y = NULL, bins = 30)
\method{plot}{squareBinning}(x, col = heat.colors(12), addPoints = TRUE,
addRug = TRUE, \dots)
\method{plot}{hexBinning}(x, col = heat.colors(12), addPoints = TRUE,
addRug = TRUE, \dots)
}
\arguments{
\item{addPoints}{
a logical flag, should the center of mass points added to the
plot?
}
\item{addRug}{
a logical flag, should a rug representation be added to the
plot, for details see the function \code{rug}.
}
\item{bins}{
an integer specifying the number of bins.
}
\item{col}{
color map like for the \code{image} function.
}
\item{x, y}{
[squareBinning][hexBinning] - \cr
either two numeric vectors of equal length or if \code{y}
is NULL, a list with entries \code{x}, \code{y},
or named data frame with \code{x} in the first and
\code{y} in the second column.
Note, \code{timeSeries} objects are also allowed as input.\cr
[plot] - \cr
an object of class \code{squareBinning} or \code{hexBinning}.
}
\item{\dots}{
arguments to be passed.
}
}
\value{
A list with three entries, \code{x}, \code{y} and \code{z},
specified by an oject of class \code{squareBinning} or
\code{hexBinning}.
Note, the returned value, can be directly used by the \code{persp()}
and \code{contour} 3D plotting functions.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## squareBinning -
sB = squareBinning(x = rnorm(1000), y = rnorm(1000))
plot(sB)
## hexBinning -
hB = hexBinning(x = rnorm(1000), y = rnorm(1000))
plot(hB)
}
\keyword{programming}
fMultivar/inst/ 0000755 0001751 0000144 00000000000 11720123747 013222 5 ustar hornik users fMultivar/inst/unitTests/ 0000755 0001751 0000144 00000000000 11720123747 015224 5 ustar hornik users fMultivar/inst/unitTests/runTests.R 0000644 0001751 0000144 00000004531 11370220760 017173 0 ustar hornik users pkg <- "fMultivar"
if(require("RUnit", quietly = TRUE))
{
library(package=pkg, character.only = TRUE)
if(!(exists("path") && file.exists(path)))
path <- system.file("unitTests", package = pkg)
## --- Testing ---
## Define tests
testSuite <- defineTestSuite(name = paste(pkg, "unit testing"),
dirs = path)
if(interactive()) {
cat("Now have RUnit Test Suite 'testSuite' for package '",
pkg, "' :\n", sep='')
str(testSuite)
cat('', "Consider doing",
"\t tests <- runTestSuite(testSuite)", "\nand later",
"\t printTextProtocol(tests)", '', sep = "\n")
} else {
## run from shell / Rscript / R CMD Batch / ...
## Run
tests <- runTestSuite(testSuite)
if(file.access(path, 02) != 0) {
## cannot write to path -> use writable one
tdir <- tempfile(paste(pkg, "unitTests", sep="_"))
dir.create(tdir)
pathReport <- file.path(tdir, "report")
cat("RUnit reports are written into ", tdir, "/report.(txt|html)",
sep = "")
} else {
pathReport <- file.path(path, "report")
}
## Print Results:
printTextProtocol(tests, showDetails = FALSE)
printTextProtocol(tests, showDetails = FALSE,
fileName = paste(pathReport, "Summary.txt", sep = ""))
printTextProtocol(tests, showDetails = TRUE,
fileName = paste(pathReport, ".txt", sep = ""))
## Print HTML Version to a File:
## printHTMLProtocol has problems on Mac OS X
if (Sys.info()["sysname"] != "Darwin")
printHTMLProtocol(tests,
fileName = paste(pathReport, ".html", sep = ""))
## stop() if there are any failures i.e. FALSE to unit test.
## This will cause R CMD check to return error and stop
tmp <- getErrors(tests)
if(tmp$nFail > 0 | tmp$nErr > 0) {
stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
", R errors: ", tmp$nErr, ")\n\n", sep=""))
}
}
} else {
cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
"for package", pkg,"\n")
}
################################################################################
fMultivar/inst/unitTests/runit.MultivariateDistributions.R 0000644 0001751 0000144 00000017625 11370220760 023745 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# dmvsnorm Multivariate Skew Normal Density Function
# pmvsnorm Multivariate Skew Normal Probability Function
# rmvsnorm Multivariate Skew Normal Random Deviates
# FUNCTION: DESCRIPTION:
# dmvst Multivariate Skew Sudent-t Density Function
# pmvst Multivariate Skew Sudent-t Probability Function
# rmvst Multivariate Skew Sudent-t Random Deviates
# FUNCTION: DESCRIPTION:
# fMV S4 Object of class 'fMV'
# mvFit Fits a MV Normal or Student-t Distribution
# print.fMV S3: Print method for objects of class 'fMV'
# plot.fMV S3: Plot method for objects of class 'fMV'
# summary.fMV S3: Summary method for objects of class 'fMV'
################################################################################
test.dmvsnorm =
function()
{
# Multivariate Skew Normal
# Bivariate Density:
x = y = seq(-4, 4, length = 81)
G = grid2d(x)
X = cbind(G$x, G$y)
z = dmvsnorm(X, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = rep(0, 2))
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
# Plot:
par(mfrow = c(1, 1), ask = FALSE)
persp(Z, theta = -40, phi = 30, col = "steelblue")
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.pmvsnorm =
function()
{
# Multivariate Skew Normal
# Bivariate Density:
x = y = seq(-4, 4, length = 21)
G = grid2d(x)
X = cbind(G$x, G$y)
z = pmvsnorm(X, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = rep(0, 2))
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
# Plot:
par(mfrow = c(1, 1), ask = FALSE)
persp(Z, theta = -40, phi = 30, col = "steelblue")
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.rmvsnorm =
function()
{
# Multivariate Skew Normal
# RVs:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
N = 5000
z = rmvsnorm(N, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = rep(1, 2))
# Scatterplot:
par(mfrow = c(1, 1), ask = FALSE)
plot(z, pch = 19, col = "steelblue")
grid()
# Return Value:
return()
}
################################################################################
test.dmvst =
function()
{
# Multivariate Skew Sudent-t
args(dmvst)
# dmvst(x, dim = 2, mu = rep(0, dim), Omega = diag(dim),
# alpha = rep(0, dim), df = 4)
# Bivariate Density:
x = y = seq(-4, 4, length = 81)
G = grid2d(x)
X = cbind(G$x, G$y)
z = dmvst(X, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = c(-1, 1))
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
# Plot:
par(mfrow = c(1, 1), ask = FALSE)
persp(Z, theta = -40, phi = 30, col = "steelblue")
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.pmvst =
function()
{
# Multivariate Skew Sudent-t
# Bivariate Density:
x = y = seq(-4, 4, length = 21)
G = grid2d(x)
X = cbind(G$x, G$y)
z = pmvst(X, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = c(-1, 1))
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
# Plot:
par(mfrow = c(1, 1), ask = FALSE)
persp(Z, theta = -40, phi = 30, col = "steelblue")
.perspPlot(Z)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.rmvst =
function()
{
# Multivariate Skew Sudent-t
# RVs:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
N = 5000
z = rmvsnorm(N, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = c(-1, 1))
# Scatterplot:
par(mfrow = c(1, 1), ask = FALSE)
plot(z, pch = 19, col = "steelblue")
grid()
# Return Value:
return()
}
################################################################################
# fMV S4 Object of class 'fMV'
################################################################################
test.mvFit.mvsnorm =
function()
{
# mvFit - Fits a MV Normal or Student-t Distribution
# mvFit(x, method = c("snorm", "st"), fixed.df = NA, title = NULL,
# description = NULL, trace = FALSE, ...)
# RVs:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
N = 5000
z = rmvsnorm(N, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = c(-1, 1))
# Fit:
fit = mvFit(x = z, method = "snorm")
# Print:
print(fit)
# Interactive Plot:
# plot(fit, which = "ask")
# Scatterplot:
par(mfrow = c(1, 1))
plot(fit, which = 1)
# Normal QQ Plot of Mahalanobis Distances:
par(mfrow = c(2, 2))
plot(fit, which = 2)
# Skew Normal QQ Plot of Mahalanobis Distances:
plot(fit, which = 3)
# Normal PP Plot of Mahalanobis Distances:
plot(fit, which = 4)
# Skew Normal PP Plot of Mahalanobis Distances:
plot(fit, which = 5)
# Summary:
summary(fit, doplot = FALSE)
# Return Value:
return()
}
################################################################################
test.mvFit.mvst =
function()
{
# mvFit - Fits a MV Normal or Student-t Distribution
# mvFit(x, method = c("snorm", "st"), fixed.df = NA, title = NULL,
# description = NULL, trace = FALSE, ...)
# RVs:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
N = 1000
z = rmvst(N, dim = 2, mu = rep(0, 2), Omega = diag(2), alpha = c(-1, 1),
df = 4)
# Fit:
# fit = mvFit(x = z, method = "st", trace = TRUE)
fit = mvFit(x = z, method = "st")
# Print:
print(fit)
# Interactive Plot:
# plot(fit, which = "ask")
# Scatterplot:
par(mfrow = c(1, 1))
plot(fit, which = 1)
# Normal QQ Plot of Mahalanobis Distances:
par(mfrow = c(2, 2))
plot(fit, which = 2)
# Skew Normal QQ Plot of Mahalanobis Distances:
plot(fit, which = 3)
# Normal PP Plot of Mahalanobis Distances:
plot(fit, which = 4)
# Skew Normal PP Plot of Mahalanobis Distances:
plot(fit, which = 5)
# Summary:
summary(fit, doplot = FALSE)
# Return Value:
return()
}
################################################################################
fMultivar/inst/unitTests/runit.BivariateGridding.R 0000644 0001751 0000144 00000006452 11370220760 022066 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: GRID DATA:
# gridData Generates a grid data set
# persp.gridData Generates a perspective plot from a grid data object
# contour.gridData Generates a contour plot from a grid data object
################################################################################
test.gridData =
function()
{
# gridData Generates a grid data set
# persp.gridData Generates a perspective plot from a grid data object
# contour.gridData Generates a contour plot from a grid data object
# Generate Grid Data:
gD = gridData()
# Perspective Plot:
persp(gD)
# Contour Plot:
contour(gD)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.gridDataPlot =
function()
{
if (FALSE) {
require(akima)
# gridData Generates a grid data set
# persp.gridData Generates a perspective plot from a grid data object
# contour.gridData Generates a contour plot from a grid data object
# Generate Akima interpolated Grid Data:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = runif(999)-0.5
y = runif(999)-0.5
z = cos(2*pi*(x^2+y^2))
ans = akimaInterp(x, y, z, extrap = FALSE)
persp(ans)
title(main = "Akima Interpolation")
contour(ans)
title(main = "Akima Interpolation")
# Generate Kriged Grid Data:
require(spatial)
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = runif(999)-0.5
y = runif(999)-0.5
z = cos(2*pi*(x^2+y^2))
ans = krigeInterp(x, y, z, extrap = FALSE)
persp(ans)
title(main = "Kriging")
contour(ans)
title(main = "Kriging")
}
# Return Value:
return()
}
################################################################################
fMultivar/inst/unitTests/runit.BivariateDistributions.R 0000644 0001751 0000144 00000015022 11370220760 023172 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# grid2d Returns from two vectors x-y grid coordinates
# density2d Returns 2D Kernel Density Estimates
# hist2d Returns 2D Histogram Counts
# integrate2d Integrates over a two dimensional unit square
# FUNCTION: BIVARIATE DISTRIBUTIONS:
# pnorm2d Computes bivariate Normal probability function
# dnorm2d Computes bivariate Normal density function
# rnorm2d Generates bivariate normal random deviates
# pcauchy2d Computes bivariate Cauchy probability function
# dcauchy2d Computes bivariate Cauchy density function
# rcauchy2d Generates bivariate Cauchy random deviates
# pt2d Computes bivariate Student-t probability function
# dt2d Computes bivariate Student-t density function
# rt2d Generates bivariate Student-t random deviates
# FUNCTION: ELLIPTICAL DISTRIBUTIONS:
# delliptical2d Computes density for elliptical distributions
# .gfunc2d Generator Function for elliptical distributions
# .delliptical2dSlider Slider for bivariate densities
################################################################################
test.grid2d =
function()
{
# Grid Data:
grid2d(x = (0:10)/10)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.density2d =
function()
{
# Data:
z = rnorm2d(1000)
# Density:
D = density2d(x = z[, 1], y = z[, 2])
.perspPlot(D)
.contourPlot(D)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.hist2d =
function()
{
# Data:
z = rnorm2d(1000)
# Histogram:
H = hist2d(x = z[, 1], y = z[, 2])
.perspPlot(H)
.contourPlot(H)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.integrate2d =
function()
{
# Data:
z = rnorm2d(1000)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.norm2d =
function()
{
# pnorm2d - Computes bivariate Normal probability function
# dnorm2d - Computes bivariate Normal density function
# rnorm2d - Generates bivariate normal random deviates
# Normal Density:
x = (-40:40)/10
X = grid2d(x)
z = dnorm2d(X$x, X$y)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Normal Density, rho = 0.5:
x = (-40:40)/10
X = grid2d(x)
z = dnorm2d(X$x, X$y, rho = 0.5)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.cauchy2d =
function()
{
# pcauchy2d - Computes bivariate Cauchy probability function
# dcauchy2d - Computes bivariate Cauchy density function
# rcauchy2d - Generates bivariate Cauchy random deviates
# Cauchy Density:
x = (-40:40)/10
X = grid2d(x)
z = dcauchy2d(X$x, X$y)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Cauchy Density, rho = 0.5:
x = (-40:40)/10
X = grid2d(x)
z = dcauchy2d(X$x, X$y, rho = 0.5)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.t2d =
function()
{
# pt2d - Computes bivariate Student-t probability function
# dt2d - Computes bivariate Student-t density function
# rt2d - Generates bivariate Student-t random deviates
# Student Density:
x = (-40:40)/10
X = grid2d(x)
z = dt2d(X$x, X$y, nu = 4)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Student Density, rho = 0.5:
x = (-40:40)/10
X = grid2d(x)
z = dt2d(X$x, X$y, rho = 0.5, nu = 4)
Z = list(x = x, y = x, z = matrix(z, ncol = length(x)))
.perspPlot(Z)
.contourPlot(Z)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.delliptical2d =
function()
{
# Settings:
xy = grid2d((-50:50)/10)
# Contour Plots:
par(ask = FALSE)
par(mfrow = c(1, 1))
contour(delliptical2d(xy, rho = 0.75, param = NULL,
type = "norm", output = "list"), main = "norm")
contour(delliptical2d(xy, rho = 0.75, param = NULL,
type = "cauchy", output = "list"), main = "cauchy")
contour(delliptical2d(xy, rho = 0.75, param = 4,
type = "t", output = "list"), main = "t")
contour(delliptical2d(xy, rho = 0.75, param = NULL,
type = "laplace", output = "list"), main = "laplace")
contour(delliptical2d(xy, rho = 0.75, param = NULL,
type = "kotz", output = "list"), main = "kotz")
contour(delliptical2d(xy, rho = 0.75, param = NULL,
type = "epower", output = "list"), main = "epower")
# Return Value:
return()
}
################################################################################
fMultivar/inst/unitTests/runit.BivariateBinning.R 0000644 0001751 0000144 00000005462 11370220760 021723 0 ustar hornik users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# squareBinning Square binning of irregularly distributed data sets
# plot S3 Method for plotting square binned data sets
# FUNCTION: DESCRIPTION:
# hexBinning Hexagonal binning of irregularly distributed data sets
# plot S3 Method for plotting hexagonal binned data sets
################################################################################
test.squareBinning =
function()
{
# squareBinning Square binning of irregularly distributed data sets
# plot S3 Method for plotting square binned data sets
# Generate Grid Data:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
sB = squareBinning(x = rnorm(1000), y = rnorm(1000))
# Plot:
par(mfrow = c(1, 1))
plot(sB)
title(main = "Square Binning")
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.hexBinning =
function()
{
# hexBinning Hexagonal binning of irregularly distributed data sets
# plot S3 Method for plotting hexagonal binned data sets
# Generate Grid Data:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
hB = hexBinning(x = rnorm(1000), y = rnorm(1000))
# Plot:
par(mfrow = c(1, 1))
plot(hB)
title(main = "Hexagonal Binning")
# Return Value:
return()
}
################################################################################
fMultivar/inst/unitTests/Makefile 0000644 0001751 0000144 00000000421 11370220760 016653 0 ustar hornik users PKG=fMultivar
TOP=../..
SUITE=doRUnit.R
R=R
all: inst test
inst: # Install package -- but where ?? -- will that be in R_LIBS ?
cd ${TOP}/..;\
${R} CMD INSTALL ${PKG}
test: # Run unit tests
export RCMDCHECK=FALSE;\
cd ${TOP}/tests;\
${R} --vanilla --slave < ${SUITE} fMultivar/inst/COPYRIGHT.html 0000644 0001751 0000144 00000020411 11370220760 015450 0 ustar hornik users
Rmetrics::COPYRIGHT
Rmetrics
Copyrights
2005-12-18 Built 221.10065
________________________________________________________________________________
Copyrights (C) for
R:
see R's copyright and license file
Version R 2.0.0 claims:
- The stub packages from 1.9.x have been removed.
- All the datasets formerly in packages 'base' and 'stats' have
been moved to a new package 'datasets'.
- Package 'graphics' has been split into 'grDevices' (the graphics
devices shared between base and grid graphics) and 'graphics'
(base graphics).
- Packages must have been re-installed for this version, and
library() will enforce this.
- Package names must now be given exactly in library() and
require(), regardless of whether the underlying file system is
case-sensitive or not.
________________________________________________________________________________
for
Rmetrics:
(C) 1999-2005, Diethelm Wuertz, GPL
Diethelm Wuertz
www.rmetrics.org
info@rmetrics.org
________________________________________________________________________________
for non default loaded basic packages part of R's basic distribution
MASS:
Main Package of Venables and Ripley's MASS.
We assume that MASS is available.
Package 'lqs' has been returned to 'MASS'.
S original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
methods:
Formally defined methods and classes for R objects, plus other
programming tools, as described in the reference "Programming
with Data" (1998), John M. Chambers, Springer NY.
R Development Core Team.
mgcv:
Routines for GAMs and other generalized ridge regression
with multiple smoothing parameter selection by GCV or UBRE.
Also GAMMs by REML or PQL. Includes a gam() function.
Simon Wood
nnet:
Feed-forward Neural Networks and Multinomial Log-Linear Models
Original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
________________________________________________________________________________
for the code partly included as builtin functions from other R ports:
fBasics:CDHSC.F
GRASS program for distributional testing.
By James Darrell McCauley
Original Fortran Source by Paul Johnson EZ006244@ALCOR.UCDAVIS.EDU>
fBasics:nortest
Five omnibus tests for the composite hypothesis of normality
R-port by Juergen Gross
fBasics:SYMSTB.F
Fast numerical approximation to the Symmetric Stable distribution
and density functions.
By Hu McCulloch
fBasics:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fCalendar:date
The tiny C program from Terry Therneau is used
R port by Th. Lumley ,
K. Halvorsen , and
Kurt Hornik
fCalendar:holidays
The holiday information was collected from the internet and
governmental sources obtained from a few dozens of websites
fCalendar:libical
Libical is an Open Source implementation of the IETF's
iCalendar Calendaring and Scheduling protocols. (RFC 2445, 2446,
and 2447). It parses iCal components and provides a C API for
manipulating the component properties, parameters, and subcomponents.
fCalendar:vtimezone
Olsen's VTIMEZONE database consists of data files are released under
the GNU General Public License, in keeping with the license options of
libical.
fSeries:bdstest.c
C Program to compute the BDS Test.
Blake LeBaron
fSeries:fracdiff
R functions, help pages and the Fortran Code for the 'fracdiff'
function are included.
S original by Chris Fraley
R-port by Fritz Leisch
since 2003-12: Martin Maechler
fSeries:lmtest
R functions and help pages for the linear modelling tests are included .
Compiled by Torsten Hothorn ,
Achim Zeileis , and
David Mitchell
fSeries:mda
R functions, help pages and the Fortran Code for the 'mars' function
are implemeted.
S original by Trevor Hastie & Robert Tibshirani,
R port by Friedrich Leisch, Kurt Hornik and Brian D. Ripley
fSeries:modreg
Brian Ripley and the R Core Team
fSeries:polspline
R functions, help pages and the C/Fortran Code for the 'polymars'
function are implemented
Charles Kooperberg
fSeries:systemfit
Simultaneous Equation Estimation Package.
R port by Jeff D. Hamann and
Arne Henningsen
fSeries:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fSeries:UnitrootDistribution:
The program uses the Fortran routine and the tables
from J.G. McKinnon.
fSeries:urca
Unit root and cointegration tests for time series data.
R port by Bernhard Pfaff .
fExtremes:evd
Functions for extreme value distributions.
R port by Alec Stephenson
Function 'fbvpot' by Chris Ferro.
fExtremes:evir
Extreme Values in R
Original S functions (EVIS) by Alexander McNeil
R port by Alec Stephenson
fExtremes:ismev
An Introduction to Statistical Modeling of Extreme Values
Original S functions by Stuart Coles
R port/documentation by Alec Stephenson
fOptions
Option Pricing formulas are implemented along the book and
the Excel spreadsheets of E.G. Haug, "The Complete Guide to Option
Pricing"; documentation is partly taken from www.derivicom.com which
implements a C Library based on Haug. For non-academic and commercial
use we recommend the professional software from "www.derivicom.com".
fOptions:SOBOL.F
ACM Algorithm 659 by P. Bratley and B.L. Fox
Extension on Algorithm 659 by S. Joe and F.Y. Kuo
fOptions:CGAMA.F
Complex gamma and related functions.
Fortran routines by Jianming Jin.
fOptions:CONHYP.F
Confluenet Hypergeometric and related functions.
ACM Algorithm 707 by mark Nardin, W.F. Perger, A. Bhalla
fPortfolio:mvtnorm
Multivariate Normal and T Distribution.
Alan Genz ,
Frank Bretz
R port by Torsten Hothorn
fPortfolio:quadprog
Functions to solve Quadratic Programming Problems.
S original by Berwin A. Turlach
R port by Andreas Weingessel
fPortfolio:sn
The skew-normal and skew-t distributions.
R port by Adelchi Azzalini
fPortfolio:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fMultivar/DESCRIPTION 0000644 0001751 0000144 00000001373 12046452327 013760 0 ustar hornik users Package: fMultivar
Version: 2152.77
Revision: 5386
Date: 2012-11-07
Title: Multivariate Market Analysis
Author: Diethelm Wuertz and many others, see the SOURCE file
Depends: R (>= 2.4.0), methods, sn, timeDate, timeSeries, fBasics
Suggests: RUnit, tcltk
Maintainer: Yohan Chalabi
Description: Environment for teaching "Financial Engineering and
Computational Finance"
NOTE: SEVERAL PARTS ARE STILL PRELIMINARY AND MAY BE CHANGED IN THE
FUTURE. THIS TYPICALLY INCLUDES FUNCTION AND ARGUMENT NAMES, AS
WELL AS DEFAULTS FOR ARGUMENTS AND RETURN VALUES.
LazyData: yes
License: GPL (>= 2)
URL: http://www.rmetrics.org
Packaged: 2012-11-07 09:50:04 UTC; yankee
Repository: CRAN
Date/Publication: 2012-11-07 12:32:23
fMultivar/ChangeLog 0000644 0001751 0000144 00000001372 12046427314 014021 0 ustar hornik users 2012-11-07 chalabi
* DESCRIPTION: Updated maintainer field to comply new CRAN policy
* NAMESPACE: Added NAMESPACE
* R/norm2d.R: Fixed partial argument match
* R/zzz.R: Removed .First.lib call
2012-01-14 mmaechler
* R/cauchy2d.R: use nu =1 ! -- thanks to Rolf Turner
2011-09-23 mmaechler
* DESCRIPTION: remove deprecated "LazyLoad" entry
2010-07-23 chalabi
* inst/DocCopying.pdf: removed DocCopying.pdf license is already
specified in DESCRIPTION file
2009-09-30 chalabi
* DESCRIPTION: updated version number
2009-09-29 chalabi
* ChangeLog, DESCRIPTION: updated DESC and ChangeLog
2009-04-02 chalabi
* DESCRIPTION: more explicit depends and suggests field in DESC
file.
2009-04-01 chalabi
* DESCRIPTION: updated DESC file