---
title: "Covsim: Simulating non-normal data with given covariance matrix"
author: "Njål Foldnes and Steffen Grønneberg"
date: "2024-05-31"
output: html_document

vignette: >
  %\VignetteIndexEntry{Covsim: Simulating non-normal data with given covariance matrix}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
citation_package: natbib
bibliography: bibcovsim.bib
biblio-style: apalike
---


The covsim package includes three methods for simulating non-normal data from distributions with given covariance matrix. The most flexible method is VIne-To-Anything (VITA) (@gronneberg2017covariance), and its implementation and use in covsim is explained in @jss. VITA allows complete specification of the marginal distributions, and partial specification of bivariate dependencies.

In addition to VITA, two more simple methods are available in covsim, which allows specification of univariate skewness and kurtosis. The independent generator (IG) was proposed by @foldnes2016simple, while the piecewise linear approach (PLSIM) was proposed by @foldnes2021plsim.

# VITA

The function vita() returns a regular vine object as defined by package rvinecopulib (@rvinecopulib).
This object may be used to simulate data from the corresponding vine distribution.
The function takes a list of marginal distributions and a covariance matrix as essential input.
In addition, the user may provide details on the vine structure and the bivariate copulae to be considered at each node in the vine.

## Bivariate case

Let us first consider the bivariate case, where we want a distribution with standard normal marginals coupled by a Clayton copula, whose correlation is $\rho=.8$

```r
library("covsim")
mnorm <- list(list(distr = "norm"), list(distr = "norm"))
sigma.target <- matrix(c(1, 0.8, 0.8, 1), 2)
set.seed(1)
calibrated.vita <- vita(mnorm, sigma.target, family_set = "clayton")
#> Tree 1 
#>     1 - 2 ( 1 of 1 )
summary(calibrated.vita)
#> $margins
#> # A data.frame: 2 x 2 
#>  margin distr
#>       1  norm
#>       2  norm
#> 
#> $copula
#> # A data.frame: 1 x 10 
#>  tree edge conditioned conditioning var_types  family rotation parameters df  tau
#>     1    1        1, 2                    c,c clayton        0        3.4  0 0.63
```

The calibrated vita object is made from a Clayton copula with dependence parameter $\theta=3.4$.
You can confirm that the vine distribution has correlation $\rho=.8$, by simulating a $n=10^5$ sample from the vita object:




```r
library("rvinecopulib")
large.sample <- rvine(10^5, calibrated.vita)
cov(large.sample)
#>           [,1]      [,2]
#> [1,] 0.9994719 0.8017954
#> [2,] 0.8017954 0.9985791
```

## Trivariate case

The motivation for this example is given in @jss, and we here restrict ourselves to calibration of the vita object. Our target covariance matrix is
$$ \Sigma =  \begin{pmatrix}   1 & 0.4 & 0.3 \\
  0.4 & 1 & 0.4 \\
  0.3 & 0.4 & 1 \\  \end{pmatrix},   $$
and we want the marginals to be the standard
normal distribution,  a scaled chi-squared
distribution with one degree of freedom, and a scaled Student's $t$ distribution with five DFs.
The scalings ensure unit variance. In addition, we want to specify the vine structure explicitly, and also the copula family for each bivariate dependency as follows.
Note: We set Nmax=10^5 to speed things up, the default, Nmax=10^6 should be used for serious work.


