[Vinecopula-commits] r107 - in pkg: . R inst

[noreply at r-forge.r-project.org]

Author: ben_graeler
Date: 2015-08-03 14:56:46 +0200 (Mon, 03 Aug 2015)
New Revision: 107

Modified:
   pkg/DESCRIPTION
   pkg/R/tawnCopula.R
   pkg/inst/ChangeLog
Log:
- Added methods for Pickand's dependence function "A" for tawnT1Copula, surTawnT1Copula, tawnT2Copula and surTawnT2Copula

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2015-07-30 13:09:51 UTC (rev 106)
+++ pkg/DESCRIPTION	2015-08-03 12:56:46 UTC (rev 107)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Statistical Inference of Vine Copulas
 Version: 1.7
-Date: 2015-07-30
+Date: 2015-08-03
 Author: Ulf Schepsmeier, Jakob Stoeber, Eike Christian Brechmann, Benedikt Graeler, Thomas Nagler, Tobias Erhardt
 Maintainer: Tobias Erhardt <tobias.erhardt at tum.de>
 Depends: R (>= 2.11.0)

Modified: pkg/R/tawnCopula.R
===================================================================
--- pkg/R/tawnCopula.R	2015-07-30 13:09:51 UTC (rev 106)
+++ pkg/R/tawnCopula.R	2015-08-03 12:56:46 UTC (rev 107)
@@ -68,6 +68,14 @@
 setMethod("tau",signature("tawnT1Copula"),linkVineCop.tau)
 setMethod("tailIndex",signature("tawnT1Copula"),linkVineCop.tailIndex)
 
+# Pickand's A
+# c-code: Tawn2(double* t, int* n, double* par, double* par2, double* par3, double* out)
+setMethod("A", signature("tawnT1Copula"), function(copula, w) {
+  .C("Tawn2",as.double(w), as.integer(length(w)), 
+     as.double(copula at parameters[1]), as.double(copula at parameters[2]),
+     as.double(1), as.double(rep(0,length(w))), PACKAGE = "VineCopula")[[6]]
+})
+
 #################################
 ## Tawn type 1 survival copula ##
 #################################
@@ -123,6 +131,19 @@
 setMethod("tau",signature("surTawnT1Copula"),linkVineCop.tau)
 setMethod("tailIndex",signature("surTawnT1Copula"),linkVineCop.tailIndex)
 
+# Pickand's A
+# c-code: Tawn2(double* t, int* n, double* par, double* par2, double* par3, double* out)
+setMethod("A", signature("surTawnT1Copula"), function(copula, w) {
+  u <- -expm1(-1+w)
+  v <- -expm1(-w)
+  
+  surA <- .C("Tawn2",as.double(log(v)/log(u*v)), as.integer(length(w)), 
+             as.double(copula at parameters[1]), as.double(copula at parameters[2]),
+             as.double(1), as.double(rep(0,length(w))), PACKAGE = "VineCopula")[[6]]
+  -log(1-u + 1-v - 1 + (u*v)^surA)
+  # -log(1-u + 1-v - 1 + VineCopula:::linkVineCop.CDFtawn(cbind(u,v), tawnT1Copula(copula at parameters)))
+})
+
 #######################################
 ## Tawn type 1 90 deg. rotate copula ##
 #######################################
@@ -290,8 +311,17 @@
 setMethod("tau",signature("tawnT2Copula"),linkVineCop.tau)
 setMethod("tailIndex",signature("tawnT2Copula"),linkVineCop.tailIndex)
 
+# Pickand's A
+# c-code: Tawn2(double* t, int* n, double* par, double* par2, double* par3, double* out)
+setMethod("A", signature("tawnT2Copula"), function(copula, w) {
+  .C("Tawn2",as.double(w), as.integer(length(w)), 
+     as.double(copula at parameters[1]), as.double(1),
+     as.double(copula at parameters[2]),
+     as.double(rep(0,length(w))), PACKAGE = "VineCopula")[[6]]
+})
+
 #################################
-## Tawn type 1 survival copula ##
+## Tawn type 2 survival copula ##
 #################################
 
 setClass("surTawnT2Copula",
@@ -345,8 +375,21 @@
 setMethod("tau",signature("surTawnT2Copula"),linkVineCop.tau)
 setMethod("tailIndex",signature("surTawnT2Copula"),linkVineCop.tailIndex)
 
+# Pickand's A
+# c-code: Tawn2(double* t, int* n, double* par, double* par2, double* par3, double* out)
+setMethod("A", signature("surTawnT2Copula"), function(copula, w) {
+  u <- -expm1(-1+w) # 1-u
+  v <- -expm1(-w)   # 1-v
+  
+  surA <- .C("Tawn2",as.double(log(v)/log(u*v)), as.integer(length(w)), 
+             as.double(copula at parameters[1]), as.double(1),
+             as.double(copula at parameters[2]), 
+             as.double(rep(0,length(w))), PACKAGE = "VineCopula")[[6]]
+  -log(1-u + 1-v - 1 + (u*v)^surA)
+})
+
 #######################################
-## Tawn type 1 90 deg. rotate copula ##
+## Tawn type 2 90 deg. rotate copula ##
 #######################################
 
 setClass("r90TawnT2Copula",
@@ -401,7 +444,7 @@
 setMethod("tailIndex",signature("r90TawnT2Copula"),linkVineCop.tailIndex)
 
 ########################################
-## Tawn type 1 270 deg. rotate copula ##
+## Tawn type 2 270 deg. rotate copula ##
 ########################################
 
 setClass("r270TawnT2Copula",

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2015-07-30 13:09:51 UTC (rev 106)
+++ pkg/inst/ChangeLog	2015-08-03 12:56:46 UTC (rev 107)
@@ -9,6 +9,7 @@
   * The S4-class objets of the Tawn copulas pointed to Archimedean CDFs, now corrected to true CDFs based on c-code
   * TauMatrix: restriction for input data to be in [0,1] removed
   * RVineCopSelect: no printing of family-Matrix
+  * Added methods for Pickand's dependence function "A" for tawnT1Copula, surTawnT1Copula, tawnT2Copula and surTawnT2Copula
 
 Version 1.6 (July 16, 2015)