[spcopula-commits] r147 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Aug 14 15:14:05 CEST 2015


Author: ben_graeler
Date: 2015-08-14 15:14:05 +0200 (Fri, 14 Aug 2015)
New Revision: 147

Added:
   pkg/man/bivTailDepFun.Rd
Removed:
   pkg/man/tailDepFun.Rd
Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/cqsCopula.R
   pkg/R/tailDependenceFunctions.R
   pkg/man/criticalLevel.Rd
   pkg/man/kendallRP.Rd
Log:
introduced limit of the tail dependence functions for 2-dimensional copulas in view of paper by Joe et al. (2010) -> rename of tailDepFun to bivTailDepFun

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/DESCRIPTION	2015-08-14 13:14:05 UTC (rev 147)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Copula Driven Spatio-Temporal Analysis
 Version: 0.2-1
-Date: 2015-08-07
+Date: 2015-08-14
 Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
                     email = "ben.graeler at uni-muenster.de"),
              person("Marius", "Appel",role = "ctb"))

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/NAMESPACE	2015-08-14 13:14:05 UTC (rev 147)
@@ -61,8 +61,8 @@
 
 # fitting
 export(fitCorFun, loglikByCopulasLags, loglikByCopulasStLags, fitSpCopula, composeSpCopula)
-export(tailDepFun, lowerTailDepFun, upperTailDepFun)
-export(empTailDepFun, lowerEmpTailDepFun, upperEmpTailDepFun)
+export(bivTailDepFun, lowerBivTailDepFun, upperBivTailDepFun)
+export(empBivTailDepFun, lowerEmpBivTailDepFun, upperEmpBivTailDepFun)
 
 # MRP functions
 export(genEmpKenFun, genInvKenFun)

Modified: pkg/R/cqsCopula.R
===================================================================
--- pkg/R/cqsCopula.R	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/R/cqsCopula.R	2015-08-14 13:14:05 UTC (rev 147)
@@ -402,8 +402,8 @@
 setMethod("iRho",signature="cqsCopula",
           function(copula, rho) {
             switch(copula at fixed,
-                   a=function(copula, rho) c(a,iRhoCQSec.a(copula at parameters[1],rho)), 
-                   b=function(copula, rho) c(iRhoCQSec.b(copula at parameters[2],rho),b),
+                   a=function(copula, rho) c(copula at parameters[1],iRhoCQSec.a(copula at parameters[1],rho)), 
+                   b=function(copula, rho) c(iRhoCQSec.b(copula at parameters[2],rho),copula at parameters[2]),
                    stop("iRho may only be used for cqsCopula with one parameter fixed."))
             })
 

