fMultivar/0000755000175100001440000000000012046452327012246 5ustar hornikusersfMultivar/MD50000644000175100001440000000312412046452327012556 0ustar hornikusersbb4760a4a41aa2225869cbdad79b5cbe *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/0000755000175100001440000000000011720123747013407 5ustar hornikusersfMultivar/tests/doRUnit.R0000644000175100001440000000151611370220757015121 0ustar hornikusers#### 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/0000755000175100001440000000000012046426447012453 5ustar hornikusersfMultivar/R/t2d.R0000644000175100001440000001017211370220757013263 0ustar hornikusers # 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.R0000644000175100001440000002170412046426447014003 0ustar hornikusers # 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.R0000644000175100001440000001077211370220757016171 0ustar hornikusers # 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.R0000644000175100001440000001121611370220757016673 0ustar hornikusers # 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.R0000644000175100001440000004006611370220757020030 0ustar hornikusers # 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.R0000644000175100001440000002326111370220757015145 0ustar hornikusers # 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.R0000644000175100001440000001747711370220757014516 0ustar hornikusers # 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.R0000644000175100001440000000675411717226247014314 0ustar hornikusers # 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.R0000644000175100001440000000774311370220757016162 0ustar hornikusers # 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.R0000644000175100001440000002443311370220757016012 0ustar hornikusers # 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/NAMESPACE0000644000175100001440000000374312046426034013470 0ustar hornikusers ################################################ ## 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/0000755000175100001440000000000011720123747013020 5ustar hornikusersfMultivar/man/t2d.Rd0000644000175100001440000000357411370220757014011 0ustar hornikusers\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.Rd0000644000175100001440000000333311370220757014512 0ustar hornikusers\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.Rd0000644000175100001440000003332311370220757020544 0ustar hornikusers\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.Rd0000644000175100001440000000475511370220757015672 0ustar hornikusers\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.Rd0000644000175100001440000000636411370220757015061 0ustar hornikusers\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.Rd0000644000175100001440000000335511370220757015017 0ustar hornikusers\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.Rd0000644000175100001440000000413311370220757016666 0ustar hornikusers\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.Rd0000644000175100001440000000446411370220757016532 0ustar hornikusers\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/0000755000175100001440000000000011720123747013222 5ustar hornikusersfMultivar/inst/unitTests/0000755000175100001440000000000011720123747015224 5ustar hornikusersfMultivar/inst/unitTests/runTests.R0000644000175100001440000000453111370220760017173 0ustar hornikuserspkg <- "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.R0000644000175100001440000001762511370220760023745 0ustar hornikusers # 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.R0000644000175100001440000000645211370220760022066 0ustar hornikusers # 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.R0000644000175100001440000001502211370220760023172 0ustar hornikusers # 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.R0000644000175100001440000000546211370220760021723 0ustar hornikusers # 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/Makefile0000644000175100001440000000042111370220760016653 0ustar hornikusersPKG=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.html0000644000175100001440000002041111370220760015450 0ustar hornikusers 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/DESCRIPTION0000644000175100001440000000137312046452327013760 0ustar hornikusersPackage: 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/ChangeLog0000644000175100001440000000137212046427314014021 0ustar hornikusers2012-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