[Vinecopula-commits] r109 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Di Aug 4 16:08:16 CEST 2015
Author: tnagler
Date: 2015-08-04 16:08:16 +0200 (Tue, 04 Aug 2015)
New Revision: 109
Added:
pkg/R/BiCopCheck.R
Modified:
pkg/R/BiCop.R
pkg/R/BiCopCDF.r
pkg/R/BiCopDeriv.r
pkg/R/BiCopDeriv2.r
pkg/R/BiCopGofTest.r
pkg/R/BiCopHfunc.r
pkg/R/BiCopHfuncDeriv.r
pkg/R/BiCopHfuncDeriv2.r
pkg/R/BiCopLambda.r
pkg/R/BiCopMetaContour.r
pkg/R/BiCopPDF.r
pkg/R/BiCopPar2Beta.r
pkg/R/BiCopPar2TailDep.r
pkg/R/BiCopPar2Tau.r
pkg/R/BiCopSim.R
pkg/R/RVineMatrix.R
Log:
- add function BiCopCheck (internal) for checking of family/parameter consistency
- code cosmetics
Modified: pkg/R/BiCop.R
===================================================================
--- pkg/R/BiCop.R 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCop.R 2015-08-04 14:08:16 UTC (rev 109)
@@ -1,90 +1,7 @@
BiCop <- function(family, par, par2 = 0) {
## family/parameter consistency checks
- if (!(family %in% c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
- 13, 14, 16, 17, 18, 19, 20,
- 23, 24, 26, 27, 28, 29, 30,
- 33, 34, 36, 37, 38, 39, 40,
- 41, 51, 61, 71,
- 104, 114, 124, 134,
- 204, 214, 224, 234)))
- stop("Copula family not implemented.")
- if (family %in% c(2, 7, 8, 9, 10,
- 17, 18, 19, 20,
- 27, 28, 29, 30,
- 37, 38, 39, 40,
- 104, 114, 124, 134,
- 204, 214, 224, 234) && par2 == 0)
- stop("For t-, BB1, BB6, BB7, BB8 and Tawn copulas, 'par2' must be set.")
- if (family %in% c(1, 3, 4, 5, 6,
- 13, 14, 16,
- 23, 24, 26,
- 33, 34, 36,
- 41, 51, 61, 71) && length(par) < 1)
- stop("'par' not set.")
+ BiCopCheck(family, par, par2)
- if ((family == 1 || family == 2) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
- if (family == 2 && par2 <= 2)
- stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 7 || family == 17) && par <= 0)
- stop("The first parameter of the BB1 copula has to be positive.")
- if ((family == 7 || family == 17) && par2 < 1)
- stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par <= 0)
- stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par2 < 1)
- stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par < 1)
- stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par2 <= 0)
- stop("The second parameter of the BB7 copula has to be positive.")
- if ((family == 10 || family == 20) && par < 1)
- stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
- if ((family == 10 || family == 20) && (par2 <= 0 || par2 > 1))
- stop("The second parameter of the BB8 copula has to be in the interval (0,1].")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
- if ((family == 27 || family == 37) && par >= 0)
- stop("The first parameter of the rotated BB1 copula has to be negative.")
- if ((family == 27 || family == 37) && par2 > -1)
- stop("The second parameter of the rotated BB1 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par >= 0)
- stop("The first parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par2 > -1)
- stop("The second parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par > -1)
- stop("The first parameter of the rotated BB7 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par2 >= 0)
- stop("The second parameter of the rotated BB7 copula has to be negative.")
- if ((family == 30 || family == 40) && par > -1)
- stop("The first parameter of the rotated BB8 copula has to be in the interval (-oo,-1].")
- if ((family == 30 || family == 40) && (par2 >= 0 || par2 < (-1)))
- stop("The second parameter of the rotated BB8 copula has to be in the interval [-1,0).")
- if ((family == 41 || family == 51) && par <= 0)
- stop("The parameter of the reflection asymmetric copula has to be positive.")
- if ((family == 61 || family == 71) && par >= 0)
- stop("The parameter of the rotated reflection asymmetric copula has to be negative.")
- if ((family == 104 || family == 114 || family == 204 || family == 214) && par < 1)
- stop("Please choose 'par' of the Tawn copula in [1,oo).")
- if ((family == 104 || family == 114 || family == 204 || family == 214) && (par2 < 0 || par2 > 1))
- stop("Please choose 'par2' of the Tawn copula in [0,1].")
- if ((family == 124 || family == 134 || family == 224 || family == 234) && par > -1)
- stop("Please choose 'par' of the Tawn copula in (-oo,-1].")
- if ((family == 124 || family == 134 || family == 224 || family == 234) && (par2 < 0 || par2 > 1))
- stop("Please choose 'par2' of the Tawn copula in [0,1].")
-
## return BiCop object
out <- list(family = family, par = par, par2 = par2)
class(out) <- "BiCop"
Modified: pkg/R/BiCopCDF.r
===================================================================
--- pkg/R/BiCopCDF.r 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCopCDF.r 2015-08-04 14:08:16 UTC (rev 109)
@@ -14,19 +14,15 @@
family <- NA
if (missing(par))
par <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
if (!is.null(obj)) {
stopifnot(class(obj) == "BiCop")
family <- obj$family
par <- obj$par
par2 <- obj$par2
}
- if (class(family) == "BiCop") {
- # for short hand usage extract from family
- obj <- family
- family <- obj$family
- par <- obj$par
- par2 <- obj$par2
- }
## sanity checks for family and parameters
if (is.na(family) | is.na(par))
@@ -43,70 +39,8 @@
if (family %in% c(1, 3, 4, 5, 6, 13, 14, 16, 23, 24, 26, 33, 34, 36, 41, 51,
61, 71) && length(par) < 1)
stop("'par' not set.")
+ BiCopCheck(family, par, par2)
- if ((family == 1) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian has to be in the interval (-1,1).")
- # if(family==2 && par2<=2) stop('The degrees of freedom parameter of the t-copula
- # has to be larger than 2.')
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 7 || family == 17) && par <= 0)
- stop("The first parameter of the BB1 copula has to be positive.")
- if ((family == 7 || family == 17) && par2 < 1)
- stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par <= 0)
- stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par2 < 1)
- stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par < 1)
- stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par2 <= 0)
- stop("The second parameter of the BB7 copula has to be positive.")
- if ((family == 10 || family == 20) && par < 1)
- stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
- if ((family == 10 || family == 20) && (par2 <= 0 || par2 > 1))
- stop("The second parameter of the BB8 copula has to be in the interval (0,1].")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
- if ((family == 27 || family == 37) && par >= 0)
- stop("The first parameter of the rotated BB1 copula has to be negative.")
- if ((family == 27 || family == 37) && par2 > -1)
- stop("The second parameter of the rotated BB1 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par >= 0)
- stop("The first parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par2 > -1)
- stop("The second parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par > -1)
- stop("The first parameter of the rotated BB7 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par2 >= 0)
- stop("The second parameter of the rotated BB7 copula has to be negative.")
- if ((family == 30 || family == 40) && par > -1)
- stop("The first parameter of the rotated BB8 copula has to be in the interval (-oo,-1].")
- if ((family == 30 || family == 40) && (par2 >= 0 || par2 < (-1)))
- stop("The second parameter of the rotated BB8 copula has to be in the interval [-1,0).")
- if ((family == 41 || family == 51) && par <= 0)
- stop("The parameter of the reflection asymmetric copula has to be positive.")
- if ((family == 61 || family == 71) && par >= 0)
- stop("The parameter of the rotated reflection asymmetric copula has to be negative.")
- if ((family == 104 || family == 114 || family == 204 || family == 214) && par < 1)
- stop("Please choose 'par' of the Tawn copula in [1,oo).")
- if ((family == 104 || family == 114 || family == 204 || family == 214) && (par2 < 0 || par2 > 1))
- stop("Please choose 'par2' of the Tawn copula in [0,1].")
- if ((family == 124 || family == 134 || family == 224 || family == 234) && par > -1)
- stop("Please choose 'par' of the Tawn copula in (-oo,-1].")
- if ((family == 124 || family == 134 || family == 224 || family == 234) && (par2 < 0 || par2 > 1))
- stop("Please choose 'par2' of the Tawn copula in [0,1].")
-
res <- rep(NA, length(u1))
## CDFs for the different families
Added: pkg/R/BiCopCheck.R
===================================================================
--- pkg/R/BiCopCheck.R (rev 0)
+++ pkg/R/BiCopCheck.R 2015-08-04 14:08:16 UTC (rev 109)
@@ -0,0 +1,106 @@
+BiCopCheck <- function(family, par, par2 = 0, obj = NULL) {
+ ## extract family and parameters if BiCop object is provided
+ if (missing(family))
+ family <- NA
+ if (missing(par))
+ par <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
+ if (!is.null(obj)) {
+ stopifnot(class(obj) == "BiCop")
+ family <- obj$family
+ par <- obj$par
+ par2 <- obj$par2
+ }
+
+ ## sanity checks for family and parameters
+ if (is.na(family) | is.na(par))
+ stop("Provide either 'family' and 'par' or 'obj'")
+ if (!(family %in% c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 13, 14, 16, 17, 18, 19,
+ 20, 23, 24, 26, 27, 28, 29, 30, 33, 34, 36, 37, 38, 39,
+ 40, 41, 42, 51, 52, 61, 62, 71, 72,
+ 104, 114, 124, 134, 204, 214, 224, 234)))
+ stop("Copula family not implemented.")
+ if (c(2, 7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40, 42, 52,
+ 62, 72, 104, 114, 124, 134, 204, 214, 224, 234) %in% family && par2 == 0)
+ stop("For t-, BB1, BB6, BB7, BB8 and Tawn copulas, 'par2' must be set.")
+ if (c(1, 3, 4, 5, 6, 11, 13, 14, 16, 23, 24, 26, 33, 34, 36, 41, 51, 61, 71) %in%
+ family && length(par) < 1)
+ stop("'par' not set.")
+
+ if ((family == 1 || family == 2) && abs(par[1]) >= 1)
+ stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
+ if (family == 2 && par2 <= 2)
+ stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
+ if ((family == 3 || family == 13) && par <= 0)
+ stop("The parameter of the Clayton copula has to be positive.")
+ if ((family == 4 || family == 14) && par < 1)
+ stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
+ if ((family == 6 || family == 16) && par <= 1)
+ stop("The parameter of the Joe copula has to be in the interval (1,oo).")
+ if (family == 5 && par == 0)
+ stop("The parameter of the Frank copula has to be unequal to 0.")
+ if ((family == 7 || family == 17) && par <= 0)
+ stop("The first parameter of the BB1 copula has to be positive.")
+ if ((family == 7 || family == 17) && par2 < 1)
+ stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
+ if ((family == 8 || family == 18) && par <= 0)
+ stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
+ if ((family == 8 || family == 18) && par2 < 1)
+ stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
+ if ((family == 9 || family == 19) && par < 1)
+ stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
+ if ((family == 9 || family == 19) && par2 <= 0)
+ stop("The second parameter of the BB7 copula has to be positive.")
+ if ((family == 10 || family == 20) && par < 1)
+ stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
+ if ((family == 10 || family == 20) && (par2 <= 0 || par2 > 1))
+ stop("The second parameter of the BB8 copula has to be in the interval (0,1].")
+ if ((family == 23 || family == 33) && par >= 0)
+ stop("The parameter of the rotated Clayton copula has to be negative.")
+ if ((family == 24 || family == 34) && par > -1)
+ stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
+ if ((family == 26 || family == 36) && par >= -1)
+ stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
+ if ((family == 27 || family == 37) && par >= 0)
+ stop("The first parameter of the rotated BB1 copula has to be negative.")
+ if ((family == 27 || family == 37) && par2 > -1)
+ stop("The second parameter of the rotated BB1 copula has to be in the interval (-oo,-1].")
+ if ((family == 28 || family == 38) && par >= 0)
+ stop("The first parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
+ if ((family == 28 || family == 38) && par2 > -1)
+ stop("The second parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
+ if ((family == 29 || family == 39) && par > -1)
+ stop("The first parameter of the rotated BB7 copula has to be in the interval (-oo,-1].")
+ if ((family == 29 || family == 39) && par2 >= 0)
+ stop("The second parameter of the rotated BB7 copula has to be negative.")
+ if ((family == 30 || family == 40) && par > -1)
+ stop("The first parameter of the rotated BB8 copula has to be in the interval (-oo,-1].")
+ if ((family == 30 || family == 40) && (par2 >= 0 || par2 < (-1)))
+ stop("The second parameter of the rotated BB8 copula has to be in the interval [-1,0).")
+ if ((family == 41 || family == 51) && par <= 0)
+ stop("The parameter of the reflection asymmetric copula has to be positive.")
+ if ((family == 61 || family == 71) && par >= 0)
+ stop("The parameter of the rotated reflection asymmetric copula has to be negative.")
+ if (family == 42) {
+ a <- par
+ b <- par2
+ limA <- (b - 3 - sqrt(9 + 6 * b - 3 * b^2))/2
+ if (abs(b) > 1)
+ stop("The second parameter of the two-parametric asymmetric copulas has to be in the interval [-1,1]")
+ if (a > 1 || a < limA)
+ stop("The first parameter of the two-parametric asymmetric copula has to be in the interval [limA(par2),1]")
+ }
+ if ((family == 104 || family == 114 || family == 204 || family == 214) && par < 1)
+ stop("Please choose 'par' of the Tawn copula in [1,oo).")
+ if ((family == 104 || family == 114 || family == 204 || family == 214) && (par2 < 0 || par2 > 1))
+ stop("Please choose 'par2' of the Tawn copula in [0,1].")
+ if ((family == 124 || family == 134 || family == 224 || family == 234) && par > -1)
+ stop("Please choose 'par' of the Tawn copula in (-oo,-1].")
+ if ((family == 124 || family == 134 || family == 224 || family == 234) && (par2 < 0 || par2 > 1))
+ stop("Please choose 'par2' of the Tawn copula in [0,1].")
+
+ ## return TRUE if all checks pass
+ TRUE
+}
\ No newline at end of file
Modified: pkg/R/BiCopDeriv.r
===================================================================
--- pkg/R/BiCopDeriv.r 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCopDeriv.r 2015-08-04 14:08:16 UTC (rev 109)
@@ -14,21 +14,15 @@
family <- NA
if (missing(par))
par <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
if (!is.null(obj)) {
stopifnot(class(obj) == "BiCop")
family <- obj$family
par <- obj$par
par2 <- obj$par2
}
- if (class(family) == "BiCop") {
- # for short hand usage extract from family
- if (class(par) == "character")
- deriv <- par
- obj <- family
- family <- obj$family
- par <- obj$par
- par2 <- obj$par2
- }
## sanity checks for family and parameters
if (is.na(family) | is.na(par))
@@ -39,29 +33,11 @@
stop("For t-copulas, 'par2' must be set.")
if (family %in% c(1, 3, 4, 5, 6, 13, 14, 16, 23, 24, 26, 33, 34, 36) && length(par) < 1)
stop("'par' not set.")
- if ((family == 1 || family == 2) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
- if (family == 2 && par2 <= 2)
- stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
-
if (deriv == "par2" && family != 2)
stop("The derivative with respect to the second parameter can only be derived for the t-copula.")
if (log == TRUE && (deriv %in% c("u1", "u2")))
stop("The derivative with respect to one of the arguments are not available in the log case.")
+ BiCopCheck(family, par, par2)
## call C routines for specified 'deriv' case
n <- length(u1)
Modified: pkg/R/BiCopDeriv2.r
===================================================================
--- pkg/R/BiCopDeriv2.r 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCopDeriv2.r 2015-08-04 14:08:16 UTC (rev 109)
@@ -14,21 +14,15 @@
family <- NA
if (missing(par))
par <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
if (!is.null(obj)) {
stopifnot(class(obj) == "BiCop")
family <- obj$family
par <- obj$par
par2 <- obj$par2
}
- if (class(family) == "BiCop") {
- # for short hand usage extract from family
- if (class(par) == "character")
- deriv <- par
- obj <- family
- family <- obj$family
- par <- obj$par
- par2 <- obj$par2
- }
## sanity checks for family and parameters
if (is.na(family) | is.na(par))
@@ -37,35 +31,12 @@
stop("Copula family not implemented.")
if (family == 2 && par2 == 0)
stop("For t-copulas, 'par2' must be set.")
- if (family %in% c(1, 3, 4, 5, 6, 13, 14, 16, 23, 24, 26, 33, 34, 36) && length(par) < 1)
- stop("'par' not set.")
-
- if ((family == 1 || family == 2) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
- if (family == 2 && par2 <= 2)
- stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
-
if (deriv == "par2" && family != 2)
stop("The derivative with respect to the second parameter can only be derived for the t-copula.")
+ BiCopCheck(family, par, par2)
- # Unterscheidung in die verschiedenen Ableitungen
-
+ ## calculate derivatives
n <- length(u1)
-
if (deriv == "par") {
if (family == 2) {
out <- .C("diff2PDF_rho_tCopula",
Modified: pkg/R/BiCopGofTest.r
===================================================================
--- pkg/R/BiCopGofTest.r 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCopGofTest.r 2015-08-04 14:08:16 UTC (rev 109)
@@ -18,19 +18,15 @@
## extract family and parameters if BiCop object is provided
if (missing(family))
family <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
if (!is.null(obj)) {
stopifnot(class(obj) == "BiCop")
family <- obj$family
par <- obj$par
par2 <- obj$par2
}
- if (class(family) == "BiCop") {
- # for short hand usage extract from family
- obj <- family
- family <- obj$family
- par <- obj$par
- par2 <- obj$par2
- }
## sanity checks for family and parameters
if (is.na(family))
@@ -42,59 +38,8 @@
stop("For t-, BB1, BB6, BB7 and BB8 copulas, 'par2' must be set.")
if (c(1, 3, 4, 5, 6, 13, 14, 16, 23, 24, 26, 33, 34, 36) %in% family && length(par) < 1)
stop("'par' not set.")
-
- if (par != 0) {
- if ((family == 1 || family == 2) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
- if (family == 2 && par2 <= 2)
- stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 7 || family == 17) && par <= 0)
- stop("The first parameter of the BB1 copula has to be positive.")
- if ((family == 7 || family == 17) && par2 < 1)
- stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par <= 0)
- stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par2 < 1)
- stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par < 1)
- stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par2 <= 0)
- stop("The second parameter of the BB7 copula has to be positive.")
- if ((family == 10 || family == 20) && par < 1)
- stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
- if ((family == 10 || family == 20) && (par2 <= 0 || par2 > 1))
- stop("The second parameter of the BB8 copula has to be in the interval (0,1].")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
- if ((family == 27 || family == 37) && par >= 0)
- stop("The first parameter of the rotated BB1 copula has to be negative.")
- if ((family == 27 || family == 37) && par2 > -1)
- stop("The second parameter of the rotated BB1 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par >= 0)
- stop("The first parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 28 || family == 38) && par2 > -1)
- stop("The second parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par > -1)
- stop("The first parameter of the rotated BB7 copula has to be in the interval (-oo,-1].")
- if ((family == 29 || family == 39) && par2 >= 0)
- stop("The second parameter of the rotated BB7 copula has to be negative.")
- if ((family == 30 || family == 40) && par > -1)
- stop("The first parameter of the rotated BB8 copula has to be in the interval (-oo,-1].")
- if ((family == 30 || family == 40) && (par2 >= 0 || par2 < (-1)))
- stop("The second parameter of the rotated BB8 copula has to be in the interval [-1,0).")
- }
+ if (par != 0)
+ BiCopCheck(family, par, par2)
if (family == 2 && method == "kendall")
stop("The goodness-of-fit test based on Kendall's process is not implemented for the t-copula.")
if (family %in% c(7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40) &&
Modified: pkg/R/BiCopHfunc.r
===================================================================
--- pkg/R/BiCopHfunc.r 2015-08-04 12:42:28 UTC (rev 108)
+++ pkg/R/BiCopHfunc.r 2015-08-04 14:08:16 UTC (rev 109)
@@ -25,119 +25,38 @@
family <- NA
if (missing(par))
par <- NA
+ # for short hand usage extract obj from family
+ if (class(family) == "BiCop")
+ obj <- family
if (!is.null(obj)) {
stopifnot(class(obj) == "BiCop")
family <- obj$family
par <- obj$par
par2 <- obj$par2
}
- if (class(family) == "BiCop") {
- # for short hand usage extract from family
- obj <- family
- family <- obj$family
- par <- obj$par
- par2 <- obj$par2
- }
-
+
## sanity checks for family and parameters
- if (is.na(family) | is.na(par))
- stop("Provide either 'family' and 'par' or 'obj'")
- if (!(family %in% c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 13, 14, 16, 17, 18, 19,
- 20, 23, 24, 26, 27, 28, 29, 30, 33, 34, 36, 37, 38, 39,
- 40, 41, 42, 51, 52, 61, 62, 71, 72,
- 104, 114, 124, 134, 204, 214, 224, 234)))
- stop("Copula family not implemented.")
- if (c(2, 7, 8, 9, 10, 17, 18, 19, 20, 27, 28, 29, 30, 37, 38, 39, 40, 42, 52,
- 62, 72, 104, 114, 124, 134, 204, 214, 224, 234) %in% family && par2 == 0)
- stop("For t-, BB1, BB6, BB7, BB8 and Tawn copulas, 'par2' must be set.")
- if (c(1, 3, 4, 5, 6, 11, 13, 14, 16, 23, 24, 26, 33, 34, 36, 41, 51, 61, 71) %in%
- family && length(par) < 1)
- stop("'par' not set.")
+ BiCopCheck(family, par, par2)
- if ((family == 1 || family == 2) && abs(par[1]) >= 1)
- stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
- if (family == 2 && par2 <= 2)
- stop("The degrees of freedom parameter of the t-copula has to be larger than 2.")
- if ((family == 3 || family == 13) && par <= 0)
- stop("The parameter of the Clayton copula has to be positive.")
- if ((family == 4 || family == 14) && par < 1)
- stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
- if ((family == 6 || family == 16) && par <= 1)
- stop("The parameter of the Joe copula has to be in the interval (1,oo).")
- if (family == 5 && par == 0)
- stop("The parameter of the Frank copula has to be unequal to 0.")
- if ((family == 7 || family == 17) && par <= 0)
- stop("The first parameter of the BB1 copula has to be positive.")
- if ((family == 7 || family == 17) && par2 < 1)
- stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par <= 0)
- stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 8 || family == 18) && par2 < 1)
- stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par < 1)
- stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
- if ((family == 9 || family == 19) && par2 <= 0)
- stop("The second parameter of the BB7 copula has to be positive.")
- if ((family == 10 || family == 20) && par < 1)
- stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
- if ((family == 10 || family == 20) && (par2 <= 0 || par2 > 1))
- stop("The second parameter of the BB8 copula has to be in the interval (0,1].")
- if ((family == 23 || family == 33) && par >= 0)
- stop("The parameter of the rotated Clayton copula has to be negative.")
- if ((family == 24 || family == 34) && par > -1)
- stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
- if ((family == 26 || family == 36) && par >= -1)
- stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
- if ((family == 27 || family == 37) && par >= 0)
- stop("The first parameter of the rotated BB1 copula has to be negative.")
- if ((family == 27 || family == 37) && par2 > -1)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/vinecopula -r 109
Mehr Informationen über die Mailingliste Vinecopula-commits