```r
sigma.target <- matrix(c(1, 0.4, 0.3, 0.4, 1, 0.4, 0.3, 0.4, 1), 3)
margins <- list(list(distr = "norm"), list(distr = "chisq", df = 1),
                list(distr = "t", df = 5))
pcs <- list(list(bicop_dist("clayton"), bicop_dist("joe")),
            list(bicop_dist("frank")))
vine_cop <- vinecop_dist(pcs, structure = dvine_structure(1:3))
margin.variances <- c(1, 2, 5/3)
pre <- diag(sqrt(margin.variances/diag(sigma.target)))
vita.target <- pre %*% sigma.target %*% pre
set.seed(1)
calibrated.vita <- vita(margins, vita.target, vc = vine_cop,
                        verbose = TRUE, Nmax = 10^5)#FAST CALIBRATION
#> Tree 1 
#>     1 - 2 ( 1 of 3 )
#>     2 - 3 ( 2 of 3 )
#> Tree 2 
#>     1 - 3 ( 3 of 3 )
post <- diag(1/diag(pre))
vita.sample <- rvine(10^5, calibrated.vita) %*% post
round(cov(vita.sample) - sigma.target, 3)
#>        [,1]   [,2]   [,3]
#> [1,]  0.001  0.003 -0.004
#> [2,]  0.003  0.002 -0.002
#> [3,] -0.004 -0.002 -0.003
library(GGally)
GGally::ggpairs(data.frame(head(vita.sample, 2*10^3)))
```

<div class="figure">
<img src="vita-1.png" alt="plot of chunk vita" width="75%" />
<p class="caption">plot of chunk vita</p>
</div>

Note that if the vc option is not included in the vita() call, the default will be the simple structure given by a d-vine. The copula families in each node (each bivariate association) may be specified by option family_set, where the default ensures that first a Clayton copula is tentatively calibrated. If unsuccesful, next a gauss, joe, gumbel or frank copula are calibrated, in that order. If none of these families can produce the required covariance, vita() returns an error message indicating that no vine distributional class can match the given marginals and covariance matrix.

## SEM example in 20 dimensions

![SEM population model, from @li](sem.jpg)



```r
sem.pop <- 'Ksi1 =~ start(.8)*x1 +start(.7)*x2 +start(.6)*x3 +start(.5)*x4
Ksi2 =~ start(.8)*x5 + start(.7)*x6 + start(.6)*x7 +start(.5)*x8
Eta1 =~ start(.8)*y1 + start(.7)*y2 + start(.6)*y3 +start(.5)*y4
Eta2 =~ start(.8)*y5 + start(.7)*y6 + start(.6)*y7 +start(.5)*y8
Eta3 =~ start(.8)*y9 + start(.7)*y10 + start(.6)*y11 +start(.5)*y12
Eta1 ~ start(.4)*Ksi1 + start(.6)*Ksi2
Eta2 ~ start(.4)*Ksi1 + start(.2)*Ksi2 + start(.3)*Eta1
Eta3 ~ start(.1)*Ksi1 + start(.1)*Ksi2 + start(.2)*Eta1 +start(.5)*Eta2
Ksi1 ~~ start(.3)*Ksi2; Eta1 ~~ start(.5)*Eta1;
Eta2 ~~ start(.5)*Eta2; Eta3 ~~ start(.5)*Eta3
x1 ~~ start(.5)*x1; x2 ~~ start(.5)*x2
x3 ~~ start(.5)*x3; x4 ~~ start(.5)*x4; x5 ~~ start(.5)*x5
x6 ~~ start(.5)*x6; x7 ~~ start(.5)*x7; x8 ~~ start(.5)*x8
y1 ~~ start(.5)*y1; y2 ~~ start(.5)*y2; y3 ~~ start(.5)*y3
y4 ~~ start(.5)*y4; y5 ~~ start(.5)*y5; y6 ~~ start(.5)*y6
y7 ~~ start(.5)*y7; y8 ~~ start(.5)*y8; y9 ~~ start(.5)*y9
y10 ~~ start(.5)*y10; y11 ~~ start(.5)*y11; y12 ~~ start(.5)*y12'
library(lavaan)
sigma.target <- lavInspect(sem(sem.pop, data = NULL), "sigma.hat")
```

Next, we fit a VITA distribution with normal marginals to the target
covariance matrix. This is a variant of a data generating distribution
used in the simulation study of @foldnes2021plsim.  First, the
margins are scaled to match the target variances. Then, we calibrate a
VITA distribution. Note that we do not specify which family of copulae
to use, so the default Clayton copula is used. Finally, a list of 1000
samples, each of sample size 1000, is drawn from the calibrated vita
distribution.