Modified: pkg/R/tailDependenceFunctions.R
===================================================================
--- pkg/R/tailDependenceFunctions.R	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/R/tailDependenceFunctions.R	2015-08-14 13:14:05 UTC (rev 147)
@@ -1,39 +1,45 @@
-# adopted from http://www.r-bloggers.com/copulas-and-tail-dependence-part-1/, 04.11.2013
-
-lowerEmpTailDepFun <- function(u) {
-  empFun <- function(x) sum((u[,1]<=x)&(u[,2]<=x))/sum(u[,1]<=x)
-  function(x) sapply(x,empFun)
-}
-
-upperEmpTailDepFun <- function(u) {
-  empFun <- function(x) sum((u[,1]>=x)&(u[,2]>=x))/sum(u[,1]>=x)
-  function(x) sapply(x,empFun)
-}
-
-empTailDepFun <- function(u) {
-  function(z) {
-    res <- z
-    res[z>0.5] <- upperEmpTailDepFun(u)(z[z>0.5])
-    res[z<=0.5] <- lowerEmpTailDepFun(u)(z[z<=0.5])
-    return(res)
-  }
-}
-
-##
-
-lowerTailDepFun <- function(copula) {
-  function(z) pCopula(cbind(z,z),copula)/z
-}
-
-upperTailDepFun <- function(copula) {
-  function(z) (1-2*z+pCopula(cbind(z,z),copula))/(1-z)
-}
-
-tailDepFun <- function(copula) {
-  function(z) {
-    res <- z
-    res[z>0.5] <- upperTailDepFun(copula)(z[z>0.5])
-    res[z<=0.5] <- lowerTailDepFun(copula)(z[z<=0.5])
-    return(res)
-  }
+# adopted from http://www.r-bloggers.com/copulas-and-tail-dependence-part-1/, 04.11.2013
+
+lowerEmpBivTailDepFun <- function(u) {
+  stopifnot(ncol(u) == 2)
+  empFun <- function(x) sum((u[,1]<=x)&(u[,2]<=x))/sum(u[,1]<=x)
+  function(x) sapply(x,empFun)
+}
+
+upperEmpBivTailDepFun <- function(u) {
+  stopifnot(ncol(u) == 2)
+  empFun <- function(x) sum((u[,1]>=x)&(u[,2]>=x))/sum(u[,1]>=x)
+  function(x) sapply(x,empFun)
+}
+
+empBivTailDepFun <- function(u) {
+  stopifnot(ncol(u) == 2)
+  
+  function(z) {
+    res <- z
+    res[z>0.5] <- upperEmpBivTailDepFun(u)(z[z>0.5])
+    res[z<=0.5] <- lowerEmpBivTailDepFun(u)(z[z<=0.5])
+    return(res)
+  }
+}
+
+##
+
+lowerBivTailDepFun <- function(copula) {
+  stopifnot(copula at dimension == 2)
+  function(z) pCopula(cbind(z,z),copula)/z
+}
+
+upperBivTailDepFun <- function(copula) {
+  stopifnot(copula at dimension == 2)
+  function(z) (1-2*z+pCopula(cbind(z,z),copula))/(1-z)
+}
+
+bivTailDepFun <- function(copula) {
+  function(z) {
+    res <- z
+    res[z>0.5] <- upperBivTailDepFun(copula)(z[z>0.5])
+    res[z<=0.5] <- lowerBivTailDepFun(copula)(z[z<=0.5])
+    return(res)
+  }
 }
\ No newline at end of file

Added: pkg/man/bivTailDepFun.Rd
===================================================================
--- pkg/man/bivTailDepFun.Rd	                        (rev 0)
+++ pkg/man/bivTailDepFun.Rd	2015-08-14 13:14:05 UTC (rev 147)
@@ -0,0 +1,83 @@
+\name{bivTailDepFun}
+\alias{bivTailDepFun}
+\alias{lowerBivTailDepFun}
+\alias{upperBivTailDepFun}
+
+\alias{empBivTailDepFun}
+\alias{lowerEmpBivTailDepFun}
+\alias{upperEmpBivTailDepFun}
+
+\title{
+Tail dependence functions
+}
+\description{
+Functions returning a (empirical) tail dependence function for a bivariate copula (sample). The tail dependence functions can be upper, lower or joint, where values below 0.5 are calculated from the lower tail dependence function and values larger 0.5 for the upper tail dependence function. The definition follows the one by Nelsen (2006, Theorem 5.4.2.). For tail dependence of multivariate copulas, see the papers by Joe et al. (2010) and Nikoloulopoulos et al. (2012).
+}
+\usage{
+bivTailDepFun(copula)
+lowerBivTailDepFun(copula)
+upperBivTailDepFun(copula)
+
+empBivTailDepFun(u)
+lowerEmpBivTailDepFun(u)
+upperEmpBivTailDepFun(u)
+}
+
+\arguments{
+  \item{copula}{
+an object of class \code{\linkS4class{copula}}
+}
+  \item{u}{
+a bivariate sample on (0,1)
+}
+}
+
+\value{
+A function taking arguments from the unit interval (0,1) and returning the corresponding tail index.
+}
+\references{
+Definition: 
+
+Nelsen, Roger B. An introduction to copulas. Vol. 139. Springer Science & Business Media, 2013.
+
+Further reading on multivariate tail dependence:
+
+Joe, Harry, Haijun Li, and Aristidis K. Nikoloulopoulos. "Tail dependence functions and vine copulas." Journal of Multivariate Analysis 101.1 (2010): 252-270.
+
+Nikoloulopoulos, Aristidis K., Harry Joe, and Haijun Li. "Vine copulas with asymmetric tail dependence and applications to financial return data." Computational Statistics & Data Analysis 56.11 (2012): 3659-3673.
+
+Plots inspired by:
+
+\url{http://freakonometrics.blog.free.fr/index.php?post/2012/09/11/Copulas-and-statistical-inference}
+}
+\author{
+Benedikt Graeler
+}
+
+\examples{
+library("VineCopula")
+data("simulatedTriples")
+X <- rankTransform(triples[,c(1,3)])
+  
+tdfEmp <- empBivTailDepFun(X)
+plot(tdfEmp,ylim=c(0,1),
+     ylab="tail dependence index")  
+abline(v=0.5, col="grey")
+
+smplTau <- cor(X,method="kendall")[1,2]
+
+# Gauss
+tdfGauss <- bivTailDepFun(normalCopula(sin(smplTau*pi/2)))
+curve(tdfGauss,add=TRUE,col="blue")
+
+# survival Gumbel
+tdfGumbel <- bivTailDepFun(surGumbelCopula(1/(1-smplTau)))
+curve(tdfGumbel,add=TRUE,col="darkgreen")
+
+# survival BB6 copula
+tdfBB6 <- bivTailDepFun(surBB6Copula(c(4.65,2.28)))
+curve(tdfBB6,add=TRUE,col="red")
+
+legend("bottomleft",c("empircal","Gauss","surv. Gumbel","surv. BB6"),
+       col=c("black","blue","darkgreen","red"),lty=1)
+} 
\ No newline at end of file

Modified: pkg/man/criticalLevel.Rd
===================================================================
--- pkg/man/criticalLevel.Rd	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/man/criticalLevel.Rd	2015-08-14 13:14:05 UTC (rev 147)
@@ -8,7 +8,7 @@
 Kendall distribution or its underlying copula.
 }
 \usage{
-criticalLevel(kendallFun = NULL, KRP = c(100, 1000), mu = 1, copula = NULL)
+criticalLevel(kendallFun, KRP = c(100, 1000), mu = 1, copula)
 }
 \arguments{
   \item{kendallFun}{

Modified: pkg/man/kendallRP.Rd
===================================================================
--- pkg/man/kendallRP.Rd	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/man/kendallRP.Rd	2015-08-14 13:14:05 UTC (rev 147)
@@ -8,7 +8,7 @@
 Kendall distribution or its underlying copula.
 }
 \usage{
-kendallRP(kendallFun = NULL, cl = c(0.99, 0.999), mu = 1, copula = NULL)
+kendallRP(kendallFun, cl = c(0.99, 0.999), mu = 1, copula)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{

Deleted: pkg/man/tailDepFun.Rd
===================================================================
--- pkg/man/tailDepFun.Rd	2015-08-07 14:09:43 UTC (rev 146)
+++ pkg/man/tailDepFun.Rd	2015-08-14 13:14:05 UTC (rev 147)
@@ -1,71 +0,0 @@
-\name{tailDepFun}
-\alias{tailDepFun}
-\alias{lowerTailDepFun}
-\alias{upperTailDepFun}
-
-\alias{empTailDepFun}
-\alias{lowerEmpTailDepFun}
-\alias{upperEmpTailDepFun}
-
-\title{
-Tail dependence functions
-}
-\description{
-Functions returning a (empirical) tail dependence function for a copula (sample). The tail dependence functions can be upper, lower or joint, where values below 0.5 are calculated from the lower tail dependence function and values larger 0.5 for the upper tail dependence function.
-}
-\usage{
-tailDepFun(copula)
-lowerTailDepFun(copula)
-upperTailDepFun(copula)
-
-empTailDepFun(u)
-lowerEmpTailDepFun(u)
-upperEmpTailDepFun(u)
-}
-
-\arguments{
-  \item{copula}{
-an object of class \code{\linkS4class{copula}}
-}
-  \item{u}{
-a bivariate sample on (0,1)
-}
-}
-
-\value{
-A function taking arguments from the unit interval (0,1) and returning the corresponding tail index.
-}
-\references{
-Inspired by: \url{http://freakonometrics.blog.free.fr/index.php?post/2012/09/11/Copulas-and-statistical-inference}
-}
-\author{
-Benedikt Graeler
-}
-
-\examples{
-library("VineCopula")
-data("simulatedTriples")
-X <- rankTransform(triples[,c(1,3)])
-  
-tdfEmp <- empTailDepFun(X)
-plot(tdfEmp,ylim=c(0,1),
-     ylab="tail dependence index")  
-abline(v=0.5, col="grey")
-
-smplTau <- cor(X,method="kendall")[1,2]
-
-# Gauss
-tdfGauss <- tailDepFun(normalCopula(sin(smplTau*pi/2)))
-curve(tdfGauss,add=TRUE,col="blue")
-
-# survival Gumbel
-tdfGumbel <- tailDepFun(surGumbelCopula(1/(1-smplTau)))
-curve(tdfGumbel,add=TRUE,col="darkgreen")
-
-# survival BB6 copula
-tdfBB6 <- tailDepFun(surBB6Copula(c(4.65,2.28)))
-curve(tdfBB6,add=TRUE,col="red")
-
-legend("bottomleft",c("empircal","Gauss","surv. Gumbel","surv. BB6"),
-       col=c("black","blue","darkgreen","red"),lty=1)
-} 
\ No newline at end of file



More information about the spcopula-commits mailing list