Learn R Programming

copBasic (version 2.1.4)

tEVcop: The t-EV (Extreme Value) Copula

Description

The t-EV copula (Joe, 2014, p. 189) is a limiting form of the t-copula (multivariate t-distribution): $$ \mathbf{C}_{\rho,\nu}(u,v) = \mathbf{tEV}(u,v; \rho, \nu) = \mathrm{exp}\bigl(-(x+y)B(x/(x+y); \rho, \nu)\bigr)\mbox{,} $$ where \(x = -\log(u)\), \(y = -\log(v)\), and letting \(\eta = \sqrt{(\nu+1)/(1-\rho^2)}\) define $$ B(w; \rho, \nu) = wT_{\nu+1}\bigl(\eta[(w/[1-w])^{1/\nu}-\rho]\bigr) + (1-w)T_{\nu+1}\bigl(\eta[([1-w]/w)^{1/\nu}-\rho]\bigr)\mbox{,} $$ where \(T_{\nu+1}\) is the cumulative distribution function of the univariate t-distribution with \(\nu-1\) degrees of freedom. As \(\nu \rightarrow \infty\), the copula weakly converges to the H<U+00FC>sler--Reiss copula (HRcop) because the t-distribution converges to the normal (see Examples for a study of this copula).

The \(\mathbf{tEV}(u,v; \rho, \nu)\) copula is a two-parameter option when working with extreme-value copula. There is a caveat though. Demarta and McNeil (2004) conclude that “the parameter of the Gumbel [GHcop] or Galambos [GLcop] A-functions [the Pickend dependence function and B-function by association] can always be chosen so that the curve is extremely close to that of the t-EV A-function for any values of \(\nu\) and \(\rho\). The implication is that in all situations where the t-EV copula might be deemed an appropriate model we can work instead with the simpler Gumbel or Galambos copulas.”

Usage

tEVcop(u, v, para=NULL, ...)

Arguments

u

Nonexceedance probability \(u\) in the \(X\) direction;

v

Nonexceedance probability \(v\) in the \(Y\) direction;

para

A vector (two element) of parameters in \(\rho\) and \(\nu\) order; and

...

Additional arguments to pass.

Value

Value(s) for the copula are returned.

References

Joe, H., 2014, Dependence modeling with copulas: Boca Raton, CRC Press, 462 p.

Demarta, S., and McNeil, A.J., 2004, The t copula and related copulas: International Statistical Review, v. 33, no. 1, pp. 111--129, https://doi.org/10.1111/j.1751-5823.2005.tb00254.x

See Also

GHcop, GLcop, HRcop

Examples

Run this code
# NOT RUN {
tau <- 1/3 # Example from copula::evCopula.Rd
tev.cop <- tevCopula(iTau(tevCopula(), tau))
copula::pCopula(c(0.1,.5), copula=tev.cop)         # 0.07811367
tEVcop(0.1, 0.5, para=slot(tev.cop, "parameters")) # 0.07811367
# }
# NOT RUN {
# }
# NOT RUN {
nsim <- 2000; pargh <- c(5, 0.5, 0.5)
UV <- simCOP(nsim, cop=GHcop, para=pargh)
U <- lmomco::pp(UV[,1], sort=FALSE)
V <- lmomco::pp(UV[,2], sort=FALSE)
RT <- mleCOP(u=U, v=V, cop=tEVcop, init.para=c(0.5,log(4)),
             parafn=function(k) return(c(k[1], exp(k[2]))))
partev <- RT$para

FT <- simCOP(nsim, cop=tEVcop, para=RT$para)

tauCOP(cop=GHcop,  para=pargh )
tauCOP(cop=tEVcop, para=partev)

tauCOP(cop=GHcop,  para=pargh ) # [1] 0.3003678
tauCOP(cop=tEVcop, para=partev) # [1] 0.3178904

densityCOPplot(cop=GHcop,  para=pargh)
densityCOPplot(cop=tEVcop, para=partev,
               ploton=FALSE, contour.col=2) #
# }
# NOT RUN {
# }
# NOT RUN {
# A demonstration Joe (2014, p. 190) for which tEvcop() has
# upper tail dependence parameter as
para <- c(0.8, 10)
lamU <- 2*pt(-sqrt((para[2]+1)*(1-para[1])/(1+para[1])), para[2]+1)
"tEVcop.copula" <- function(u,v, para=NULL, ...) {
      if(length(u)==1) u<-rep(u,length(v)); if(length(v)==1) v<-rep(v,length(u))
      return(copula::pCopula(matrix(c(u,v), ncol=2),
                   tevCopula(param=para[1], df=para[2])))
}
lamU.copBasic <- taildepCOP(cop=tEVcop,        para)$lambdaU
lamU.copula   <- taildepCOP(cop=tEVcop.copula, para)$lambdaU
print(c(lamU, lamU.copBasic, lamU.copula))
#[1] 0.2925185 0.2925200 0.2925200 # So we see that they all match. 
# }
# NOT RUN {
# }
# NOT RUN {
# Convergence of tEVcop to HRcop as nu goes to infinity.
nu <- 10^(seq(-4,2,by=.1)) # nu right end point rho dependent
rho <- 0.7 # otherwise, expect to see 'zeros' errors on the plot()
# Compute Blomqvist Beta (fast computation is reason for choice)
btEV <- sapply(nu, function(n) blomCOP(tEVcop, para=c(rho, n)))
limit.thetas <- sqrt(2/(nu*(1-rho))) # for nu --> infinity HRcop
thetas <- sapply(btEV, function(b) {
     uniroot(function(l, blom=NA) { blom - blomCOP(HRcop, para=l) },
     interval=c(0,10), blom=b)$root })
plot(limit.thetas, thetas, log="xy", type="b",
     xlab="Theta of HRcop via limit nu --> infinity",
     ylab="Theta from Blomqvist Beta equivalent HRcop to tEVcop")
abline(0,1)
mtext(paste0("Note 'weak' convergence to lower left, and \n",
             "convergence increasing with rho"))
# Another reference of note
# https://mediatum.ub.tum.de/doc/1145695/1145695.pdf (p.39) #
# }

Run the code above in your browser using DataLab