[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