convex2COP: Convex Combination of Two Copulas

Description

The convex composition of two copulas (Joe, 2014, p. 155) provides for some simple complexity extension between coupla families. Let $\mathbf{A}$ and $\mathbf{B}$ be copulas with respective parameters $\Theta_\mathbf{A}$ and $\Theta_\mathbf{B}$, then the conve$\times$ combination of these copulas is

$$\mathbf{C}^{\times}_{\alpha}(u,v) = \alpha \mathbf{A}(u, v; \Theta_\mathbf{A}) - (1-\alpha)\mathbf{B}(u,v; \Theta_\mathbf{B})\mbox{,}$$

where $0 \le \alpha \le 1$.

Usage

convex2COP(u,v, para, ...)

Arguments

Nonexceedance probability $u$ in the $X$ direction;

Nonexceedance probability $v$ in the $Y$ direction;

para

A special parameter list (see Note); and

...

Additional arguments to pass to the copula.

Value

Value(s) for the convex combination copula is returned.

References

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

Examples

Run this code

para <- list(alpha=0.24, cop1=FRECHETcop, para1=c(.4,.56),
                         cop2=PSP,        para2=NA)
convex2COP(0.87,0.35, para=para)
# Suppose we have a target Kendall Tau of 1/3 and a Gumbel-Hougaard copula
# seems pretty attractive but the GH has just too much upper tail dependency
# for our comfort. We think from data analysis that an upper tail dependency
# that is weaker and near 2/10 is the better. Let us convex mix in a Plackett
# copula and optimize.
TargetTau <- tauCOP(cop=GHcop, para=1.5) # 1/3 (Kendall's Tau)
taildepCOP(   cop=GHcop, para=1.5, plot = TRUE)$lambdaU  # 0.4126
TargetUpperTailDep <- 2/10

# **Serious CPU time pending for this example**
par <- c(-.10, 4.65) # inital guess but the first parameter is in standard
# normal units for the optimize to keep us in the [0,1] domain when converted to
# probability. The guesses of -0.10 (standard deviation) for the convex
# parameter and 4.65 for the Plackett are based on a much longer search times as
# setup for this problem. The simplex for optim() is going to be close the
# solution on startup.
"afunc" <- function(par) {
   para <- list(alpha=pnorm(par[1]), cop1=GHcop,       para1=1.5,
                                     cop2=PLACKETTcop, para2=par[2])
   tau  <- tauCOP(cop=convex2COP, para=para)
   taildep <- taildepCOP(cop=convex2COP, para=para, plot = FALSE)$lambdaU
   err <- sqrt((TargetTau - tau)^2 + (TargetUpperTailDep - taildep)^2)
   print(c(pnorm(par[1]), par[2], tau, taildep, err))
   return(err)
}
mysolution <- optim(par, afunc, control=list(abstol=1E-4))

para <- list(alpha=.4846902, cop1=GHcop,     para1=1.5,
                           cop2=PLACKETTcop, para2=4.711464)
UV <- simCOP(n=2500, cop=convex2COP, para=para, snv=TRUE)