[spcopula-commits] r64 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 28 16:08:05 CEST 2012
Author: ben_graeler
Date: 2012-09-28 16:08:05 +0200 (Fri, 28 Sep 2012)
New Revision: 64
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/BB6copula.R
pkg/R/BB7copula.R
pkg/R/Classes.R
pkg/R/spatialPreparation.R
pkg/R/spcopula.R
pkg/R/stcopula.R
pkg/R/utilities.R
pkg/R/vineCopulas.R
Log:
still adapting to major changes in copula
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-09-12 11:54:46 UTC (rev 63)
+++ pkg/DESCRIPTION 2012-09-28 14:08:05 UTC (rev 64)
@@ -1,30 +1,30 @@
-Package: spcopula
-Type: Package
-Title: copula driven spatial analysis
-Version: 1.0.63
-Date: 2012-09-12
-Author: Benedikt Graeler
-Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
-Description: This package provides a framework to analyse spatial data provided in the format of the spacetime package with copulas. Additionally, support for calculating multivariate return periods is implemented.
-License: GPL-2
-LazyLoad: yes
-Depends: copula (>= 0.99-2), spacetime, CDVine, methods, lattice, R (>= 2.13.2)
-URL: http://r-forge.r-project.org/projects/spcopula/
-Collate:
- Classes.R
- partialDerivatives.R
- cqsCopula.R
- asCopula.R
- spcopula.R
- stcopula.R
- spatialPreparation.R
- linkingCDVine.R
- BB1copula.R
- BB6copula.R
- BB7copula.R
- BB8copula.R
- JoeCopula.R
- ClaytonGumbelCopula.R
- vineCopulas.R
- utilities.R
- returnPeriods.R
+Package: spcopula
+Type: Package
+Title: copula driven spatial analysis
+Version: 1.0.64
+Date: 2012-09-28
+Author: Benedikt Graeler
+Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
+Description: This package provides a framework to analyse spatial data provided in the format of the spacetime package with copulas. Additionally, support for calculating multivariate return periods is implemented.
+License: GPL-2
+LazyLoad: yes
+Depends: copula (>= 0.99-2), spacetime, CDVine, methods, lattice, R (>= 2.13.2)
+URL: http://r-forge.r-project.org/projects/spcopula/
+Collate:
+ Classes.R
+ partialDerivatives.R
+ cqsCopula.R
+ asCopula.R
+ spcopula.R
+ stcopula.R
+ spatialPreparation.R
+ linkingCDVine.R
+ BB1copula.R
+ BB6copula.R
+ BB7copula.R
+ BB8copula.R
+ JoeCopula.R
+ ClaytonGumbelCopula.R
+ vineCopulas.R
+ utilities.R
+ returnPeriods.R
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-09-12 11:54:46 UTC (rev 63)
+++ pkg/NAMESPACE 2012-09-28 14:08:05 UTC (rev 64)
@@ -1,58 +1,58 @@
-# useDynLib(spcopula)
-
-import(copula, spacetime, CDVine, lattice)
-# importClassesFrom(spacetime, STFDF)
-
-# constructor
-export(asCopula, cqsCopula)
-export(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
-export(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
-export(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
-export(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
-export(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
-export(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
-export(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
-export(vineCopula)
-export(neighbourhood)
-
-# general functions
-export(rankTransform, dependencePlot, univScatter)
-export(fitCopula)
-export(dduCopula,ddvCopula)
-export(invdduCopula, invddvCopula)
-export(qCopula_u)
-export(genEmpCop)
-
-# tweaks
-export(setSizeLim)
-
-# spatial
-export(getNeighbours)
-export(calcBins)
-# fitting
-export(fitCorFun, loglikByCopulasLags, composeSpCop, fitSpCopula)
-export(spCopula)
-
-# MRP functions
-export(genEmpKenFun, genInvKenFun)
-export(kendallRP, criticalLevel, kendallDistribution)
-
-## classes
-exportClasses(asCopula, cqsCopula, neighbourhood)
-
-# wrappers to CDVine
-exportClasses(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
-exportClasses(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
-exportClasses(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
-exportClasses(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
-exportClasses(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
-exportClasses(vineCopula, spCopula)
-
-## exportClasses(mvdc) ## S4 methods
-## exportMethods(persp, contour)
-## S3method(print, indepTest)
-## importClassesFrom(package, ...)
-## importMethodsFrom(package, ...)
-
-
-
+# useDynLib(spcopula)
+
+import(copula, spacetime, CDVine, lattice)
+# importClassesFrom(spacetime, STFDF)
+
+# constructor
+export(asCopula, cqsCopula)
+export(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
+export(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
+export(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
+export(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
+export(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
+export(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
+export(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
+export(vineCopula)
+export(neighbourhood)
+
+# general functions
+export(rankTransform, dependencePlot, unitScatter, univScatter)
+export(fitCopula)
+export(dduCopula,ddvCopula)
+export(invdduCopula, invddvCopula)
+export(qCopula_u)
+export(genEmpCop)
+
+# tweaks
+export(setSizeLim)
+
+# spatial
+export(getNeighbours)
+export(calcBins)
+# fitting
+export(fitCorFun, loglikByCopulasLags, composeSpCop, fitSpCopula)
+export(spCopula)
+
+# MRP functions
+export(genEmpKenFun, genInvKenFun)
+export(kendallRP, criticalLevel, kendallDistribution)
+
+## classes
+exportClasses(asCopula, cqsCopula, neighbourhood)
+
+# wrappers to CDVine
+exportClasses(BB1Copula, surBB1Copula, r90BB1Copula, r270BB1Copula)
+exportClasses(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
+exportClasses(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
+exportClasses(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
+exportClasses(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
+exportClasses(vineCopula, spCopula)
+
+## exportClasses(mvdc) ## S4 methods
+## exportMethods(persp, contour)
+## S3method(print, indepTest)
+## importClassesFrom(package, ...)
+## importMethodsFrom(package, ...)
+
+
+
Modified: pkg/R/BB6copula.R
===================================================================
--- pkg/R/BB6copula.R 2012-09-12 11:54:46 UTC (rev 63)
+++ pkg/R/BB6copula.R 2012-09-28 14:08:05 UTC (rev 64)
@@ -1,181 +1,180 @@
-#####################
-## ##
-## 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) {
- val <- 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 CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","BB6Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","BB6Copula"), linkCDVine.CDF)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","BB6Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","BB6Copula"), linkCDVine.ddv)
-
-## random number generater ??
-setMethod("rCopula", signature("numeric","BB6Copula"), linkCDVine.r)
-
-## kendall distribution/measure, taken from CDVine:::obs.stat
-kendall.BB6 <- function(copula, t){
- theta = copula at parameters[1]
- delta = copula at parameters[2]
-
- kt <- rep(NA,length(t))
- kt <- t + log(-(1 - t)^theta + 1) * (1 - t - (1 - t)^(-theta) + (1 - t)^(-theta) * t)/(delta * theta)
- kt[t==1] <- 1
- kt[t==0] <- 0
- return(kt)
-}
-
-setMethod("kendallDistribution", signature("BB6Copula"), kendall.BB6)
-
-setMethod("getKendallDistr", signature("BB6Copula"),
- function(copula) return(function(t) kendall.BB6(copula, t)))
-
-#########################
-## BB6 survival copula ##
-#########################
-
-setClass("surBB6Copula",
- representation = representation("copula", family="numeric"),
- validity = validBB6Copula,
- contains = list("copula")
-)
-
-# constructor
-surBB6Copula <- function (param) {
- val <- 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 CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","surBB6Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","surBB6Copula"), linkCDVine.surCDF)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","surBB6Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","surBB6Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","surBB6Copula"), linkCDVine.r)
-
-#######################
-## 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")
- if (any(is.na(param) | param > upper | param <= lower))
- return("Parameter value out of bound")
- else return (TRUE)
-}
-
-setClass("r90BB6Copula",
- representation = representation("copula", family="numeric"),
- validity = validRotBB6Copula,
- contains = list("copula")
-)
-
-# constructor
-r90BB6Copula <- function (param) {
- val <- 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 CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","r90BB6Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","r90BB6Copula"), linkCDVine.r90CDF)
-# persp(r90BB6Copula(c(-1.329995,-1.1201476)), pcopula)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","r90BB6Copula"), linkCDVine.ddu)
-
-## ddv
-setMethod("ddvCopula", signature("numeric","r90BB6Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","r90BB6Copula"), linkCDVine.r)
-# rcopula(r90BB6Copula(c(-5.329995,-1.1201476)),500)
-
-#####################
-## BB6 copula 270� ##
-#####################
-
-setClass("r270BB6Copula",
- representation = representation("copula", family="numeric"),
- validity = validRotBB6Copula,
- contains = list("copula")
-)
-
-# constructor
-r270BB6Copula <- function (param) {
- val <- 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 CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","r270BB6Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","r270BB6Copula"), linkCDVine.r270CDF)
-# persp(r270BB6Copula(c(-5.329995,-1.1201476)), dcopula)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","r270BB6Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","r270BB6Copula"), linkCDVine.ddv)
-
-## random number generator
+#####################
+## ##
+## 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) {
+ val <- 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 CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","BB6Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","BB6Copula"), linkCDVine.CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","BB6Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","BB6Copula"), linkCDVine.ddv)
+
+## random number generater ??
+setMethod("rCopula", signature("numeric","BB6Copula"), linkCDVine.r)
+
+## kendall distribution/measure, taken from CDVine:::obs.stat
+kendall.BB6 <- function(copula, t){
+ theta = copula at parameters[1]
+ delta = copula at parameters[2]
+
+ kt <- rep(NA,length(t))
+ kt <- t + log(-(1 - t)^theta + 1) * (1 - t - (1 - t)^(-theta) + (1 - t)^(-theta) * t)/(delta * theta)
+ kt[t==1] <- 1
+ kt[t==0] <- 0
+ return(kt)
+}
+
+setMethod("kendallDistribution", signature("BB6Copula"), kendall.BB6)
+
+setMethod("getKendallDistr", signature("BB6Copula"),
+ function(copula) return(function(t) kendall.BB6(copula, t)))
+
+#########################
+## BB6 survival copula ##
+#########################
+
+setClass("surBB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+surBB6Copula <- function (param) {
+ val <- 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 CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","surBB6Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","surBB6Copula"), linkCDVine.surCDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","surBB6Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","surBB6Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","surBB6Copula"), linkCDVine.r)
+
+#######################
+## 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")
+ if (any(is.na(param) | param > upper | param <= lower))
+ return("Parameter value out of bound")
+ else return (TRUE)
+}
+
+setClass("r90BB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+r90BB6Copula <- function (param) {
+ val <- 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 CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r90BB6Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r90BB6Copula"), linkCDVine.r90CDF)
+# persp(r90BB6Copula(c(-1.329995,-1.1201476)), pcopula)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r90BB6Copula"), linkCDVine.ddu)
+
+## ddv
+setMethod("ddvCopula", signature("numeric","r90BB6Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r90BB6Copula"), linkCDVine.r)
+# rcopula(r90BB6Copula(c(-5.329995,-1.1201476)),500)
+
+#####################
+## BB6 copula 270� ##
+#####################
+
+setClass("r270BB6Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB6Copula,
+ contains = list("copula")
+)
+
+# constructor
+r270BB6Copula <- function (param) {
+ val <- 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 CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r270BB6Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r270BB6Copula"), linkCDVine.r270CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r270BB6Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","r270BB6Copula"), linkCDVine.ddv)
+
+## random number generator
setMethod("rCopula", signature("numeric","r270BB6Copula"), linkCDVine.r)
\ No newline at end of file
Modified: pkg/R/BB7copula.R
===================================================================
--- pkg/R/BB7copula.R 2012-09-12 11:54:46 UTC (rev 63)
+++ pkg/R/BB7copula.R 2012-09-28 14:08:05 UTC (rev 64)
@@ -1,184 +1,182 @@
-#####################
-## ##
-## 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")
- if (any(is.na(param) | param >= upper | param[1] < lower[1] | param[2] <= lower[2]))
- return("Parameter value out of bound.")
- else return (TRUE)
-}
-
-setClass("BB7Copula",
- representation = representation("copula", family="numeric"),
- validity = validBB7Copula,
- contains = list("copula")
-)
-
-# constructor
-BB7Copula <- function (param) {
- val <- 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 CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","BB7Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","BB7Copula"), linkCDVine.CDF)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","BB7Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","BB7Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","BB7Copula"), linkCDVine.r)
-
-## kendall distribution/measure, taken from CDVine:::obs.stat
-kendall.BB7 <- function(copula, t){
- theta = copula at parameters[1]
- delta = copula at parameters[2]
-
- kt <- rep(NA,length(t))
- kt <- t + 1/(theta * delta) * ((1 - (1 - t)^theta)^(-delta) - 1)/
- ((1 - t)^(theta - 1) * (1 - (1 - t)^theta)^(-delta - 1))
- kt[t==1] <- 1
- kt[t==0] <- 0
- return(kt)
-}
-
-setMethod("kendallDistribution", signature("BB7Copula"), kendall.BB7)
-
-setMethod("getKendallDistr", signature("BB7Copula"),
- function(copula) return(function(t) kendall.BB7(copula, t)))
-
-#########################
-## BB7 survival copula ##
-#########################
-
-setClass("surBB7Copula",
- representation = representation("copula", family="numeric"),
- validity = validBB7Copula,
- contains = list("copula")
-)
-
-# constructor
-surBB7Copula <- function (param) {
- val <- 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 CDVine.")
- return(val)
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","surBB7Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","surBB7Copula"), linkCDVine.surCDF)
-# persp(surBB7Copula(c(5.329995,2.1201476)),pcopula,zlim=c(0,1))
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","surBB7Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","surBB7Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","surBB7Copula"), linkCDVine.r)
-
-####################
-## BB7 copula 90� ##
-####################
-
-validRotBB7Copula = 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")
- if (any(is.na(param) | param[1] > upper[1] | param[2] >= upper[2] | param <= lower))
- return("Parameter value out of bound")
- else return (TRUE)
-}
-
-setClass("r90BB7Copula",
- representation = representation("copula", family="numeric"),
- validity = validRotBB7Copula,
- contains = list("copula")
-)
-
-# constructor
-r90BB7Copula <- function (param) {
- val <- new("r90BB7Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, 0), family=29, fullname = "90 deg rotated BB7 copula family. Number 29 in CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","r90BB7Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","r90BB7Copula"), linkCDVine.r90CDF)
-# persp(r90BB7Copula(c(-1.329995,-1.1201476)), dcopula)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","r90BB7Copula"), linkCDVine.ddu)
-
-## ddv
-setMethod("ddvCopula", signature("numeric","r90BB7Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","r90BB7Copula"), linkCDVine.r)
-# rcopula(r90BB7Copula(c(-5.329995,-1.1201476)),500)
-
-########################
-## BB7 copula 270 deg ##
-########################
-
-setClass("r270BB7Copula",
- representation = representation("copula", family="numeric"),
- validity = validRotBB7Copula,
- contains = list("copula")
-)
-
-# constructor
-r270BB7Copula <- function (param) {
- val <- new("r270BB7Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, -1), family=39, fullname = "270 deg rotated BB7 copula family. Number 39 in CDVine.")
- val
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","r270BB7Copula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","r270BB7Copula"), linkCDVine.r270CDF)
-# persp(r270BB7Copula(c(-5.329995,-1.1201476)), dcopula, zlim=c(0,20))
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","r270BB7Copula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","r270BB7Copula"), linkCDVine.ddv)
-
-## random number generator
-setMethod("rCopula", signature("numeric","r270BB7Copula"), linkCDVine.r)
-
+#####################
+## ##
+## 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")
+ if (any(is.na(param) | param >= upper | param[1] < lower[1] | param[2] <= lower[2]))
+ return("Parameter value out of bound.")
+ else return (TRUE)
+}
+
+setClass("BB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+BB7Copula <- function (param) {
+ val <- 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 CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","BB7Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","BB7Copula"), linkCDVine.CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","BB7Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","BB7Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","BB7Copula"), linkCDVine.r)
+
+## kendall distribution/measure, taken from CDVine:::obs.stat
+kendall.BB7 <- function(copula, t){
+ theta = copula at parameters[1]
+ delta = copula at parameters[2]
+
+ kt <- rep(NA,length(t))
+ kt <- t + 1/(theta * delta) * ((1 - (1 - t)^theta)^(-delta) - 1)/
+ ((1 - t)^(theta - 1) * (1 - (1 - t)^theta)^(-delta - 1))
+ kt[t==1] <- 1
+ kt[t==0] <- 0
+ return(kt)
+}
+
+setMethod("kendallDistribution", signature("BB7Copula"), kendall.BB7)
+
+setMethod("getKendallDistr", signature("BB7Copula"),
+ function(copula) return(function(t) kendall.BB7(copula, t)))
+
+#########################
+## BB7 survival copula ##
+#########################
+
+setClass("surBB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+surBB7Copula <- function (param) {
+ val <- 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 CDVine.")
+ return(val)
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","surBB7Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","surBB7Copula"), linkCDVine.surCDF)
+# persp(surBB7Copula(c(5.329995,2.1201476)),pcopula,zlim=c(0,1))
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","surBB7Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","surBB7Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","surBB7Copula"), linkCDVine.r)
+
+####################
+## BB7 copula 90� ##
+####################
+
+validRotBB7Copula = 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")
+ if (any(is.na(param) | param[1] > upper[1] | param[2] >= upper[2] | param <= lower))
+ return("Parameter value out of bound")
+ else return (TRUE)
+}
+
+setClass("r90BB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+r90BB7Copula <- function (param) {
+ val <- new("r90BB7Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, 0), family=29, fullname = "90 deg rotated BB7 copula family. Number 29 in CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r90BB7Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r90BB7Copula"), linkCDVine.r90CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r90BB7Copula"), linkCDVine.ddu)
+
+## ddv
+setMethod("ddvCopula", signature("numeric","r90BB7Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r90BB7Copula"), linkCDVine.r)
+# rcopula(r90BB7Copula(c(-5.329995,-1.1201476)),500)
+
+########################
+## BB7 copula 270 deg ##
+########################
+
+setClass("r270BB7Copula",
+ representation = representation("copula", family="numeric"),
+ validity = validRotBB7Copula,
+ contains = list("copula")
+)
+
+# constructor
+r270BB7Copula <- function (param) {
+ val <- new("r270BB7Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -Inf), param.upbnd = c(-1, -1), family=39, fullname = "270 deg rotated BB7 copula family. Number 39 in CDVine.")
+ val
+}
+
+## density ##
+setMethod("dCopula", signature("numeric","r270BB7Copula"), linkCDVine.PDF)
+
+## jcdf ##
+setMethod("pCopula", signature("numeric","r270BB7Copula"), linkCDVine.r270CDF)
+
+## partial derivatives ##
+# ddu
+setMethod("dduCopula", signature("numeric","r270BB7Copula"), linkCDVine.ddu)
+
+# ddv
+setMethod("ddvCopula", signature("numeric","r270BB7Copula"), linkCDVine.ddv)
+
+## random number generator
+setMethod("rCopula", signature("numeric","r270BB7Copula"), linkCDVine.r)
+
Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R 2012-09-12 11:54:46 UTC (rev 63)
+++ pkg/R/Classes.R 2012-09-28 14:08:05 UTC (rev 64)
@@ -1,164 +1,163 @@
-#################################################################################
-##
-## R package spcopula by Benedikt Gräler Copyright (C) 2011
-##
-## This file is part of the R package spcopula.
-##
-## The R package spcopula is free software: you can redistribute it and/or modify
-## it under the terms of the GNU General Public License as published by
-## the Free Software Foundation, either version 3 of the License, or
-## (at your option) any later version.
-##
-## The R package spcopula 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 General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with the R package spcopula. If not, see <http://www.gnu.org/licenses/>.
-##
-#################################################################################
-## some additional bivariate copulas extending the set of copulas in the package copula
-
-####
-## an asymmetric copula with cubic and qudratic sections
-
-validAsCopula = function(object) {
- if (object at dimension != 2)
- return("Only copulas with cubic quadratic sections 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)
-}
-
-# the lower bound of the parameter a dependening on the parameter b
-limA <- function (b) {
- (b-3-sqrt(9+6*b-3*b^2))/2
-}
-
-setClass("asCopula",
- representation = representation("copula"),
- validity = validAsCopula,
- contains = list("copula")
-)
-
-####
-## a symmetric copula with cubic and quadratic sections
-
-validCqsCopula <- validAsCopula
-
-setClass("cqsCopula",
- representation = representation("copula"),
- validity = validCqsCopula,
- contains = list("copula")
-)
-
-##
-## the spatial copula
-##
-## realized as a distance dependent convex combination of biv copulas
-
-# dimension = "numeric" set to 2
-# parameters = "numeric" set of parameters
-# param.names = "character" appropriate names
-# param.lowbnd = "numeric" appropriate lower bounds
-# param.upbnd = "numeric" appropriate upper bounds
-# message = "character" messgae printed with "show"
-# components="list" list of copulas
-# distances="numeric" the linking distances
-# unit="character" measurement unit of distance
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/spcopula -r 64
More information about the spcopula-commits
mailing list