[spcopula-commits] r69 - / pkg pkg/R pkg/demo pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Nov 30 21:47:32 CET 2012
Author: ben_graeler
Date: 2012-11-30 21:47:31 +0100 (Fri, 30 Nov 2012)
New Revision: 69
Added:
pkg/R/joeBiCopula.R
pkg/man/getKendallDistr.Rd
pkg/man/joeBiCopula-class.Rd
pkg/man/joeBiCopula.Rd
pkg/man/kendallDistribution.Rd
spcopula_1.0.69.tar.gz
spcopula_1.0.69.zip
Removed:
pkg/R/JoeCopula.R
pkg/man/JoeCopula-class.Rd
pkg/man/JoeCopula.Rd
spcopula_1.0.68.tar.gz
spcopula_1.0.68.zip
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/BB1copula.R
pkg/R/BB6copula.R
pkg/R/BB7copula.R
pkg/R/BB8copula.R
pkg/R/Classes.R
pkg/R/ClaytonGumbelCopula.R
pkg/R/asCopula.R
pkg/R/cqsCopula.R
pkg/R/linkingCDVine.R
pkg/R/spcopula.R
pkg/R/utilities.R
pkg/demo/MRP.R
pkg/demo/spcopula_estimation.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-methods.Rd
pkg/man/ddvCopula-methods.Rd
Log:
- some cleaning
- renaming of JoeCopula to joeBiCopula to avoid confusion with joeCopula from the copula package
- further helpfiles
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/DESCRIPTION 2012-11-30 20:47:31 UTC (rev 69)
@@ -1,7 +1,7 @@
Package: spcopula
Type: Package
Title: copula driven spatial analysis
-Version: 1.0.68
+Version: 1.0.69
Date: 2012-11-30
Author: Benedikt Graeler
Maintainer: Benedikt Graeler <ben.graeler at uni-muenster.de>
@@ -23,7 +23,7 @@
BB6copula.R
BB7copula.R
BB8copula.R
- JoeCopula.R
+ joeBiCopula.R
ClaytonGumbelCopula.R
vineCopulas.R
utilities.R
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/NAMESPACE 2012-11-30 20:47:31 UTC (rev 69)
@@ -9,7 +9,7 @@
export(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
export(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
export(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
-export(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
+export(joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula)
export(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
export(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
export(vineCopula)
@@ -45,7 +45,7 @@
exportClasses(BB6Copula, surBB6Copula, r90BB6Copula, r270BB6Copula)
exportClasses(BB7Copula, surBB7Copula, r90BB7Copula, r270BB7Copula)
exportClasses(BB8Copula, surBB8Copula, r90BB8Copula, r270BB8Copula)
-exportClasses(JoeCopula, surJoeCopula, r90JoeCopula, r270JoeCopula)
+exportClasses(joeBiCopula, surJoeBiCopula, r90JoeBiCopula, r270JoeBiCopula)
exportClasses(surClaytonCopula, r90ClaytonCopula, r270ClaytonCopula)
exportClasses(surGumbelCopula, r90GumbelCopula, r270GumbelCopula)
Modified: pkg/R/BB1copula.R
===================================================================
--- pkg/R/BB1copula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/BB1copula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -15,8 +15,6 @@
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)
}
@@ -28,9 +26,11 @@
# constructor
BB1Copula <- function (param) {
- val <- 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 CDVine.")
- val
+ 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 CDVine.")
}
## density ##
@@ -81,6 +81,9 @@
setMethod("getKendallDistr", signature("BB1Copula"), function(copula) return(function(t) kendall.BB1(copula, t)) )
+setMethod("tau",signature("BB1Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("BB1Copula"),linkCDVine.tailIndex)
+
#########################
## BB1 survival copula ##
#########################
@@ -93,8 +96,11 @@
# constructor
surBB1Copula <- function (param) {
- val <- 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 CDVine.")
- val
+ 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 CDVine.")
}
## density ##
@@ -129,6 +135,9 @@
## random number generater ??
setMethod("rCopula", signature("numeric","surBB1Copula"), linkCDVine.r)
+setMethod("tau",signature("surBB1Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("surBB1Copula"),linkCDVine.tailIndex)
+
#######################
## BB1 copula 90 deg ##
#######################
@@ -143,8 +152,6 @@
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)
}
@@ -156,10 +163,13 @@
# constructor
r90BB1Copula <- function (param) {
- val <- 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 CDVine.")
- val
+ 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 CDVine.")
}
-
+BiCopCDF
## density ##
setMethod("dCopula", signature("numeric","r90BB1Copula"),
function(u, copula, ...) {
@@ -192,6 +202,9 @@
## random number generator
setMethod("rCopula", signature("numeric","r90BB1Copula"), linkCDVine.r)
+setMethod("tau",signature("r90BB1Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r90BB1Copula"),linkCDVine.tailIndex)
+
########################
## BB1 copula 270 deg ##
########################
@@ -204,8 +217,11 @@
# constructor
r270BB1Copula <- function (param) {
- val <- 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 CDVine.")
- val
+ 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 CDVine.")
}
## density ##
@@ -238,4 +254,7 @@
setMethod("ddvCopula", signature("matrix","r270BB1Copula"), linkCDVine.ddv)
## random number generator
-setMethod("rCopula", signature("numeric","r270BB1Copula"), linkCDVine.r)
\ No newline at end of file
+setMethod("rCopula", signature("numeric","r270BB1Copula"), linkCDVine.r)
+
+setMethod("tau",signature("r270BB1Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r270BB1Copula"),linkCDVine.tailIndex)
\ No newline at end of file
Modified: pkg/R/BB6copula.R
===================================================================
--- pkg/R/BB6copula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/BB6copula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -28,9 +28,11 @@
# 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
+ 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 CDVine.")
}
## density ##
@@ -82,6 +84,9 @@
setMethod("getKendallDistr", signature("BB6Copula"),
function(copula) return(function(t) kendall.BB6(copula, t)))
+setMethod("tau",signature("BB6Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("BB6Copula"),linkCDVine.tailIndex)
+
#########################
## BB6 survival copula ##
#########################
@@ -94,8 +99,11 @@
# 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
+ 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 CDVine.")
}
## density ##
@@ -130,6 +138,9 @@
## random number generator
setMethod("rCopula", signature("numeric","surBB6Copula"), linkCDVine.r)
+setMethod("tau",signature("surBB6Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("surBB6Copula"),linkCDVine.tailIndex)
+
#######################
## BB6 copula 90 deg ##
#######################
@@ -144,8 +155,6 @@
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)
}
@@ -157,8 +166,11 @@
# 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
+ 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 CDVine.")
}
## density ##
@@ -193,6 +205,9 @@
## random number generator
setMethod("rCopula", signature("numeric","r90BB6Copula"), linkCDVine.r)
+setMethod("tau",signature("r90BB6Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r90BB6Copula"),linkCDVine.tailIndex)
+
###########################
## BB6 copula 270 degree ##
###########################
@@ -205,8 +220,11 @@
# 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
+ 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 CDVine.")
}
## density ##
@@ -239,4 +257,7 @@
setMethod("ddvCopula", signature("matrix","r270BB6Copula"), linkCDVine.ddv)
## random number generator
-setMethod("rCopula", signature("numeric","r270BB6Copula"), linkCDVine.r)
\ No newline at end of file
+setMethod("rCopula", signature("numeric","r270BB6Copula"), linkCDVine.r)
+
+setMethod("tau",signature("r270BB6Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r270BB6Copula"),linkCDVine.tailIndex)
\ No newline at end of file
Modified: pkg/R/BB7copula.R
===================================================================
--- pkg/R/BB7copula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/BB7copula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -15,8 +15,6 @@
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)
}
@@ -28,9 +26,11 @@
# 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
+ 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 CDVine.")
}
## density ##
@@ -83,6 +83,10 @@
setMethod("getKendallDistr", signature("BB7Copula"),
function(copula) return(function(t) kendall.BB7(copula, t)))
+setMethod("tau",signature("BB7Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("BB7Copula"),linkCDVine.tailIndex)
+
+
#########################
## BB7 survival copula ##
#########################
@@ -95,8 +99,11 @@
# 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)
+ 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 CDVine.")
}
## density ##
@@ -131,6 +138,9 @@
## random number generator
setMethod("rCopula", signature("numeric","surBB7Copula"), linkCDVine.r)
+setMethod("tau",signature("surBB7Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("surBB7Copula"),linkCDVine.tailIndex)
+
###################
## BB7 copula 90 ##
###################
@@ -158,8 +168,11 @@
# 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
+ if (any(is.na(param) | param[1] > -1 | param[2] >= 0 | param <= c(-Inf,-Inf)))
+ stop(paste("Parameter values out of bounds: theta: (-Inf,-1], delta: (-Inf,0)."))
+ 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.")
}
## density ##
@@ -193,8 +206,10 @@
## random number generator
setMethod("rCopula", signature("numeric","r90BB7Copula"), linkCDVine.r)
-# rcopula(r90BB7Copula(c(-5.329995,-1.1201476)),500)
+setMethod("tau",signature("r90BB7Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r90BB7Copula"),linkCDVine.tailIndex)
+
########################
## BB7 copula 270 deg ##
########################
@@ -207,8 +222,11 @@
# 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
+ if (any(is.na(param) | param[1] > -1 | param[2] >= 0 | param <= c(-Inf,-Inf)))
+ stop(paste("Parameter values out of bounds: theta: (-Inf,-1], delta: (-Inf,0)."))
+ 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.")
}
## density ##
@@ -243,3 +261,5 @@
## random number generator
setMethod("rCopula", signature("numeric","r270BB7Copula"), linkCDVine.r)
+setMethod("tau",signature("r270BB7Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r270BB7Copula"),linkCDVine.tailIndex)
\ No newline at end of file
Modified: pkg/R/BB8copula.R
===================================================================
--- pkg/R/BB8copula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/BB8copula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -28,9 +28,11 @@
# constructor
BB8Copula <- function (param) {
- val <- new("BB8Copula", dimension = as.integer(2), parameters = param,
- param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, 1), family=10, fullname = "BB8 copula family. Number 10 in CDVine.")
- val
+ if (any(is.na(param)) | param[1] >= Inf | param[2] > 1 | param[1] < 1 | param[2] <= 0)
+ stop("Parameter value out of bound: theta: [1,Inf), delta: (0,1].")
+ new("BB8Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, 1),
+ family=10, fullname = "BB8 copula family. Number 10 in CDVine.")
}
## density ##
@@ -82,6 +84,9 @@
setMethod("getKendallDistr", signature("BB8Copula"),
function(copula) return(function(t) kendall.BB8(copula, t)))
+setMethod("tau",signature("BB8Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("BB8Copula"),linkCDVine.tailIndex)
+
#########################
## BB8 survival copula ##
#########################
@@ -94,8 +99,11 @@
# constructor
surBB8Copula <- function (param) {
- val <- new("surBB8Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, 1), family=20, fullname = "Survival BB8 copula family. Number 20 in CDVine.")
- val
+ if (any(is.na(param)) | param[1] >= Inf | param[2] > 1 | param[1] < 1 | param[2] <= 0)
+ stop("Parameter value out of bound: theta: [1,Inf), delta: (0,1].")
+ new("surBB8Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(1, 0), param.upbnd = c(Inf, 1),
+ family=20, fullname = "Survival BB8 copula family. Number 20 in CDVine.")
}
## density ##
@@ -130,6 +138,9 @@
## random number generator
setMethod("rCopula", signature("numeric","surBB8Copula"), linkCDVine.r)
+setMethod("tau",signature("surBB8Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("surBB8Copula"),linkCDVine.tailIndex)
+
#######################
## BB8 copula 90 deg ##
#######################
@@ -144,8 +155,6 @@
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[1] <= lower[1] | param[2] < lower[2]))
- return("Parameter value out of bound")
else return (TRUE)
}
@@ -157,8 +166,11 @@
# constructor
r90BB8Copula <- function (param) {
- val <- new("r90BB8Copula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -1), param.upbnd = c(-1, 0), family=30, fullname = "90 deg rotated BB8 copula family. Number 30 in CDVine.")
- val
+ if (any(is.na(param) | param[1] > -1 | param[2] >= 0 | param[1] <= -Inf | param[2] < -1))
+ stop("Parameter value out of bound: theta: (-Inf,-1], delta: [-1,0).")
+ new("r90BB8Copula", dimension = as.integer(2), parameters = param,
+ param.names = c("theta", "delta"), param.lowbnd = c(-Inf, -1), param.upbnd = c(-1, 0),
+ family=30, fullname = "90 deg rotated BB8 copula family. Number 30 in CDVine.")
}
## density ##
@@ -193,6 +205,9 @@
## random number generator
setMethod("rCopula", signature("numeric","r90BB8Copula"), linkCDVine.r)
+setMethod("tau",signature("r90BB8Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r90BB8Copula"),linkCDVine.tailIndex)
+
###########################
## BB8 copula 270 degree ##
###########################
@@ -239,4 +254,7 @@
setMethod("ddvCopula", signature("matrix","r270BB8Copula"), linkCDVine.ddv)
## random number generator
-setMethod("rCopula", signature("numeric","r270BB8Copula"), linkCDVine.r)
\ No newline at end of file
+setMethod("rCopula", signature("numeric","r270BB8Copula"), linkCDVine.r)
+
+setMethod("tau",signature("r270BB8Copula"),linkCDVine.tau)
+setMethod("tailIndex",signature("r270BB8Copula"),linkCDVine.tailIndex)
\ No newline at end of file
Modified: pkg/R/Classes.R
===================================================================
--- pkg/R/Classes.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/Classes.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -1,26 +1,3 @@
-#################################################################################
-##
-## 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 quadratic sections
validAsCopula = function(object) {
Modified: pkg/R/ClaytonGumbelCopula.R
===================================================================
--- pkg/R/ClaytonGumbelCopula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/ClaytonGumbelCopula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -69,12 +69,15 @@
setMethod("rCopula", signature("numeric","surClaytonCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("surClaytonCopula"),
+setMethod("iTau", signature("surClaytonCopula"),
function(copula, tau) {
if(tau <= 0) warning("The survival Clayton copula can only represent positive dependence!")
- linkCDVine.calibKendallsTau(copula, max(1e-6,abs(tau)))
+ linkCDVine.iTau(copula, max(1e-6,abs(tau)))
})
+setMethod("tau",signature("surClaytonCopula"),linkCDVine.tau)
+setMethod("tailIndex",signature("surClaytonCopula"),linkCDVine.tailIndex)
+
#######################
## Clayton copula 90 ##
#######################
@@ -140,12 +143,16 @@
setMethod("rCopula", signature("numeric","r90ClaytonCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("r90ClaytonCopula"),
+setMethod("iTau", signature("r90ClaytonCopula"),
function(copula, tau) {
if(tau >= 0) warning("The rotated Clayton copula can only represent negative dependence!")
- linkCDVine.calibKendallsTau(copula, min(-1e-6,-abs(tau)))
+ linkCDVine.iTau(copula, min(-1e-6,-abs(tau)))
})
+setMethod("tau",signature("r90ClaytonCopula"),linkCDVine.tau)
+
+setMethod("tailIndex",signature("r90ClaytonCopula"),linkCDVine.tailIndex)
+
########################
## Clayton copula 270 ##
########################
@@ -196,12 +203,16 @@
setMethod("rCopula", signature("numeric","r270ClaytonCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("r270ClaytonCopula"),
+setMethod("iTau", signature("r270ClaytonCopula"),
function(copula, tau) {
if(tau >= 0) warning("The rotated Clayton copula can only represent negative dependence!")
- linkCDVine.calibKendallsTau(copula, min(-1e-6,-abs(tau)))
+ linkCDVine.iTau(copula, min(-1e-6,-abs(tau)))
})
+setMethod("tau",signature("r270ClaytonCopula"),linkCDVine.tau)
+
+setMethod("tailIndex",signature("r270ClaytonCopula"),linkCDVine.tailIndex)
+
####################################
## ##
## additions to the Gumbel copula ##
@@ -273,12 +284,16 @@
setMethod("rCopula", signature("numeric","surGumbelCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("surGumbelCopula"),
+setMethod("iTau", signature("surGumbelCopula"),
function(copula, tau) {
if(tau < 0) warning("The survival Gumbel copula can only represent non-negative dependence!")
- linkCDVine.calibKendallsTau(copula, max(0,abs(tau)))
+ linkCDVine.iTau(copula, max(0,abs(tau)))
})
+setMethod("tau",signature("surGumbelCopula"),linkCDVine.tau)
+
+setMethod("tailIndex",signature("surGumbelCopula"),linkCDVine.tailIndex)
+
#######################
## Gumbel copula 90 ##
#######################
@@ -344,12 +359,16 @@
setMethod("rCopula", signature("numeric","r90GumbelCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("r90GumbelCopula"),
+setMethod("iTau", signature("r90GumbelCopula"),
function(copula, tau) {
if(tau > 0) warning("The rotated Gumbel copula can only represent non-positive dependence!")
- linkCDVine.calibKendallsTau(copula, min(0,-abs(tau)))
+ linkCDVine.iTau(copula, min(0,-abs(tau)))
})
+setMethod("tau",signature("r90GumbelCopula"),linkCDVine.tau)
+
+setMethod("tailIndex",signature("r90GumbelCopula"),linkCDVine.tailIndex)
+
########################
## Gumbel copula 270 ##
########################
@@ -400,8 +419,12 @@
setMethod("rCopula", signature("numeric","r270GumbelCopula"), linkCDVine.r)
## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("r270GumbelCopula"),
+setMethod("iTau", signature("r270GumbelCopula"),
function(copula, tau) {
if(tau >= 0) warning("The rotated Gumbel copula can only represent negative dependence!")
- linkCDVine.calibKendallsTau(copula, min(-1e-6,-abs(tau)))
- })
\ No newline at end of file
+ linkCDVine.iTau(copula, min(-1e-6,-abs(tau)))
+ })
+
+setMethod("tau",signature("r270GumbelCopula"),linkCDVine.tau)
+
+setMethod("tailIndex",signature("r270GumbelCopula"),linkCDVine.tailIndex)
Deleted: pkg/R/JoeCopula.R
===================================================================
--- pkg/R/JoeCopula.R 2012-11-30 10:54:46 UTC (rev 68)
+++ pkg/R/JoeCopula.R 2012-11-30 20:47:31 UTC (rev 69)
@@ -1,272 +0,0 @@
-####################
-## ##
-## the Joe copula ##
-## ##
-####################
-# Joe, H., (1997). Multivariate Models and Dependence Concepts. Monogra. Stat. Appl. Probab. 73, London: Chapman and Hall.
-
-validJoeCopula = function(object) {
- if (object at dimension != 2)
- return("Only Joe 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("JoeCopula",
- representation = representation("copula", family="numeric"),
- validity = validJoeCopula,
- contains = list("copula")
-)
-
-# constructor
-JoeCopula <- function (param) {
- new("JoeCopula", dimension = as.integer(2), parameters = param, param.names = c("theta"),
- param.lowbnd = 1, param.upbnd = Inf, family=6,
- fullname = "Joe copula family. Number 6 in CDVine.")
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","JoeCopula"),
- function(u, copula, log) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula, log)
- })
-setMethod("dCopula", signature("matrix","JoeCopula"), function(u, copula, log) linkCDVine.PDF(u, copula, log))
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","JoeCopula"),
- function(u, copula, ...) {
- linkCDVine.CDF(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("pCopula", signature("matrix","JoeCopula"), linkCDVine.CDF)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","JoeCopula"),
- function(u, copula, ...) {
- linkCDVine.ddu(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("dduCopula", signature("matrix","JoeCopula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","JoeCopula"),
- function(u, copula, ...) {
- linkCDVine.ddv(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("ddvCopula", signature("matrix","JoeCopula"), linkCDVine.ddv)
-
-## random number generater
-setMethod("rCopula", signature("numeric","JoeCopula"), linkCDVine.r)
-
-## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("JoeCopula"),
- function(copula, tau) {
- if(tau <= 0) warning("The Joe copula can only represent positive dependence!")
- linkCDVine.calibKendallsTau(copula, max(1e-6,abs(tau)))
- })
-
-## kendall distribution/measure, taken from CDVine:::obs.stat
-kendall.Joe <- function(copula, t){
- par = copula at parameters[1]
-
- kt <- rep(NA,length(t))
- kt <- t - (log(1 - (1 - t)^par) * (1 - (1 - t))^par)/(par * (1 - t)^(par - 1))
- kt[t==1] <- 1
- kt[t==0] <- 0
- return(kt)
-}
-
-setMethod("kendallDistribution", signature("JoeCopula"), kendall.Joe)
-
-setMethod("getKendallDistr", signature("JoeCopula"),
- function(copula) return(function(t) kendall.Joe(copula, t)))
-
-#########################
-## Joe survival copula ##
-#########################
-
-setClass("surJoeCopula",
- representation = representation("copula", family="numeric"),
- validity = validJoeCopula,
- contains = list("copula")
-)
-
-# constructor
-surJoeCopula <- function (param) {
- new("surJoeCopula", dimension = as.integer(2), parameters = param, param.names = c("theta", "delta"),
- param.lowbnd = 1, param.upbnd = Inf, family=16,
- fullname = "Survival Joe copula family. Number 16 in CDVine.")
-}
-
-## density ##
-setMethod("dCopula", signature("numeric","surJoeCopula"),
- function(u, copula, ...) {
- linkCDVine.PDF(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("dCopula", signature("matrix","surJoeCopula"), linkCDVine.PDF)
-
-## jcdf ##
-setMethod("pCopula", signature("numeric","surJoeCopula"),
- function(u, copula, ...) {
- linkCDVine.CDF(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("pCopula", signature("matrix","surJoeCopula"), linkCDVine.surCDF)
-
-## partial derivatives ##
-# ddu
-setMethod("dduCopula", signature("numeric","surJoeCopula"),
- function(u, copula, ...) {
- linkCDVine.ddu(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("dduCopula", signature("matrix","surJoeCopula"), linkCDVine.ddu)
-
-# ddv
-setMethod("ddvCopula", signature("numeric","surJoeCopula"),
- function(u, copula, ...) {
- linkCDVine.ddv(matrix(u,ncol=copula at dimension),copula)
- })
-setMethod("ddvCopula", signature("matrix","surJoeCopula"), linkCDVine.ddv)
-
-## random number generater
-setMethod("rCopula", signature("numeric","surJoeCopula"), linkCDVine.r)
-
-## Kendalls tau to parameter conversion
-setMethod("calibKendallsTau", signature("surJoeCopula"),
- function(copula, tau) {
- if(tau <= 0) warning("The survival Joe copula can only represent positive dependence!")
- linkCDVine.calibKendallsTau(copula, max(1e-6,abs(tau)))
- })
-
-###################
-## Joe copula 90 ##
-###################
-
-validRotJoeCopula = function(object) {
- if (object at dimension != 2)
- return("Only Joe 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))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/spcopula -r 69
More information about the spcopula-commits
mailing list