```r
marginsnorm <- lapply(X = sqrt(diag(sigma.target)),
                      function(X) list(distr = "norm", sd = sqrt(X)))
vitadist <- vita(marginsnorm, sigma.target)
#> Tree 1 
#>     1 - 2 ( 1 of 190 )
#>     2 - 3 ( 2 of 190 )
#>     3 - 4 ( 3 of 190 )
#>     4 - 5 ( 4 of 190 )
#>     5 - 6 ( 5 of 190 )
#>     6 - 7 ( 6 of 190 )
#>     7 - 8 ( 7 of 190 )
#>     8 - 9 ( 8 of 190 )
#>     9 - 10 ( 9 of 190 )
#>     10 - 11 ( 10 of 190 )
#>     11 - 12 ( 11 of 190 )
#>     12 - 13 ( 12 of 190 )
#>     13 - 14 ( 13 of 190 )
#>     14 - 15 ( 14 of 190 )
#>     15 - 16 ( 15 of 190 )
#>     16 - 17 ( 16 of 190 )
#>     17 - 18 ( 17 of 190 )
#>     18 - 19 ( 18 of 190 )
#>     19 - 20 ( 19 of 190 )
#> Tree 2 
#>     1 - 3 ( 20 of 190 )
#>     2 - 4 ( 21 of 190 )
#>     3 - 5 ( 22 of 190 )
#>     4 - 6 ( 23 of 190 )
#>     5 - 7 ( 24 of 190 )
#>     6 - 8 ( 25 of 190 )
#>     7 - 9 ( 26 of 190 )
#>     8 - 10 ( 27 of 190 )
#>     9 - 11 ( 28 of 190 )
#>     10 - 12 ( 29 of 190 )
#>     11 - 13 ( 30 of 190 )
#>     12 - 14 ( 31 of 190 )
#>     13 - 15 ( 32 of 190 )
#>     14 - 16 ( 33 of 190 )
#>     15 - 17 ( 34 of 190 )
#>     16 - 18 ( 35 of 190 )
#>     17 - 19 ( 36 of 190 )
#>     18 - 20 ( 37 of 190 )
#> Tree 3 
#>     1 - 4 ( 38 of 190 )
#>     2 - 5 ( 39 of 190 )
#>     3 - 6 ( 40 of 190 )
#>     4 - 7 ( 41 of 190 )
#>     5 - 8 ( 42 of 190 )
#>     6 - 9 ( 43 of 190 )
#>     7 - 10 ( 44 of 190 )
#>     8 - 11 ( 45 of 190 )
#>     9 - 12 ( 46 of 190 )
#>     10 - 13 ( 47 of 190 )
#>     11 - 14 ( 48 of 190 )
#>     12 - 15 ( 49 of 190 )
#>     13 - 16 ( 50 of 190 )
#>     14 - 17 ( 51 of 190 )
#>     15 - 18 ( 52 of 190 )
#>     16 - 19 ( 53 of 190 )
#>     17 - 20 ( 54 of 190 )
#> Tree 4 
#>     1 - 5 ( 55 of 190 )
#>     2 - 6 ( 56 of 190 )
#>     3 - 7 ( 57 of 190 )
#>     4 - 8 ( 58 of 190 )
#>     5 - 9 ( 59 of 190 )
#>     6 - 10 ( 60 of 190 )
#>     7 - 11 ( 61 of 190 )
#>     8 - 12 ( 62 of 190 )
#>     9 - 13 ( 63 of 190 )
#>     10 - 14 ( 64 of 190 )
#>     11 - 15 ( 65 of 190 )
#>     12 - 16 ( 66 of 190 )
#>     13 - 17 ( 67 of 190 )
#>     14 - 18 ( 68 of 190 )
#>     15 - 19 ( 69 of 190 )
#>     16 - 20 ( 70 of 190 )
#> Tree 5 
#>     1 - 6 ( 71 of 190 )
#>     2 - 7 ( 72 of 190 )
#>     3 - 8 ( 73 of 190 )
#>     4 - 9 ( 74 of 190 )
#>     5 - 10 ( 75 of 190 )
#>     6 - 11 ( 76 of 190 )
#>     7 - 12 ( 77 of 190 )
#>     8 - 13 ( 78 of 190 )
#>     9 - 14 ( 79 of 190 )
#>     10 - 15 ( 80 of 190 )
#>     11 - 16 ( 81 of 190 )
#>     12 - 17 ( 82 of 190 )
#>     13 - 18 ( 83 of 190 )
#>     14 - 19 ( 84 of 190 )
#>     15 - 20 ( 85 of 190 )
#> Tree 6 
#>     1 - 7 ( 86 of 190 )
#>     2 - 8 ( 87 of 190 )
#>     3 - 9 ( 88 of 190 )
#>     4 - 10 ( 89 of 190 )
#>     5 - 11 ( 90 of 190 )
#>     6 - 12 ( 91 of 190 )
#>     7 - 13 ( 92 of 190 )
#>     8 - 14 ( 93 of 190 )
#>     9 - 15 ( 94 of 190 )
#>     10 - 16 ( 95 of 190 )
#>     11 - 17 ( 96 of 190 )
#>     12 - 18 ( 97 of 190 )
#>     13 - 19 ( 98 of 190 )
#>     14 - 20 ( 99 of 190 )
#> Tree 7 
#>     1 - 8 ( 100 of 190 )
#>     2 - 9 ( 101 of 190 )
#>     3 - 10 ( 102 of 190 )
#>     4 - 11 ( 103 of 190 )
#>     5 - 12 ( 104 of 190 )
#>     6 - 13 ( 105 of 190 )
#>     7 - 14 ( 106 of 190 )
#>     8 - 15 ( 107 of 190 )
#>     9 - 16 ( 108 of 190 )
#>     10 - 17 ( 109 of 190 )
#>     11 - 18 ( 110 of 190 )
#>     12 - 19 ( 111 of 190 )
#>     13 - 20 ( 112 of 190 )
#> Tree 8 
#>     1 - 9 ( 113 of 190 )
#>     2 - 10 ( 114 of 190 )
#>     3 - 11 ( 115 of 190 )
#>     4 - 12 ( 116 of 190 )
#>     5 - 13 ( 117 of 190 )
#>     6 - 14 ( 118 of 190 )
#>     7 - 15 ( 119 of 190 )
#>     8 - 16 ( 120 of 190 )
#>     9 - 17 ( 121 of 190 )
#>     10 - 18 ( 122 of 190 )
#>     11 - 19 ( 123 of 190 )
#>     12 - 20 ( 124 of 190 )
#> Tree 9 
#>     1 - 10 ( 125 of 190 )
#>     2 - 11 ( 126 of 190 )
#>     3 - 12 ( 127 of 190 )
#>     4 - 13 ( 128 of 190 )
#>     5 - 14 ( 129 of 190 )
#>     6 - 15 ( 130 of 190 )
#>     7 - 16 ( 131 of 190 )
#>     8 - 17 ( 132 of 190 )
#>     9 - 18 ( 133 of 190 )
#>     10 - 19 ( 134 of 190 )
#>     11 - 20 ( 135 of 190 )
#> Tree 10 
#>     1 - 11 ( 136 of 190 )
#>     2 - 12 ( 137 of 190 )
#>     3 - 13 ( 138 of 190 )
#>     4 - 14 ( 139 of 190 )
#>     5 - 15 ( 140 of 190 )
#>     6 - 16 ( 141 of 190 )
#>     7 - 17 ( 142 of 190 )
#>     8 - 18 ( 143 of 190 )
#>     9 - 19 ( 144 of 190 )
#>     10 - 20 ( 145 of 190 )
#> Tree 11 
#>     1 - 12 ( 146 of 190 )
#>     2 - 13 ( 147 of 190 )
#>     3 - 14 ( 148 of 190 )
#>     4 - 15 ( 149 of 190 )
#>     5 - 16 ( 150 of 190 )
#>     6 - 17 ( 151 of 190 )
#>     7 - 18 ( 152 of 190 )
#>     8 - 19 ( 153 of 190 )
#>     9 - 20 ( 154 of 190 )
#> Tree 12 
#>     1 - 13 ( 155 of 190 )
#>     2 - 14 ( 156 of 190 )
#>     3 - 15 ( 157 of 190 )
#>     4 - 16 ( 158 of 190 )
#>     5 - 17 ( 159 of 190 )
#>     6 - 18 ( 160 of 190 )
#>     7 - 19 ( 161 of 190 )
#>     8 - 20 ( 162 of 190 )
#> Tree 13 
#>     1 - 14 ( 163 of 190 )
#>     2 - 15 ( 164 of 190 )
#>     3 - 16 ( 165 of 190 )
#>     4 - 17 ( 166 of 190 )
#>     5 - 18 ( 167 of 190 )
#>     6 - 19 ( 168 of 190 )
#>     7 - 20 ( 169 of 190 )
#> Tree 14 
#>     1 - 15 ( 170 of 190 )
#>     2 - 16 ( 171 of 190 )
#>     3 - 17 ( 172 of 190 )
#>     4 - 18 ( 173 of 190 )
#>     5 - 19 ( 174 of 190 )
#>     6 - 20 ( 175 of 190 )
#> Tree 15 
#>     1 - 16 ( 176 of 190 )
#>     2 - 17 ( 177 of 190 )
#>     3 - 18 ( 178 of 190 )
#>     4 - 19 ( 179 of 190 )
#>     5 - 20 ( 180 of 190 )
#> Tree 16 
#>     1 - 17 ( 181 of 190 )
#>     2 - 18 ( 182 of 190 )
#>     3 - 19 ( 183 of 190 )
#>     4 - 20 ( 184 of 190 )
#> Tree 17 
#>     1 - 18 ( 185 of 190 )
#>     2 - 19 ( 186 of 190 )
#>     3 - 20 ( 187 of 190 )
#> Tree 18 
#>     1 - 19 ( 188 of 190 )
#>     2 - 20 ( 189 of 190 )
#> Tree 19 
#>     1 - 20 ( 190 of 190 )
randomsamples <- replicate(10^3, rvine(10^3, vitadist))
```


