library(copula)
library(KendallSignature)
library(rgl)
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
knitr::knit_hooks$set(webgl = hook_webgl)

A 3-dimensional motivating example

First consider a 3-dimensional t copula with degree-of-freedom parameter $\nu = 0.02$ and correlation values $\rho_{12} = 0.2$, $\rho_{13} = 0.5$ and $\rho_{23} = 0.8$. We simulate $n = 2000$ values from this copula and plot them.

corvals <- c(0.3, 0.5, 0.8)
tcop <- copula::tCopula(
  df = 0.02,
  param = corvals,
  dim = 3,
  dispstr = "un"
)
set.seed(13)
n <- 2000
data <- copula::rCopula(n, tcop)
plot3d(data, xlab = "U1", ylab = "U2", zlab = "U3")

We can count the proportions of points that are closest to each diagonal.

table(quadrants(sign(data - 0.5), diagonal = TRUE, pretty = TRUE))/n

Theory gives the concordance signature and the true weights of the corresponding mixture of extremal copulas as follows.

kappa <- consignature(p2P(corvals))
kappa
solve(Amatrix(3), kappa)

A 6-dimensional example

Now consider an elliptical copula with the following correlation matrix.

P <- copula::p2P((1:15) / 16)
P

This is the concordance signature.

kappa <- consignature(P)
kappa

Here are the extremal weights.

weights <- findextremal(kappa, named = FALSE)
weights

Let's put all the results in a table.

table <- extremaltable(kappa)
knitr::kable(table)

We compute the Kendall's tau matrix of the extremal mixture copula and check it is equal to the Kendall's tau matrix of the elliptical copula, which is given by $2\arcsin(P)/\pi$.

sum(weights)
taumatrix <- Reduce('+', Map('*', weights, extcorr(1:32, 6)))
taumatrix
2*asin(P)/pi

We generate some data from the extremal mixture. The correlation matrix (whether computed by the Pearson, Kendall or Spearman method) should be close to the Kendall's tau matrix of the elliptical copula.

set.seed(13)
U <- rextremalmix(weights, 10000)
cor(U)

Here is a scatterplot from the extremal mixture.

pairs(U[1:500,])

A Kendall correlation matrix that can't be elliptical

Here is a $4 \times 4$ correlation matrix. Note that it is positive definite.

P <- copula::p2P(c(-0.19, -0.29, 0.49, -0.34, 0.3, -0.79))
P

eigen(P)$values

Could it be a matrix of Kendall's tau values? On the assumption that it is, let's calculate the pairwise probabilities of concordance. More precisely we find the first 7 elements of the concordance signature.

kappa <- c(1, (1 + P[lower.tri(P)])/2)
names(kappa) <- evenpowerset(4)[1:length(kappa)]
kappa

Let's see if we can find an extremal mixture copula that matches these probabilities of concordance.

weights <- findpolytope(kappa, 4)
weights

These are the two vertices of the polytope of weights. We can check the vertices give the right Kendall rank correlations by computing the weighted sum of the extremal correlation matrices.

Reduce('+', Map('*', weights[1,], extcorr(1:8, 4)))
Reduce('+', Map('*', weights[2,], extcorr(1:8, 4)))

Can we get this set of Kendall's tau values from an elliptical copula? Let's calculate the implied correlation matrix of the copula and check it is positive semi-definite.

P2 <- sin(pi * P / 2)
eigen(P2)$values

It isn't! So $P$ is an example of a Kendall's tau matrix that cannot be associated with an elliptically distributed random vector.



ajmcneil/extremalcopula documentation built on Jan. 25, 2022, 11:54 p.m.