---
title: "Data depth and rank-based tests for HPD matrices"
author: "Joris Chau"
date: "`r Sys.Date()`"
output: 
  rmarkdown::html_vignette:
    fig_caption: yes
    toc: true
vignette: >
  %\VignetteIndexEntry{"Data depth and rank-based tests for HPD matrices"}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
references:
- id: COvS17
  title: 'Data depth and rank-based tests for covariance and spectral density matrices'
  author:
  - family: Chau  
    given: J.
  - family: Ombao
    given: H.
  - family: von Sachs
    given: R.
  URL: 'http://arxiv.org/abs/1706.08289'
  type: article-journal
  issued: 
    year: 2017
---

```{r, echo = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 10, fig.height = 4, fig.align = "center", out.width = "600px")
```
## Introduction 

In second-order stationary multivariate time series analysis, non-degenerate autocovariance matrices or spectral density matrices at the Fourier frequencies are necessarily elements of the space of Hermitian positive definite (HPD) matrices. In [@COvS17], we generalize the classical concept of data depth for Euclidean vectors to intrinsic *manifold* data depth for matrix-valued observations in the non-Euclidean space of HPD matrices. Data depth is an important tool in statistical data analysis measuring the *depth* of a point with respect to a data cloud or probability distribution. In this way, data depth provides a center-to-outward ordering of multivariate data observations, generalizing the notion of a rank for univariate observations.

The proposed data depth measures can be used to characterize central regions or detect outlying observations in samples of HPD matrices, such as collections of covariance or spectral density matrices. The depth functions also provide a practical framework to perform rank-based hypothesis testing for samples of HPD matrices by replacing the usual ranks by their depth-induced counterparts. Other applications of data depth include the construction of confidence regions, clustering, or classification for samples of HPD matrices.

In this vignette we demonstrate the use of the functions `pdDepth()` and `pdRankTests()` to compute data depth values of HPD matrix-valued observations and perform rank-based hypothesis testing for samples of HPD matrices, where the space of HPD matrices can be equipped with several different metrics, e.g. the *invariant* Riemannian metric discussed in [@COvS17].

### Shiny app