The above calibration step is time-consuming, since it is high-dimensional.
With 20 variables, the calibration step
required 1.8 hours (again using a 2.3 GHz 8-Core Intel Core i9
CPU). This step is only performed once.  When completed, random
samples can be drawn at a relatively fast rate. Producing 1000 samples
each of size 1000 took one minute to complete.  Finally, we note that
the calibration step may be performed faster by specifying option
Nmax=$10^5$ when calling vita(), at the expense of
reduced precision in covariance matching.


## Ordinal-categorical data

We assume that the underlying correlation in a
continuous bivariate distribution with standard normal marginals is
$\rho=0.5$, and we discretize into three categories using thresholds
$\tau_1=0$ and $\tau_2=1$. This means that we consider simulated data
of the form
\[
  X_i =
  \left\{  \begin{matrix}
      1, & \text{if } \xi_i \leq \tau_1 \\
      2, & \text{if } \tau_1 < \xi_i \leq \tau_2 \\
      3, & \text{if } \xi_i > \tau_2 \\
    \end{matrix}
  \right.
  =
  \left\{  \begin{matrix}
      1, & \text{if } \xi_i \leq 0 \\
      2, & \text{if } 0 < \xi_i \leq 1 \\
      3, & \text{if } \xi_i > 1 \\
    \end{matrix}
  \right.
\]
for $i=1,2$, where $(\xi_1,\xi_2)$ is a continuous random vector
simulated using VITA.  Both ordinal variables have proportions
$0.5, 0.34,$ and $0.16$. We inquire whether the polychoric correlation
estimator used in ordinal SEM becomes biased when we replace the
bivariate normal with a Clayton or a Joe copula. So first, we
determine parameters for the latter two copulas such that, when
marginals are standard normal, the Pearson correlation is $0.5$.
We then discretize a large sample from each of the VITA distributions and estimate the polychoric correlation.
The estimates turn out to be very biased:


```r
sigma.target <- matrix(c(1, 0.5, 0.5, 1), 2)
set.seed(1)
vita_clayton <- vita(list(list(distr = "norm"), list(distr = "norm")),
                     sigma.target, family_set = "clayton")
#> Tree 1 
#>     1 - 2 ( 1 of 1 )
set.seed(1)
vita_joe <- vita(list(list(distr = "norm"), list(distr = "norm")),
                 sigma.target, family_set = "joe")
#> Tree 1 
#>     1 - 2 ( 1 of 1 )
clayton.disc <- apply(rvine(10^5, vita_clayton), 2, cut,
                      breaks = c(-Inf, 0, 1, Inf), labels = FALSE)
joe.disc <- apply(rvine(10^5, vita_joe), 2, cut,
                      breaks = c(-Inf, 0, 1, Inf), labels = FALSE)
library(psych)
#polychoric correlation (based on underlying normality) is severely biased (downards for Clayton, and upwards for Joe)
polychoric(clayton.disc)$rho
#>          [,1]     [,2]
#> [1,] 1.000000 0.419161
#> [2,] 0.419161 1.000000
polychoric(joe.disc)$rho
#>           [,1]      [,2]
#> [1,] 1.0000000 0.5918562
#> [2,] 0.5918562 1.0000000
```


# IG and Piecewise linear methods

The IG and PLSIM methods require just specifying the kurtosis and skewness of each marginal distribution, together with the covariance matrix. Hence, the marginals are not fully controlled, in contrast to VITA.

Let us require skewness=2 and excess kurtosis =7 in each of three marginal distributions.
The covariance matrix is specified as
$$ \Sigma =  \begin{pmatrix}   1 & 0.4 & 0.3 \\
  0.4 & 1 & 0.4 \\
  0.3 & 0.4 & 1 \\  \end{pmatrix},   $$


## IG
Function rIG() returns a list of simulated samples, of length specified by option reps.
The default is reps=1 (one sample only), so we need to append [[1]]:


```r
skewness=rep(2, 3)
excesskurtosis=rep(7,3)
sigma.target <- matrix(c(1, 0.4, 0.3, 0.4, 1, 0.4, 0.3, 0.4, 1), 3)
set.seed(1)
ig.sample <- rIG(10^4, sigma.target, skewness, excesskurtosis )[[1]]
round(cov(ig.sample)-sigma.target,3)
#>        [,1]   [,2]   [,3]
#> [1,] -0.069 -0.016 -0.005
#> [2,] -0.016 -0.052 -0.025
#> [3,] -0.005 -0.025 -0.017
psych::skew(ig.sample)
#> [1] 1.814969 1.890223 1.925510
psych::kurtosi(ig.sample)
#> [1] 5.400986 5.717628 6.272962
```
## PLSIM


The piecewise linear approach is run similarly:

```r
set.seed(1)
pl.sample <- rPLSIM(10^4, sigma.target, skewness, excesskurtosis )[[1]]
pl.sample <- data.frame(pl.sample)
round(cov(pl.sample)-sigma.target,3)
#>       X1    X2    X3
#> X1 0.011 0.012 0.036
#> X2 0.012 0.051 0.034
#> X3 0.036 0.034 0.044
psych::skew(pl.sample)
#> [1] 1.985208 2.047052 1.923874
psych::kurtosi(pl.sample)
#>       X1       X2       X3 
#> 6.545025 6.978239 6.029132
```

Note that rPLSIM() is slower that rIG(), since it requires numerical optimization for each pair of variables.
The distributions stemming from PLSIM are different from the IG distributions, even if the covariance matrix and the marginal skewness and kurtosi are identical.




```r
GGally::ggpairs(data.frame(ig.sample)[2:10^3,])
```

<div class="figure">
<img src="IG_PL-1.png" alt="plot of chunk IG_PL" width="75%" />
<p class="caption">plot of chunk IG_PL</p>
</div>

```r
GGally::ggpairs(data.frame(pl.sample)[2:10^3,])
```

<div class="figure">
<img src="IG_PL-2.png" alt="plot of chunk IG_PL" width="75%" />
<p class="caption">plot of chunk IG_PL</p>
</div>


# References







