library(copula) # for hierarchical frailties, generators etc.
library(mev) # for rmev()
The (frozen) parameters considered are as follows.
## Parameters
c(2, 3) # copula sector dimensions
d. <- sum(d.) # copula dimension
d <-stopifnot(d >= 3) # for 3d plots
1000 # sample size n <-
We also implement an auxiliary function to generated the hierarchical frailties involved.
##' @title Generated two hierarchical frailties (V0, V01, V02)
##' @param n sample size
##' @param family copula family
##' @param tau Kendall's tau
##' @return 3-column matrix containing the hierarchical frailties
##' @author Marius Hofert and Avinash Prasad
function(n, family, tau)
rV012 <-
{stopifnot(n >= 1, is.character(family), length(tau) == 3, tau > 0)
getAcop(family) # corresponding AC
cop <- iTau(cop, tau = tau) # copula parameters
th <- cop@V0(n, theta = th[1]) # sample frailties V_0
V0 <- cop@V01(V0, theta0 = th[1], theta1 = th[2]) # sample frailties V_01
V01 <- cop@V01(V0, theta0 = th[1], theta1 = th[3]) # sample frailties V_02
V02 <-cbind(V0 = V0, V01 = V01, V02 = V02)
}
And a short helper function for plotting (possibly to PDF).
## Plot with possible export to PDF
function(x, pch = ".", file = NULL, width = 6, height = 6, ...)
mypairs <-
{ par(pty = "s")
opar <-on.exit(par(opar))
!is.null(file)
doPDF <-if(doPDF) {
pdf(file = file, width = width, height = height)
stopifnot(require(crop))
}pairs2(x, pch = pch, ...)
if(doPDF) dev.off.crop(file)
}
In this example, we compare Archimedean copulas (ACs), Archimax copulas (AXCs), nested Archimedean copulas (NACs) and hierarchical Archimax copulas (HAXCs) with hierarchical frailties only, with hierarchical frailties and hierarchical extreme-value copula (HEVC) but both of the same hierarchical structure, and with hierarchical frailties and HEVC but of different hierarchical structure.
To begin with, we sample from a standard Clayton copula.
## Sample frailties (to recycle the frailties, we apply the Marshall--Olkin (MO)
## algorithm manually here)
0.4 # Kendall's tau
tau <- "Clayton" # frailty family
family <- getAcop(family) # corresponding AC
cop <- iTau(cop, tau = tau) # copula parameter
th <-set.seed(271) # for reproducibility
cop@V0(n, theta = th) # sample frailty
V <- matrix(rexp(n * d), ncol = d) # sample Exp(1)
E <- cop@psi(E/V, theta = th) # MO
U.AC <-
## Plot
mypairs(U.AC)
Now we sample from an Archimax copula with gamma frailties (as underlying the Clayton family; we recycle the frailties from 1.1) and Gumbel EVC (parameters chosen such that Kendall’s tau equals 0.5).
## Generate Gumbel EVC sample with Exp(1) margins
0.5 # Kendall's tau
tau.EVC <- "Gumbel" # EVC family
family.EVC <- iTau(getAcop(family.EVC), tau = tau.EVC) # EVC parameter
th.EVC <- onacopulaL(family.EVC, list(th.EVC, 1:d)) # EVC
cop.EVC <-set.seed(271) # for reproducibility
rCopula(n, copula = cop.EVC) # sample EVC
U.EVC <- -log(U.EVC) # map the EVC to Exp(1) margins
E.EVC <-
## Combine with the (same) Clayton frailties (as before)
cop@psi(E.EVC/V, theta = th)
U.AXC <-
## Plot
mypairs(U.AXC)
Sampling from a NAC based on Clayton’s family with parameters such that Kendall’s tau equals 0.2 between the two sectors, 0.4 within the first sector and 0.6 within the second sector, can be done as follows.
## Generate hierarchical frailties
c(0.2, 0.4, 0.6) # Kendall's taus
tau.N <- "Clayton" # frailty family
family.N <- getAcop(family.N) # corresponding AC
cop.N <- iTau(cop.N, tau = tau.N) # copula parameters
th.N <-set.seed(271) # for reproducibility
rV012(n, family = family.N, tau = tau.N) # generate corresponding frailties
V.N <- V.N[,"V0"]
V0 <- V.N[,"V01"]
V01 <- V.N[,"V02"]
V02 <-
## Combine with independent Exp(1)
cbind(cop.N@psi(E[,1:d.[1]]/V01, theta = th.N[2]),
U.NAC <-@psi(E[,(d.[1]+1):d]/V02, theta = th.N[3]))
cop.N
## Plot
mypairs(U.NAC)
Sampling from a NAXC based on hierarchical Clayton frailties (recycled from 1.3) and Gumbel EVC (realizations recycled from 1.2). Note that hierarchies only take place at the levels of the frailties in this case.
## Generate samples
cbind(cop.N@psi(E.EVC[,1:d.[1]]/V01, theta = th.N[2]),
U.HAXC <-@psi(E.EVC[,(d.[1]+1):d]/V02, theta = th.N[3]))
cop.N
## Plot
mypairs(U.HAXC)
After this warm-up, we can consider sampling from a HAXC based on hierarchical Clayton frailties (recycled from 1.3) and a hierarchical Gumbel EVC (with sector sizes 2 and 3 and parameters such that Kendall’s tau equals 0.2 between the two sectors, 0.5 within the first sector and 0.7 within the second sector). Note that there are two types of hierarchies involved, at the level of the (hierarchical) frailties and at the level of the (hierarchical) EVC. Furthermore, their hierarchical structure is the same.
## Sampling from a hierarchical Gumbel copula
c(0.2, 0.5, 0.7) # Kendall's taus
tau.HEVC <- "Gumbel" # EVC family
family.HEVC <- getAcop(family.HEVC) # corresponding base EVC
cop.HEVC <- iTau(cop.HEVC, tau = tau.HEVC) # copula parameters
th.HEVC <- onacopulaL(family.HEVC, list(th.HEVC[1], NULL,
cop.HEVC <-list(list(th.HEVC[2], 1:d.[1]),
list(th.HEVC[3], (d.[1]+1):d)))) # hierarchical EVC
set.seed(271) # for reproducibility
rCopula(n, copula = cop.HEVC) # sample the HEVC
U.HEVC <- -log(U.HEVC) # map the HEVC samples to Exp(1) margins
E.HEVC <-
## Combine the hierarchical Gumbel EVC with Exp(1) margins with the hierarchical frailties
cbind(cop.N@psi(E.HEVC[,1:d.[1]]/V01, theta = th.N[2]),
U.HAXC.HEVC.same <-@psi(E.HEVC[,(d.[1]+1):d]/V02, theta = th.N[3]))
cop.N
## Plot
mypairs(U.HAXC.HEVC.same)
Sampling from a HAXC (recycling realizations from 1.5) for which the hierarchical structures of the hierarchical frailties (sector sizes 3 and 2, respectively) and of the hierarchical Gumbel EVC (sector sizes 2 and 3, respectively) differ.
## Combine the hierarchical Gumbel EVC with Exp(1) margins with the hierarchical frailties
## in an 'asymmetric' way (hierarchical structures of the HEVC and the hierarchical frailties differ)
rev(d.) # 3, 2
d.. <- cbind(cop.N@psi(E.HEVC[,1:d..[1]]/V01, theta = th.N[2]), # first three components get V01
U.HAXC.HEVC.dffr <-@psi(E.HEVC[,(d..[1]+1):d]/V02, theta = th.N[3])) # last two components get V02
cop.N
## Plot
mypairs(U.HAXC.HEVC.dffr)
Again in terms of an example, we now compare extreme-value copulas (EVCs), hierarchical extreme-value copulas (HEVCs) and hierarchical Archimax copulas (HAXCs) with single frailty and HEVC, with hierarchical frailties and EVC, with hierarchical frailties and HEVC but both of the same hierarchical structure, and with hierarchical frailties and HEVC but of different hierarchical structure.
To begin with, we draw \(n\) samples from an extremal t copula with \(\nu=3.5\) degrees of freedom and off-diagonal entry of the correlation matrix parameter \(P\) to be 0.7.
## Correlation matrix (parameter matrix of the extremal t)
matrix(0.7, ncol = d, nrow = d)
P <-diag(P) <- 1
## Extremal t copula (EVC)
3.5
nu <-set.seed(271)
exp(-1/rmev(n, d = d, param = nu, sigma = P, model = "xstud")) # apply unit Frechet margins to get U
U.EVC <-
## Plot
mypairs(U.EVC)
Now, we sample from an hierarchical extremal t copula with two sectors of sizes 2 and 3 such that the correlation matrix \(P\) has entries 0.2 for pairs belonging to different sectors, 0.5 for pairs belonging to the first sector and 0.7 for pairs belonging to the second sector.
## Construct a hierarchical correlation matrix for the extremal t
matrix(0.2, ncol = d, nrow = d)
P.h <-1:d.[1], 1:d.[1]] <- 0.5
P.h[-d.[2]+1):d, (d-d.[2]+1):d] <- 0.7
P.h[(ddiag(P.h) <- 1
## Hierarchical extremal t copula (HEVC)
rmev(n, d = d, param = nu, sigma = P.h, model = "xstud")
X.et <- exp(-1/X.et) # apply unit Frechet margins to get U
U.HEVC <-
## Plot
mypairs(U.HEVC)
Sampling from a HAXC with Clayton frailty (recycled from 1.1) and hierarchical extremal t copula (on top of the unit exponentials; recycled from 2.2) can be done as follows.
## Construct samples
-log(U.HEVC) # map to Exp(1) margins
E.HEVC <- cop@psi(E.HEVC/V, theta = th)
U.AXC.HEVC <-
## Plot
mypairs(U.AXC.HEVC)
Consider a HAXC with hierarchical Clayton frailties (recycled from 1.3) and extremal t EVC (on top of the unit exponentials; recycled from 2.1).
## Construct samples
-log(U.EVC)
E.EVC <- cbind(cop.N@psi(E.EVC[,1:d.[1]]/V01, theta = th.N[2]),
U.HAXC.EVC <-@psi(E.EVC[,(d.[1]+1):d]/V02, theta = th.N[3]))
cop.N
## Plot
mypairs(U.HAXC.EVC)
Now consider a HAXC with hierarchical Clayton frailties (recycled from 1.3) and hierarchical extremal t EVC (on top of the unit exponentials; recycled from 2.2 and 2.3). Note that there are two types of hierarchies involved, at the level of the (hierarchical) frailties and at the level of the (hierarchical) EVC.
## Construct samples
cbind(cop.N@psi(E.HEVC[,1:d.[1]]/V01, theta = th.N[2]),
U.NAXC.HEVC.same <-@psi(E.HEVC[,(d.[1]+1):d]/V02, theta = th.N[3]))
cop.N
## Plot
mypairs(U.HAXC.HEVC.same)
Sampling from a HAXC (recycling realizations from 2.5) for which the hierarchical structures of the frailties (sector sizes 3 and 2, respectively) and of the HEVC (sector sizes 2 and 3, respectively) differ in this case.
## Construct samples
cbind(cop.N@psi(E.HEVC[,1:d..[1]]/V01, theta = th.N[2]), # first three components get V01
U.NAXC.HEVC.dffr <-@psi(E.HEVC[,(d..[1]+1):d]/V02, theta = th.N[3])) # last two components get V02
cop.N
## Plot
mypairs(U.HAXC.HEVC.dffr)