A demo Shiny app for data depth and rank-based tests in the context of samples of HPD matrices is available [here](https://jchau.shinyapps.io/pdSpecEst_app/). By clicking on the tab 'Data depth', for simulated samples of HPD matrices, the user can examine the performance of the different rank-based tests (via `pdRankTests()`) based on depth-induced ranks computed with `pdDepth()`.

## Data depth of HPD matrices with `pdDepth()`

First, we generate a pointwise random sample of `(2,2)`-dimensional HPD matrix-valued observations using the exponential map `Expm()`, with underlying geometric (i.e. Karcher or Fréchet) mean equal to the identity matrix `diag(2)`.
Second, we generate a random sample of sequences (curves) of `(2,2)`-dimensional HPD matrix-valued observations, with underlying geometric mean curve equal to an array of rescaled identity matrices. 
We can think of the first sample as a random collection of covariance matrices, and the second sample as a random collection of spectral matrices along frequency.

 
```{r}
library(pdSpecEst)
set.seed(100)

## Pointwise random sample
X1 <- replicate(50, Expm(diag(2), H.coeff(0.5 * rnorm(4), inverse = T))) 
str(X1)

## Curve random sample
X2 <- replicate(50, sapply(1:5, function(i) Expm(i * diag(2), H.coeff(0.5 * rnorm(4), inverse = T) / i), simplify = "array"))
str(X2)
```

**Remark:** The function `H.coeff()` converts (real-valued) basis components to Hermitian matrices via an inverse orthonormal basis expansion on the real vector space of Hermitian matrices.

`pdDepth()` computes the data depth of a single HPD matrix (resp. curve of HPD matrices) `y` with respect to a sample of HPD matrices (resp. sample of curves of HPD matrices) `X`.  The function computes the intrinsic data depths based on the metric space of HPD matrices equipped with one of the following metrics: (i) Riemannian metric (default), (ii) log-Euclidean metric, the Euclidean inner product between matrix logarithms, (iii) Cholesky metric, the Euclidean inner product between Cholesky decompositions, (iv) Euclidean metric and (v) root-Euclidean metric, the Euclidean inner product between Hermitian square root matrices. The default choice (Riemannian) has several appealing properties not shared by the other metrics. See [@COvS17] for more details and additional properties of the available manifold depth functions.

```{r}
## Pointwise depth
pdDepth(y = diag(2), X = X1, method = "gdd") ## geodesic distance depth
pdDepth(y = diag(2), X = X1, method = "zonoid") ## manifold zonoid depth
pdDepth(y = diag(2), X = X1, method = "spatial") ## manifold spatial depth

## Integrated depth 
pdDepth(y = sapply(1:5, function(i) i * diag(2), simplify = "array"), X = X2, method = "gdd") 
pdDepth(y = sapply(1:5, function(i) i * diag(2), simplify = "array"), X = X2, method = "zonoid") 
pdDepth(y = sapply(1:5, function(i) i * diag(2), simplify = "array"), X = X2, method = "spatial") 
```

We can also compute the data depth of each individual object in `X` with respect to the sample `X` itself by leaving the argument `y` in the function `pdDepth()` unspecified.

```{r}
(dd1 <- pdDepth(X = X1, method = "gdd")) ## pointwise geodesic distance depth

(dd2 <- pdDepth(X = X2, method = "gdd")) ## integrated geodesic distance depth
```

A center-to-outwards ordering of the individual objects is then obtained by computing the data depth induced ranks, with the most central observation having smallest rank and the most outlying observation having largest rank.

```{r}
(dd1.ranks <- rank(1 - dd1)) ## pointwise depth ranks

(dd2.ranks <- rank(1 - dd2)) ## integrated depth ranks

## Explore sample X1
head(order(dd1.ranks)) ## most central observations 
rev(tail(order(dd1.ranks))) ## most outlying observations
X1[ , , which(dd1.ranks == 1)] ## most central HPD matrix 
X1[ , , which(dd1.ranks == 50)] ## most outlying HPD matrix

```

We can compare the most central HPD matrix above with the (approximate) empirical geometric mean of the observations obtained with `pdMean()` based on the Riemannian metric. The empirical geometric mean is known to maximize the data depth for observations from a *centrally symmetric* distribution (as in this example). For more details, see [@COvS17].

```{r}
(mean.X1 <- pdMean(X1)) 

pdDepth(y = mean.X1, X = X1, method = "gdd")
```

### Computation times
The figure below displays average computation times in milliseconds (single core Intel Xeon E5-2650) of the depth of a single `(d, d)`-dimensional HPD matrix with respect to a sample of `(d, d)`-dimensional HPD matrices of size `n` under the Riemannian metric. The computation times of the data depths based on one of the other metrics are either similar or faster than the times displayed below (in particular computation times of the manifold zonoid and spatial depth are significantly faster). 

In the left-hand image, the sample size is fixed at `n = 500`, and in the right-hand image the dimension is fixed at `d = 6`. (The computation times are based on the median computation time of 100 depth calculations for 50 random samples). The manifold zonoid depth can only be calculated if $d^2 < n$ and for this reason there are some missing values in the left-hand image.<br>
<br>

```{r, echo = FALSE}
d <- round(exp(seq(from = log(2), to = log(64), length = 10)), digits = 0)
n <- round(exp(seq(from = log(100), to = log(2000), length = 10)), digits = 0)
par(mfrow = c(1,2), mgp = c(2,0.5,0), mar = c(4,3,2,2))
plot(range(d), range(pdSpecEst:::depth_time, na.rm=T), type="n", log = "xy", main = "Increasing dimension d x d, (n = 500)", xlab = "d", ylab = "Time (ms)")
for(i in 1:3){
  lines(d, pdSpecEst:::depth_time[i,,1], col = i, lty = i)
  points(d, pdSpecEst:::depth_time[i,,1], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18,
       col = 1:3, cex = 1, bty = "n", y.intersp = 1)
plot(range(n), range(pdSpecEst:::depth_time, na.rm=T), type="n", log = "xy", main = "Increasing sample size n, (d = 6)", xlab = "n", ylab = "Time (ms)")
for(i in 1:3){
  lines(n, pdSpecEst:::depth_time[i,,2], col = i, lty = i)
  points(n, pdSpecEst:::depth_time[i,,2], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18,
       col = 1:3, cex = 1, bty = "n", y.intersp = 1)
```

## Rank-based tests for HPD matrices with `pdRankTests()`

The null hypotheses of the available rank-based hypothesis tests in `pdRankTests()` are:

* `"rank.sum"`: homogeneity of distributions of two independent samples of HPD matrices (resp. sequences of HPD matrices).
* `"krusk.wall"`: homogeneity of distributions of more than two independent samples of HPD matrices (resp. sequences of HPD matrices).
* `"signed-rank"`: homogeneity of distributions of independent paired or matched samples of HPD matrices.
* `"bartels"`: exchangeability (i.e. randomness) within a single independent sample of HPD matrices (resp. sequences of HPD matrices).
 
Below, we construct several simulated examples for which (i) the null hypotheses listed above are satisfied, and (ii) the null hypotheses listed above are not satisfied. Analogous to the previous section, we generate pointwise random samples (resp. random samples of sequences) of `(2,2)`-dimensional HPD matrix-valued observations, with underlying geometric mean equal to the identity matrix (resp. sequence of scaled identity matrices). 

Instead of equipping the space of HPD matrices with the Riemannian metric (the default), `pdRankTests()` can also compute rank-based test statistics in the *complete* metric space of HPD matrices equipped with the Log-Euclidean metric (`metric = 'logEuclidean'`). The default Riemannien metric is invariant under congruence transformation by any invertible matrix, whereas the Log-Euclidean metric is only invariant under congruence transformation by unitary matrices. The space of HPD matrices equipped with one of the other metrics listed above (i.e. Cholesky, Euclidean and root-Euclidean) is no longer a complete metric space, and the derivations of asymptotic null distributions of the rank-based test statistics break down.

Let us first consider simulated examples of the manifold Wilcoxon rank-sum test (`"rank.sum"`) and manifold Kruskal-Wallis test (`"krusk.wall"`).

```{r}
## Generate data (null true)
data1 <- array(c(X1, replicate(50, Expm(diag(2), H.coeff(0.5 * rnorm(4), inverse = T)))), dim = c(2, 2, 100)) ## pointwise sample
data2 <- array(c(X2, replicate(50, sapply(1:5, function(i) Expm(i * diag(2), H.coeff(0.5 * rnorm(4), inverse = T) / i), simplify = "array"))), dim = c(2, 2, 5, 100)) ## curve sample

## Generate data (null false)
data1a <- array(c(X1, replicate(50, Expm(diag(2), H.coeff(rnorm(4), inverse = T)))), dim = c(2, 2, 100)) ## pointwise scale change
data2a <- array(c(X2, replicate(50, sapply(1:5, function(i) Expm(i * diag(2), H.coeff(rnorm(4), inverse = T) / i), simplify = "arra"))), dim = c(2, 2, 5, 100)) ## curve scale change

## Rank-sum test
pdRankTests(data1, sample.sizes = c(50, 50), "rank.sum")[1:4] ## null true (pointwise)
pdRankTests(data2, sample.sizes = c(50, 50), "rank.sum")[2] ## null true (curve)
pdRankTests(data1a, sample.sizes = c(50, 50), "rank.sum")[2] ## null false (pointwise)
pdRankTests(data2a, sample.sizes = c(50, 50), "rank.sum")[2] ## null false (curve)

## Kruskal-Wallis test
pdRankTests(data1, sample.sizes = c(50, 25, 25), "krusk.wall")[1:4] ## null true (pointwise)
pdRankTests(data2, sample.sizes = c(50, 25, 25), "krusk.wall")[2] ## null true (curve)
pdRankTests(data1a, sample.sizes = c(50, 25, 25), "krusk.wall")[2] ## null false (pointwise)
pdRankTests(data2a, sample.sizes = c(50, 25, 25), "krusk.wall")[2] ## null false (curve)
```

To apply the manifold Wilcoxon signed-rank test (`"signed-rank"`), we generate paired observations for independent trials (or subjects) by introducing trial-specific random effects, such that the paired observations in each trial share a trial-specific geometric mean. Note that for such data the manifold Wilcoxon rank-sum test is no longer valid due to the introduced sample dependence.

```{r}
## Trial-specific means
mu <- replicate(50, Expm(diag(2), H.coeff(0.1 * rnorm(4), inverse = T)))

## Generate paired samples X,Y
make_sample <- function(null) sapply(1:50, function(i) Expm(mu[, , i], pdSpecEst:::T_coeff_inv(ifelse(null, 1, 0.5) * rexp(4) - 1, mu[, , i])), simplify = "array") 

X3 <- make_sample(null = T)
Y3 <- make_sample(null = T) ## null true
Y3a <- make_sample(null = F) ## null false (scale change)

## Signed-rank test
pdRankTests(array(c(X3, Y3), dim = c(2, 2, 100)), test = "signed.rank")[1:4] ## null true
pdRankTests(array(c(X3, Y3a), dim = c(2, 2, 100)), test = "signed.rank")[2] ## null false

``` 

The manifold signed-rank test also provides a valid procedure to test for equivalence of spectral matrices of two (independent) multivariate stationary time series based on the HPD periodogram matrices obtained via `pdPgram()`. In contrast to other available tests in the literature, this asymptotic test does not require consistent spectral estimators or resampling/bootstrapping of test statistics, and therefore remains computationally efficient for higher-dimensional spectral matrices or a large number of sampled Fourier frequencies.

```{r}
## Signed-rank test for equivalence of spectra
## vARMA(1,1) process: Example 11.4.1 in (Brockwell and Davis, 1991)
Phi <- array(c(0.7, 0, 0, 0.6, rep(0, 4)), dim = c(2, 2, 2))
Theta <- array(c(0.5, -0.7, 0.6, 0.8, rep(0, 4)), dim = c(2, 2, 2))
Sigma <- matrix(c(1, 0.71, 0.71, 2), nrow = 2)
pgram <- function(Sigma) pdPgram(rARMA(2^10, 2, Phi, Theta, Sigma)$X)$P ## HPD periodogram

## Null is true
pdRankTests(array(c(pgram(Sigma), pgram(Sigma)), dim = c(2, 2, 2^10)), test = "signed.rank")[2]

## Null is false
pdRankTests(array(c(pgram(Sigma), pgram(0.5 * Sigma)), dim = c(2, 2, 2^10)), test = "signed.rank")[2]
```

To apply the manifold Bartels-von Neumman test (`"bartels"`), we generate an independent non-identically distributed sample with a trend in the scale of the distribution across observations, such that the null hypothesis of randomness breaks down.

```{r}
## Null is true
data3 <- replicate(200, Expm(diag(2), H.coeff(rnorm(4), inverse = T))) ## pointwise samples
data4 <- replicate(100, sapply(1:5, function(i) Expm(i * diag(2), H.coeff(rnorm(4), inverse = T) / i), simplify = "array")) ## curve samples

## Null is false
data3a <- sapply(1:200, function(j) Expm(diag(2), H.coeff(((200 - j) / 200 + j * 2 / 200) * rnorm(4), inverse = T)), simplify = "array") ## pointwise trend in scale
data4a <- sapply(1:100, function(j) sapply(1:5, function(i) Expm(i * diag(2), H.coeff(((100 - j) / 100 + j * 2 / 100) * rnorm(4), inverse = T) / i), simplify = "array"), simplify = "array") ## curve trend in scale

## Bartels-von Neumann test
pdRankTests(data3, test = "bartels")[1:4] ## null true (pointwise)
pdRankTests(data4, test = "bartels")[2] ## null true (curve)
pdRankTests(data3a, test = "bartels")[2] ## null false (pointwise)
pdRankTests(data4a, test = "bartels")[2] ## null false (curve)
```

### Computation times
The figures below display average computation times in milliseconds (single core, Intel Xeon E5-2650) of the rank-based hypothesis tests based on the Riemannian metric in terms of the dimension of the matrix-valued data and the size of the samples considered in the tests. The computation times based on the Log-Euclidean metric are either similar or significantly faster (in particular for the rank-based tests based on the manifold zonoid or spatial depth) than the times displayed below.

**Manifold Wilcoxon rank-sum test**
The figure below displays average computation times of the manifold Wilcoxon rank-sum test for two equal-sized samples of `(d,d)`-dimensional HPD matrices of size `n`, with depth-induced ranks based on the geodesic distance depth (`gdd`), manifold zonoid depth (`zonoid`) and manifold spatial depth (`spatial`) respectively.<br>
<br>
```{r, echo = FALSE}
d <- round(exp(seq(from = log(2), to = log(32), length = 5)), digits = 0)
n <- round(exp(seq(from = log(50), to = log(500), length = 5)), digits = 0)
par(mfrow = c(1,2), mgp = c(2,0.5,0), mar = c(4,3,2,2))
plot(range(d), range(pdSpecEst:::rs_time[1:3,,], na.rm=T), type="n", log = "xy", main = "Increasing dimension d x d, (n = 100)", xlab = "d", ylab = "Time (ms)")
for(i in 1:3){
  lines(d, pdSpecEst:::rs_time[i,,1], col = i, lty = i)
  points(d, pdSpecEst:::rs_time[i,,1], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
plot(range(n), range(pdSpecEst:::rs_time[1:3,,], na.rm=T), type="n", log = "xy", main = "Increasing sample size n, (d = 4)", xlab = "n", ylab = "Time (ms)")
for(i in 1:3){
  lines(n, pdSpecEst:::rs_time[i,,2], col = i, lty = i)
  points(n, pdSpecEst:::rs_time[i,,2], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
```
<br>
**Manifold Kruskal-Wallis test**
The figure below displays average computation times of the manifold Kruskal-Wallis test for three equal-sized samples of `(d,d)`-dimensional HPD matrices of size `n`, with depth-induced ranks based on the geodesic distance depth (`gdd`), manifold zonoid depth (`zonoid`) and manifold spatial depth (`spatial`) respectively.<br>
<br>
```{r, echo = FALSE}
d <- round(exp(seq(from = log(2), to = log(32), length = 5)), digits = 0)
n <- round(exp(seq(from = log(25), to = log(250), length = 5)), digits = 0)
par(mfrow = c(1,2), mgp = c(2,0.5,0), mar = c(4,3,2,2))
plot(range(d), range(pdSpecEst:::kw_time[1:3,,], na.rm=T), type="n", log = "xy", main = "Increasing dimension d x d, (n = 50)", xlab = "d", ylab = "Time (ms)")
for(i in 1:3){
  lines(d, pdSpecEst:::kw_time[i,,1], col = i, lty = i)
  points(d, pdSpecEst:::kw_time[i,,1], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
plot(range(n), range(pdSpecEst:::kw_time[1:3,,], na.rm=T), type="n", log = "xy", main = "Increasing sample size n, (d = 4)", xlab = "n", ylab = "Time (ms)")
for(i in 1:3){
  lines(n, pdSpecEst:::kw_time[i,,2], col = i, lty = i)
  points(n, pdSpecEst:::kw_time[i,,2], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
```
<br>
**Manifold Bartels-von Neumann test**
The figure below displays average computation times of the manifold Bartels-von Neumann test for a single sample of size `n` of `(d,d)`-dimensional HPD matrices, with depth-induced ranks based on the geodesic distance depth (`gdd`), manifold zonoid depth (`zonoid`) and manifold spatial depth (`spatial`) respectively.<br>
<br>
```{r, echo = FALSE}
d <- round(exp(seq(from = log(2), to = log(32), length = 5)), digits = 0)
n <- round(exp(seq(from = log(50), to = log(500), length = 5)), digits = 0)
par(mfrow = c(1,2), mgp = c(2,0.5,0), mar = c(4,3,2,2))
plot(range(d), range(pdSpecEst:::bart_time, na.rm=T), type="n", log = "xy", main = "Increasing dimension d x d, (n = 200)", xlab = "d", ylab = "Time (ms)")
for(i in 1:3){
  lines(d, pdSpecEst:::bart_time[i,,1], col = i, lty = i)
  points(d, pdSpecEst:::bart_time[i,,1], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
plot(range(n), range(pdSpecEst:::bart_time, na.rm=T), type="n", log = "xy", main = "Increasing sample size n, (d = 4)", xlab = "n", ylab = "Time (ms)")
for(i in 1:3){
  lines(n, pdSpecEst:::bart_time[i,,2], col = i, lty = i)
  points(n, pdSpecEst:::bart_time[i,,2], col = i, pch = 15+i)
}
legend("bottomright", legend = c("gdd", "zonoid", "spatial"), lty = 1:3, pch = 16:18, col = 1:3, cex = 1, bty = "n", y.intersp = 1)
```
<br>
**Manifold Wilcoxon signed-rank test**
The figure below displays average computation times of the manifold Wilcoxon signed-rank test for two equal-sized samples of size `n` of `(d,d)`-dimensional HPD matrices. This test is not based on data depth but on a specific intrinsic manifold difference score. <br>
<br>
```{r, echo = FALSE}
d <- round(exp(seq(from = log(2), to = log(128), length = 10)), digits = 0)
n <- round(exp(seq(from = log(50), to = log(500), length = 10)), digits = 0)
par(mfrow = c(1,2), mgp = c(2,0.5,0), mar = c(4,3,2,2))
plot(range(d), range(pdSpecEst:::sr_time, na.rm=T), type="n", log = "xy", main = "Increasing dimension d x d, (n = 100)", xlab = "d", ylab = "Time (ms)")
  lines(d, pdSpecEst:::sr_time[,1], col = 1, lty = 1)
  points(d, pdSpecEst:::sr_time[,1], col = 1, pch = 16)
plot(range(n), range(pdSpecEst:::sr_time, na.rm=T), type="n", log = "xy", main = "Increasing sample size n, (d = 6)", xlab = "n", ylab = "Time (ms)")
  lines(n, pdSpecEst:::sr_time[,2], col = 2, lty = 2)
  points(n, pdSpecEst:::sr_time[,2], col = 2, pch = 17)
```

To conclude, we note again that an interactive demo Shiny app to test and tune the different rank-based test procedures detailed in this vignette is available at [https://jchau.shinyapps.io/pdSpecEst/](https://jchau.shinyapps.io/pdSpecEst/). 

## References

