[Vinecopula-commits] r52 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Do Feb 6 17:53:03 CET 2014
Author: ben_graeler
Date: 2014-02-06 17:53:02 +0100 (Thu, 06 Feb 2014)
New Revision: 52
Added:
pkg/R/0_prep_object.R
pkg/R/BB1copula.R
pkg/R/BB6copula.R
pkg/R/BB7copula.R
pkg/R/BB8copula.R
pkg/R/ClaytonGumbelCopula.R
pkg/R/joeBiCopula.R
pkg/R/tawnCopula.R
pkg/R/vineCopulas.R
pkg/man/BB1Copula-class.Rd
pkg/man/BB1Copula.Rd
pkg/man/BB6Copula-class.Rd
pkg/man/BB6Copula.Rd
pkg/man/BB7Copula-class.Rd
pkg/man/BB7Copula.Rd
pkg/man/BB8Copula-class.Rd
pkg/man/BB8Copula.Rd
pkg/man/dduCopula.Rd
pkg/man/joeBiCopula-class.Rd
pkg/man/joeBiCopula.Rd
pkg/man/surClaytonCopula-class.Rd
pkg/man/surClaytonCopula.Rd
pkg/man/surGumbelCopula-class.Rd
pkg/man/surGumbelCopula.Rd
pkg/man/tawnT1Copula-class.Rd
pkg/man/tawnT1Copula.Rd
pkg/man/tawnT2Copula-class.Rd
pkg/man/tawnT2Copula.Rd
pkg/man/vineCopula-class.Rd
pkg/man/vineCopula.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
Log:
- included wrapper for copula-package compatibility and documentation
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-02-03 13:01:52 UTC (rev 51)
+++ pkg/DESCRIPTION 2014-02-06 16:53:02 UTC (rev 52)
@@ -2,10 +2,11 @@
Type: Package
Title: Statistical inference of vine copulas
Version: 1.2-1
-Date: 2014-01-27
+Date: 2014-02-06
Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler
Maintainer: Ulf Schepsmeier <schepsmeier at ma.tum.de>
-Depends: R (>= 2.11.0), MASS, mvtnorm, igraph
+Depends: R (>= 2.11.0)
+Imports: MASS, mvtnorm, igraph, copula, methods
Suggests: CDVine, TSP, ADGofTest
Description: This package provides functions for statistical inference of vine copulas. It contains tools for bivariate exploratory data analysis, bivariate copula selection and (vine) tree construction. Models can be estimated either sequentially or by joint maximum likelihood estimation. Sampling algorithms and plotting methods are also included. Data is assumed to lie in the unit hypercube (so-called copula data). For C- and D-vines links to the package CDVine are provided.
License: GPL (>= 2)
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-02-03 13:01:52 UTC (rev 51)
+++ pkg/NAMESPACE 2014-02-06 16:53:02 UTC (rev 52)
@@ -1,6 +1,8 @@
import(MASS)
import(mvtnorm)
import(igraph)
+import(copula)
+import(methods)
export(BiCopEst)
export(BiCopMetaContour)
@@ -55,6 +57,31 @@
export(RVinePar2Beta)
export(BetaMatrix)
+# compatibility to copula
+export(fitCopula)
+export(dduCopula,ddvCopula)
+
+export(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
+export(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
+export(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
+export(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
+export(joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula)
+export(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
+export(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
+export(tawnT1Copula, surTawnT1Copula, r90TawnT1Copula, r270TawnT1Copula)
+export(tawnT2Copula, surTawnT2Copula, r90TawnT2Copula, r270TawnT2Copula)
+export(vineCopula)
+
+exportClasses(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
+exportClasses(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
+exportClasses(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
+exportClasses(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
+exportClasses(joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula)
+exportClasses(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
+exportClasses(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
+exportClasses(tawnT1Copula, surTawnT1Copula, r90TawnT1Copula, r270TawnT1Copula)
+exportClasses(tawnT2Copula, surTawnT2Copula, r90TawnT2Copula, r270TawnT2Copula)
+exportClasses(vineCopula)
S3method(print, RVineMatrix)
useDynLib("VineCopula")
\ No newline at end of file
Added: pkg/R/0_prep_object.R
===================================================================
--- pkg/R/0_prep_object.R (rev 0)
+++ pkg/R/0_prep_object.R 2014-02-06 16:53:02 UTC (rev 52)
@@ -0,0 +1,190 @@
+copulaFromFamilyIndex <- function(family, par, par2=0) {
+ constr <- switch(paste("fam",family,sep=""),
+ fam0 = function(par) indepCopula(),
+ fam1 = function(par) normalCopula(par[1]),
+ fam2 = function(par) tCopula(par[1],df=par[2]),
+ fam3 = function(par) claytonCopula(par[1]),
+ fam4 = function(par) gumbelCopula(par[1]),
+ fam5 = function(par) frankCopula(par[1]),
+ fam6 = function(par) joeBiCopula(par[1]),
+ fam7 = BB1Copula,
+ fam8 = BB6Copula,
+ fam9 = BB7Copula,
+ fam10 = BB8Copula,
+ fam13 = function(par) surClaytonCopula(par[1]),
+ fam14 = function(par) surGumbelCopula(par[1]),
+ fam16 = function(par) surJoeBiCopula(par[1]),
+ fam17 = surBB1Copula,
+ fam18 = surBB6Copula,
+ fam19 = surBB7Copula,
+ fam20 = surBB8Copula,
+ fam23 = function(par) r90ClaytonCopula(par[1]),
+ fam24 = function(par) r90GumbelCopula(par[1]),
+ fam26 = function(par) r90JoeBiCopula(par[1]),
+ fam27 = r90BB1Copula,
+ fam28 = r90BB6Copula,
+ fam29 = r90BB7Copula,
+ fam30 = r90BB8Copula,
+ fam33 = function(par) r270ClaytonCopula(par[1]),
+ fam34 = function(par) r270GumbelCopula(par[1]),
+ fam36 = function(par) r270JoeBiCopula(par[1]),
+ fam37 = r270BB1Copula,
+ fam38 = r270BB6Copula,
+ fam39 = r270BB7Copula,
+ fam40 = r270BB8Copula,
+ fam104 = tawnT1Copula,
+ fam114 = surTawnT1Copula,
+ fam124 = r90TawnT1Copula,
+ fam134 = r270TawnT1Copula,
+ fam204 = tawnT2Copula,
+ fam214 = surTawnT2Copula,
+ fam224 = r90TawnT2Copula,
+ fam234 = r270TawnT2Copula)
+ constr(c(par,par2))
+}
+
+#########################################################
+## generic wrapper functions to the VineCopula package ##
+#########################################################
+
+# density from BiCopPDF
+linkVineCop.PDF <- function (u, copula, log=FALSE) {
+ param <- copula at parameters
+
+ if(length(param)==1)
+ param <- c(param,0)
+ n <- nrow(u)
+ fam <- copula at family
+
+# coplik = RLL_mod_separate(fam, n, u, param)[[7]]
+ coplik = .C("LL_mod_seperate", as.integer(fam), as.integer(n), as.double(u[,1]),
+ as.double(u[,2]), as.double(param[1]), as.double(param[2]),
+ as.double(rep(0, n)), PACKAGE = "VineCopula")[[7]]
+ if(log)
+ return(coplik)
+ else
+ return(exp(coplik))
+}
+
+# cdf from BiCopCDF
+
+# for "standard" copulas: family %in% c(3:10)
+linkVineCop.CDF <- function (u, copula) {
+ param <- copula at parameters
+ if (!is.matrix(u)) u <- matrix(u, ncol = 2)
+ n <- nrow(u)
+ fam <- copula at family
+
+# res <- RarchCDF(fam, n, u, param)[[6]]
+ res <- .C("archCDF", as.double(u[,1]), as.double(u[,2]), as.integer(n), as.double(param),
+ as.integer(fam), as.double(rep(0, n)), PACKAGE = "VineCopula")[[6]]
+ return(res)
+}
+
+# for survival copulas: family %in% c(13, 14, 16:20)
+linkVineCop.surCDF <- function (u, copula) {
+ param <- copula at parameters
+ if (!is.matrix(u)) u <- matrix(u, ncol = 2)
+ u1 <- u[,1]
+ u2 <- u[,2]
+ n <- nrow(u)
+ fam <- copula at family
+
+# res <- u1 + u2 - 1 + RarchCDF(fam-10, n, cbind(1-u1,1-u2), param)[[6]]
+ res <- u1 + u2 - 1 + .C("archCDF", as.double(1 - u1), as.double(1 - u2), as.integer(n),
+ as.double(param), as.integer(fam - 10), as.double(rep(0, n)),
+ PACKAGE = "VineCopula")[[6]]
+ return(res)
+}
+
+# for 90 deg rotated copulas: family %in% c(23, 24, 26:30)
+linkVineCop.r90CDF <- function (u, copula) {
+ param <- copula at parameters
+ if (!is.matrix(u)) u <- matrix(u, ncol = 2)
+ u1 <- u[,1]
+ u2 <- u[,2]
+ n <- nrow(u)
+ fam <- copula at family
+
+# res <- u2 - RarchCDF(fam - 20, n, cbind(1-u1,u2), -param)[[6]]
+ u2 - .C("archCDF", as.double(1 - u1), as.double(u2), as.integer(n),
+ as.double(-param), as.integer(fam - 20), as.double(rep(0, n)),
+ PACKAGE = "VineCopula")[[6]]
+}
+
+# for 270 deg rotated copulas: family %in% c(33, 34, 36:40)
+linkVineCop.r270CDF <- function (u, copula) {
+ param <- copula at parameters
+ if (!is.matrix(u)) u <- matrix(u, ncol = 2)
+ u1 <- u[,1]
+ u2 <- u[,2]
+ n <- nrow(u)
+ fam <- copula at family
+
+# u1 - RarchCDF(fam-30, n, cbind(u1,1-u2), -param)[[6]]
+ u1 - .C("archCDF", as.double(u1), as.double(1 - u2), as.integer(n),
+ as.double(-param), as.integer(fam - 30), as.double(rep(0, n)),
+ PACKAGE = "VineCopula")[[6]]
+}
+
+## derivtives/h-function from BiCopHfunc
+# ddu
+linkVineCop.ddu <- function (u, copula) {
+ param <- copula at parameters
+ u <- matrix(u, ncol = 2)
+ n <- nrow(u)
+ fam <- copula at family
+
+# RHfunc1(fam, n, u, param)[[7]]
+ .C("Hfunc1", as.integer(fam), as.integer(n), as.double(u[,2]), as.double(u[,1]),
+ as.double(param[1]), as.double(param[2]), as.double(rep(0, n)),
+ PACKAGE = "VineCopula")[[7]]
+}
+
+# ddv
+linkVineCop.ddv <- function (u, copula) {
+ param <- copula at parameters
+ u <- matrix(u, ncol = 2)
+ n <- nrow(u)
+ fam <- copula at family
+
+# RHfunc2(fam, n, u, param)[[7]]
+ .C("Hfunc2", as.integer(fam), as.integer(n), as.double(u[,1]), as.double(u[,2]),
+ as.double(param[1]), as.double(param[2]), as.double(rep(0, n)),
+ PACKAGE = "VineCopula")[[7]]
+}
+
+
+## random numbers from VineCopulaSim
+linkVineCop.r <- function (n, copula){
+ param <- copula at parameters
+ fam <- copula at family
+ if(is.na(param[2])) param <- c(param,0)
+
+# tmp <- Rpcc(fam, n, param)[[7]]
+ res <- .C("pcc", as.integer(n), as.integer(2), as.integer(fam), as.integer(1),
+ as.double(param[1]), as.double(param[2]), as.double(rep(0, n * 2)),
+ PACKAGE = "VineCopula")[[7]]
+
+ return(matrix(res, ncol = 2))
+}
+
+## Kendall's tau
+linkVineCop.tau <- function(copula) {
+ par <- copula at parameters
+ BiCopPar2Tau(copula at family, par[1], par[2])
+}
+
+## get parameter from Kendall's tau (only for one parameter families)
+linkVineCop.iTau <- function(copula, tau) {
+ BiCopTau2Par(copula at family, tau)
+}
+
+## tailIndex
+linkVineCop.tailIndex <- function(copula) {
+ par <- copula at parameters
+ unlist(BiCopPar2TailDep(copula at family,par[1],par[2]))
+}
+
+setGeneric("dduCopula", function(u, copula, ...) standardGeneric("dduCopula"))
+setGeneric("ddvCopula", function(u, copula, ...) standardGeneric("ddvCopula"))
\ No newline at end of file
Added: pkg/R/BB1copula.R
===================================================================
--- pkg/R/BB1copula.R (rev 0)
+++ pkg/R/BB1copula.R 2014-02-06 16:53:02 UTC (rev 52)
@@ -0,0 +1,245 @@
+#####################
+## ##
+## the BB1 copulas ##
+## ##
+#####################
+# Joe, H., (1997). Multivariate Models and Dependence Concepts. Monogra. Stat. Appl. Probab. 73, London: Chapman and Hall.
+
+validBB1Copula = function(object) {
+ if (object at dimension != 2)
+ return("Only BB1 copulas of dimension 2 are supported.")
+ param <- object at parameters
+ upper <- object at param.upbnd
+ lower <- object at param.lowbnd
+ if (length(param) != length(upper))
+ return("Parameter and upper bound have non-equal length")
+ if (length(param) != length(lower))
+ return("Parameter and lower bound have non-equal length")
+ else return (TRUE)
+}
+
+setClass("BB1Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB1Copula,
+ contains = list("copula")
+)
+
+# constructor
+BB1Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf,Inf) | param[1] <= 0 | param[2] < 1))
+ stop(paste("Parameter values out of bounds: theta: (0,Inf), delta: [1,Inf)."))
+ new("BB1Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(0, 1), param.upbnd = c(Inf, Inf),
+ family=7, fullname = "BB1 copula family. Number 7 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","BB1Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","BB1Copula"),
+ function(u, copula, log) linkVineCop.PDF(u, copula, log))
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","BB1Copula"), linkVineCop.CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","BB1Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","BB1Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","BB1Copula"), linkVineCop.r)
+
+setMethod("tau",signature("BB1Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("BB1Copula"),linkVineCop.tailIndex)
+
+#########################
+## BB1 survival copula ##
+#########################
+
+setClass("surBB1Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB1Copula,
+ contains = list("copula")
+)
+
+# constructor
+surBB1Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf,Inf) | param[1] <= 0 | param[2] < 1))
+ stop(paste("Parameter values out of bounds: theta: (0,Inf), delta: [1,Inf)."))
+ new("surBB1Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(0, 1), param.upbnd = c(Inf, Inf),
+ family=17, fullname = "Survival BB1 copula family. Number 17 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","surBB1Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","surBB1Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","surBB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","surBB1Copula"), linkVineCop.surCDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","surBB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","surBB1Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","surBB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","surBB1Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","surBB1Copula"), linkVineCop.r)
+
+setMethod("tau",signature("surBB1Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("surBB1Copula"),linkVineCop.tailIndex)
+
+#######################
+## BB1 copula 90 deg ##
+#######################
+
+validRotBB1Copula = function(object) {
+ if (object at dimension != 2)
+ return("Only BB1 copulas of dimension 2 are supported.")
+ param <- object at parameters
+ upper <- object at param.upbnd
+ lower <- object at param.lowbnd
+ if (length(param) != length(upper))
+ return("Parameter and upper bound have non-equal length")
+ if (length(param) != length(lower))
+ return("Parameter and lower bound have non-equal length")
+ else return (TRUE)
+}
+
+setClass("r90BB1Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB1Copula,
+ contains = list("copula")
+)
+
+# constructor
+r90BB1Copula <- function (param=c(-1,-1)) {
+ if (any(is.na(param) | param[1] >= 0 | param[2] > -1 | param <= c(-Inf,-Inf)))
+ stop(paste("Parameter values out of bounds: theta: (-Inf,0), delta: (-Inf,-1]."))
+ new("r90BB1Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(0, -1),
+ family=27, fullname = "90 deg rotated BB1 copula family. Number 27 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r90BB1Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","r90BB1Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r90BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","r90BB1Copula"), linkVineCop.r90CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r90BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","r90BB1Copula"), linkVineCop.ddu)
+
+## ddv
+setMethod("ddvCopula", signature("numeric","r90BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","r90BB1Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r90BB1Copula"), linkVineCop.r)
+
+setMethod("tau",signature("r90BB1Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("r90BB1Copula"),linkVineCop.tailIndex)
+
+########################
+## BB1 copula 270 deg ##
+########################
+
+setClass("r270BB1Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB1Copula,
+ contains = list("copula")
+)
+
+# constructor
+r270BB1Copula <- function (param=c(-1,-1)) {
+ if (any(is.na(param) | param[1] >= 0 | param[2] > -1 | param <= c(-Inf,-Inf)))
+ stop(paste("Parameter values out of bounds: theta: (-Inf,0), delta: (-Inf,-1]."))
+ new("r270BB1Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(0, -1),
+ family=37, fullname = "270 deg rotated BB1 copula family. Number 37 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r270BB1Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","r270BB1Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r270BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","r270BB1Copula"), linkVineCop.r270CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r270BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","r270BB1Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","r270BB1Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","r270BB1Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r270BB1Copula"), linkVineCop.r)
+
+setMethod("tau",signature("r270BB1Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("r270BB1Copula"),linkVineCop.tailIndex)
\ No newline at end of file
Added: pkg/R/BB6copula.R
===================================================================
--- pkg/R/BB6copula.R (rev 0)
+++ pkg/R/BB6copula.R 2014-02-06 16:53:02 UTC (rev 52)
@@ -0,0 +1,246 @@
+#####################
+## ##
+## the BB6 copulas ##
+## ##
+#####################
+# Joe, H., (1997). Multivariate Models and Dependence Concepts. Monogra. Stat. Appl. Probab. 73, London: Chapman and Hall.
+
+validBB6Copula = function(object) {
+ if (object at dimension != 2)
+ return("Only BB6 copulas of dimension 2 are supported.")
+ param <- object at parameters
+ upper <- object at param.upbnd
+ lower <- object at param.lowbnd
+ if (length(param) != length(upper))
+ return("Parameter and upper bound have non-equal length")
+ if (length(param) != length(lower))
+ return("Parameter and lower bound have non-equal length")
+ if (any(is.na(param) | param >= upper | param < lower))
+ return("Parameter value out of bound.")
+ else return (TRUE)
+}
+
+setClass("BB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+BB6Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf, Inf) | param < c(1,1)))
+ stop("Parameter value(s) out of bound(s): theta: [1,Inf), delta: [1,Inf).")
+ new("BB6Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 1), param.upbnd = c(Inf, Inf),
+ family=8, fullname = "BB6 copula family. Number 8 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","BB6Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","BB6Copula"), function(u, copula, log) linkVineCop.PDF(u, copula, log))
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","BB6Copula"), linkVineCop.CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","BB6Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","BB6Copula"), linkVineCop.ddv)
+
+## random number generater ??
+setMethod("rCopula", signature("numeric","BB6Copula"), linkVineCop.r)
+
+setMethod("tau",signature("BB6Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("BB6Copula"),linkVineCop.tailIndex)
+
+#########################
+## BB6 survival copula ##
+#########################
+
+setClass("surBB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+surBB6Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf, Inf) | param < c(1,1)))
+ stop("Parameter value(s) out of bound(s): theta: [1,Inf), delta: [1,Inf).")
+ new("surBB6Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 1), param.upbnd = c(Inf, Inf),
+ family=18, fullname = "Survival BB6 copula family. Number 18 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","surBB6Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","surBB6Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","surBB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","surBB6Copula"), linkVineCop.surCDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","surBB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","surBB6Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","surBB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","surBB6Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","surBB6Copula"), linkVineCop.r)
+
+setMethod("tau",signature("surBB6Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("surBB6Copula"),linkVineCop.tailIndex)
+
+#######################
+## BB6 copula 90 deg ##
+#######################
+
+validRotBB6Copula = function(object) {
+ if (object at dimension != 2)
+ return("Only BB6 copulas of dimension 2 are supported.")
+ param <- object at parameters
+ upper <- object at param.upbnd
+ lower <- object at param.lowbnd
+ if (length(param) != length(upper))
+ return("Parameter and upper bound have non-equal length")
+ if (length(param) != length(lower))
+ return("Parameter and lower bound have non-equal length")
+ else return (TRUE)
+}
+
+setClass("r90BB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+r90BB6Copula <- function (param=c(-1,-1)) {
+ if (any(is.na(param) | param > c(-1,-1) | param <= c(-Inf,-Inf)))
+ stop("Parameter value out of bound: theta: (-Inf,1], delta: (-Inf,1].")
+ new("r90BB6Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, -1),
+ family=28, fullname = "90 deg rotated BB6 copula family. Number 28 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r90BB6Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula,log)
+ })
+setMethod("dCopula", signature("matrix","r90BB6Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r90BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","r90BB6Copula"), linkVineCop.r90CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r90BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","r90BB6Copula"), linkVineCop.ddu)
+
+## ddv
+setMethod("ddvCopula", signature("numeric","r90BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","r90BB6Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r90BB6Copula"), linkVineCop.r)
+
+setMethod("tau",signature("r90BB6Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("r90BB6Copula"),linkVineCop.tailIndex)
+
+###########################
+## BB6 copula 270 degree ##
+###########################
+
+setClass("r270BB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+r270BB6Copula <- function (param=c(-1,-1)) {
+ if (any(is.na(param) | param > c(-1,-1) | param <= c(-Inf,-Inf)))
+ stop("Parameter value out of bound: theta: (-Inf,1], delta: (-Inf,1].")
+ new("r270BB6Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, -1),
+ family=38, fullname = "270 deg rotated BB6 copula family. Number 38 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r270BB6Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension, log),copula)
+ })
+setMethod("dCopula", signature("matrix","r270BB6Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r270BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","r270BB6Copula"), linkVineCop.r270CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r270BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","r270BB6Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","r270BB6Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","r270BB6Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r270BB6Copula"), linkVineCop.r)
+
+setMethod("tau",signature("r270BB6Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("r270BB6Copula"),linkVineCop.tailIndex)
\ No newline at end of file
Added: pkg/R/BB7copula.R
===================================================================
--- pkg/R/BB7copula.R (rev 0)
+++ pkg/R/BB7copula.R 2014-02-06 16:53:02 UTC (rev 52)
@@ -0,0 +1,247 @@
+#####################
+## ##
+## the BB7 copulas ##
+## ##
+#####################
+# Joe, H., (1997). Multivariate Models and Dependence Concepts. Monogra. Stat. Appl. Probab. 73, London: Chapman and Hall.
+
+validBB7Copula = function(object) {
+ if (object at dimension != 2)
+ return("Only BB7 copulas of dimension 2 are supported.")
+ param <- object at parameters
+ upper <- object at param.upbnd
+ lower <- object at param.lowbnd
+ if (length(param) != length(upper))
+ return("Parameter and upper bound have non-equal length")
+ if (length(param) != length(lower))
+ return("Parameter and lower bound have non-equal length")
+ else return (TRUE)
+}
+
+setClass("BB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+BB7Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf, Inf) | param[1] < 1 | param[2] <= 0))
+ stop(paste("Parameter values out of bounds: theta: [1,Inf), delta: (0,Inf)."))
+ new("BB7Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, Inf),
+ family=9, fullname = "BB7 copula family. Number 9 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","BB7Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension),copula, log)
+ })
+setMethod("dCopula", signature("matrix","BB7Copula"), function(u, copula, log) linkVineCop.PDF(u, copula, log))
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","BB7Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","BB7Copula"), linkVineCop.CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","BB7Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddu(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("dduCopula", signature("matrix","BB7Copula"), linkVineCop.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","BB7Copula"),
+ function(u, copula, ...) {
+ linkVineCop.ddv(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("ddvCopula", signature("matrix","BB7Copula"), linkVineCop.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","BB7Copula"), linkVineCop.r)
+
+setMethod("tau",signature("BB7Copula"),linkVineCop.tau)
+setMethod("tailIndex",signature("BB7Copula"),linkVineCop.tailIndex)
+
+
+#########################
+## BB7 survival copula ##
+#########################
+
+setClass("surBB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+surBB7Copula <- function (param=c(1,1)) {
+ if (any(is.na(param) | param >= c(Inf, Inf) | param[1] < 1 | param[2] <= 0))
+ stop(paste("Parameter values out of bounds: theta: [1,Inf), delta: (0,Inf)."))
+ new("surBB7Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, Inf),
+ family= 19, fullname = "Survival BB7 copula family. Number 19 in VineCopula.")
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","surBB7Copula"),
+ function(u, copula, log) {
+ linkVineCop.PDF(matrix(u,ncol=copula at dimension,),copula,log=log)
+ })
+setMethod("dCopula", signature("matrix","surBB7Copula"), linkVineCop.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","surBB7Copula"),
+ function(u, copula, ...) {
+ linkVineCop.CDF(matrix(u,ncol=copula at dimension),copula)
+ })
+setMethod("pCopula", signature("matrix","surBB7Copula"), linkVineCop.surCDF)
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/vinecopula -r 52
Mehr Informationen über die Mailingliste Vinecopula-commits