#+TITLE: Covariance pattern in LMMstar
#+Author: Brice Ozenne

* LV pattern

** Theory

Consider 4 timepoints. The traditional parametrisation of the residual
variance-covariance matrix of a factor model is
#+BEGIN_EXPORT latex
\[ \Omega = \begin{bmatrix}
\omega^2_1 + \tau & .                           & .                           & . \\
\lambda_2 \tau    & \omega^2_2 + \lambda^2_2\tau & .                           & . \\
\lambda_3 \tau    & \lambda_2 \lambda_3 \tau    & \omega^2_3 + \lambda^2_3 \tau & . \\
\lambda_4 \tau    & \lambda_2 \lambda_4 \tau    & \lambda_3 \lambda_4 \tau     & \omega^2_4 + \lambda^2_4 \tau \\
\end{bmatrix} \]
#+END_EXPORT
LMMstar uses a different parametrisation with distinct parameters for
the variance and the correlation:
#+BEGIN_EXPORT latex
\[ \Omega = \begin{bmatrix}
\sigma^2_1                      & .                              & .                               & . \\
\rho_1 \rho_2 \sigma_1 \sigma_2 & \sigma^2_2                      & .                              & . \\
\rho_1 \rho_3 \sigma_1 \sigma_3 & \rho_2 \rho_3 \sigma_2 \sigma_3 & \sigma^2_3                      & . \\
\rho_1 \rho_4 \sigma_1 \sigma_4 & \rho_2 \rho_4 \sigma_2 \sigma_4 & \rho_3 \rho_4 \sigma_3 \sigma_4 & \sigma^2_4 \\
\end{bmatrix} \]
#+END_EXPORT

The two parametrisation are equivalent when assuming the same sign for
all correlation (e.g. all positive correlation).

\bigskip

\(\boldsymbol{\omega},\boldsymbol{\tau},\boldsymbol{\lambda}
\rightarrow \boldsymbol{\rho},\boldsymbol{\sigma}\): the \(\sigma\)
values can be deduce from the diagonal of \(\Omega\). \newline To get the
\(\rho\) value, we can first multiply \(\rho_1 \rho_2 \sigma_1
\sigma_2 = \lambda_2 \tau \) by \(\rho_1 \rho_3 \sigma_1 \sigma_3 =
\lambda_3 \tau \) and divide by \(\rho_2 \rho_3 \sigma_2 \sigma_3 =
\lambda_2 \lambda_3 \tau \):
#+BEGIN_EXPORT latex
\begin{align*}
\frac{\rho_1^2 \rho_2 \rho_3 \sigma_1^2 \sigma_2 \sigma_3}{\rho_2 \rho_3 \sigma_2 \sigma_3} &= \frac{\lambda_2 \lambda_3 \tau^2}{\lambda_2 \lambda_3 \tau} \\
\rho_1^2 \sigma_1^2 &= \tau \\
\rho_1^2 = \frac{\tau}{\omega_1^2 + \tau}
\end{align*}
#+END_EXPORT
More generally, denoting \(\lambda_1=1\), from:
#+BEGIN_EXPORT latex
\begin{align*}
\sigma_i^2  &= \omega_i^2+\lambda_i^2\tau \\
\rho_i \rho_j \sigma_i \sigma_j &= \lambda_i \lambda_j \tau
\end{align*}
#+END_EXPORT
we can deduce
#+BEGIN_EXPORT latex
\begin{align*}
\rho_i^2 \rho_j \rho_k  \sigma_i^2 \sigma_j \sigma_k &= \lambda_i^2 \lambda_j \lambda_k \tau^2 \\
\rho_i^2  \sigma_i^2 &= \lambda_i^2 \tau \\
\rho_i  &=  \sqrt{\frac{\lambda_i^2 \tau}{\omega_i^2+\lambda_i^2\tau}}
\end{align*}
#+END_EXPORT
Technical \(\rho_i\) could be negative but here use the assumption of
same (positive) sign for all correlations.

\bigskip

\( \boldsymbol{\rho},\boldsymbol{\sigma} \rightarrow
\boldsymbol{\omega},\boldsymbol{\tau},\boldsymbol{\lambda}\): we can re-use the previous result:
#+BEGIN_EXPORT latex
\begin{align*}
\rho_i^2  &=  \frac{\lambda_i^2 \tau}{\omega_i^2+\lambda_i^2\tau} = \frac{\lambda_i^2 \tau}{\sigma_i^2}
\end{align*}
#+END_EXPORT
So for \(i=1\):
#+BEGIN_EXPORT latex
\begin{align*}
\tau  &= \rho_1^2 \sigma_1^2
\end{align*}
#+END_EXPORT
and otherwise:
#+BEGIN_EXPORT latex
\begin{align*}
\lambda_i^2  &=  \frac{\rho_i^2 \sigma_i^2}{\rho_1^2 \sigma_1^2} \\
\lambda_i  &= sign(\rho_1 \rho_i) \frac{\rho_i\sigma_i}{\rho_1 \sigma_1}
\end{align*}
#+END_EXPORT
One can then deduce \(\omega_i\):
#+BEGIN_EXPORT latex
\begin{align*}
\omega_i  &=  \sqrt{\sigma_i^2 - \lambda_i \tau} = \sigma_i \sqrt{1-\rho_i^2}
\end{align*}
#+END_EXPORT

\clearpage

** Example

Simulate data
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
library(lava)
library(LMMstar)

mSim <- lvm(c(Y1,Y2,Y3,Y4)~eta+age)
latent(mSim) <- ~eta

set.seed(10)
n <- 100
n.time <- length(endogenous(mSim))
dfW.sim <- cbind(id = paste0("Id",1:n), sim(mSim, n = n, latent = FALSE))
dfW.sim$id <- factor(dfW.sim$id, unique(dfW.sim$id))
head(dfW.sim)
#+END_SRC

#+RESULTS:
:    id         Y1          Y2         Y3         Y4        age
: 1 Id1  0.8087642  0.02821369  2.0055318 2.29256267  0.8694750
: 2 Id2  0.3174894  0.92111736  0.8326184 1.09215142 -0.6800096
: 3 Id3  0.9880281  1.31941524  3.7496337 1.72867315  0.1732145
: 4 Id4 -0.3524308  0.95831086  1.1187839 1.03908643 -0.1594380
: 5 Id5  0.3496855 -0.57807269 -1.0256767 0.18052490  0.7934994
: 6 Id6  0.1276581  0.30103845  0.2336854 0.06061876  1.6943505

Convert to long format:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
dfL.sim <- reshape(dfW.sim, direction = "long", idvar = c("id","age"), varying = paste0("Y",1:4), sep="")
dfL.sim$time <- as.factor(dfL.sim$time)
rownames(dfL.sim) <- NULL
head(dfL.sim)
#+END_SRC

#+RESULTS:
:    id        age time          Y
: 1 Id1  0.8694750    1  0.8087642
: 2 Id2 -0.6800096    1  0.3174894
: 3 Id3  0.1732145    1  0.9880281
: 4 Id4 -0.1594380    1 -0.3524308
: 5 Id5  0.7934994    1  0.3496855
: 6 Id6  1.6943505    1  0.1276581

Fit LVM:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
m.lvm <- lvm(c(Y1,Y2,Y3,Y4)~eta+age, eta ~ 0)
latent(m.lvm) <- ~eta
e.lvm <- estimate(m.lvm, data = dfW.sim)
logLik(e.lvm)
#+END_SRC

#+RESULTS:
: 'log Lik.' -651.0478 (df=16)

Export coefficient by type:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
mu.lvm <- coef(e.lvm)[c(paste0("Y",1:n.time),paste0("Y",1:n.time,"~age"))]
lambda.lvm <- c(1,coef(e.lvm)[paste0("Y",2:n.time,"~eta")])
tau.lvm <- coef(e.lvm)["eta~~eta"]
omega.lvm <- coef(e.lvm)[paste0("Y",1:n.time,"~~Y",1:n.time)]
list(mu = mu.lvm,
     lambda = lambda.lvm,
     tau = tau.lvm,
     omega = omega.lvm)
#+END_SRC

#+RESULTS:
#+begin_example
$mu
        Y1         Y2         Y3         Y4     Y1~age     Y2~age     Y3~age 
-0.1835368 -0.1491306 -0.0194078  0.1459640  0.9502774  1.0535363  0.9671297 
    Y4~age 
 1.0349377 

$lambda
             Y2~eta    Y3~eta    Y4~eta 
1.0000000 0.8653753 1.1024519 1.0537868 

$tau
eta~~eta 
1.259395 

$omega
   Y1~~Y1    Y2~~Y2    Y3~~Y3    Y4~~Y4 
0.8444582 0.9968492 1.0012298 0.9868099
#+end_example

Conversion to LMM coefficients:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
list(sigma = sqrt(omega.lvm + lambda.lvm^2 * tau.lvm),
     rho = sqrt( lambda.lvm^2 * tau.lvm / (omega.lvm + lambda.lvm^2 * tau.lvm)))
#+END_SRC

#+RESULTS:
: $sigma
:   Y1~~Y1   Y2~~Y2   Y3~~Y3   Y4~~Y4 
: 1.450466 1.392831 1.591194 1.544450 
: 
: $rho
:              Y2~eta    Y3~eta    Y4~eta 
: 0.7737012 0.6972477 0.7775305 0.7657021

\clearpage

Fit LMM:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
rhoLVM <- function(p,time,...){
  R <- tcrossprod(p[time])
  diag(R) <- 1
  return(R)
}
myStruct <- CUSTOM(~time,
                   FCT.sigma = function(p,time,X){p[time]},
                   init.sigma = setNames(rep(1.45,n.time),paste0("sigma",1:n.time)),
                   FCT.rho = rhoLVM,
                   init.rho = setNames(rep(0.7,n.time),paste0("rho",1:n.time)))
e.lmmCUSTOM <- lmm(Y ~ time*age,
                   repetition = ~time|id,
                   structure  = myStruct, data = dfL.sim,
                   method.fit = "ML")
logLik(e.lmmCUSTOM)
#+END_SRC

#+RESULTS:
: [1] -651.0478

We get exactly the same log-likelihood as the latent variable
model. Export coefficient by type:

#+BEGIN_SRC R :exports both :results output :session *R* :cache no
mu.lmm <- coef(e.lmmCUSTOM, effects = "mean")
sigma.lmm <- coef(e.lmmCUSTOM, effects = "variance")
rho.lmm <- coef(e.lmmCUSTOM, effects = "correlation")
list(mu = mu.lmm,
     sigma = sigma.lmm,
     rho = rho.lmm)
#+END_SRC

#+RESULTS:
#+begin_example
$mu
(Intercept)       time2       time3       time4         age   time2:age 
-0.18353676  0.03440620  0.16412896  0.32950080  0.95027744  0.10325886 
  time3:age   time4:age 
 0.01685224  0.08466026 

$sigma
  sigma1   sigma2   sigma3   sigma4 
1.450466 1.392831 1.591194 1.544450 

$rho
     rho1      rho2      rho3      rho4 
0.7737013 0.6972475 0.7775306 0.7657020
#+end_example

\clearpage

Conversion to LVM coefficients:
#+BEGIN_SRC R :exports both :results output :session *R* :cache no
list(lambda = rho.lmm*sigma.lmm/(rho.lmm[1]*sigma.lmm[1]),
     tau = rho.lmm[1]^2*sigma.lmm[1]^2,
     omega = sigma.lmm^2 * (1-rho.lmm^2))
#+END_SRC

#+RESULTS:
#+begin_example
$lambda
    rho1     rho2     rho3     rho4 
1.000000 0.865375 1.102452 1.053786 

$tau
    rho1 
1.259395 

$omega
   sigma1    sigma2    sigma3    sigma4 
0.8444578 0.9968496 1.0012293 0.9868104
#+end_example

* CONFIG :noexport:
# #+LaTeX_HEADER:\affil{Department of Biostatistics, University of Copenhagen, Copenhagen, Denmark}
#+LANGUAGE:  en
#+LaTeX_CLASS: org-article
#+LaTeX_CLASS_OPTIONS: [12pt]
#+OPTIONS:   title:t author:t toc:nil todo:nil
#+OPTIONS:   H:3 num:t 
#+OPTIONS:   TeX:t LaTeX:t
#+LATEX_HEADER: %
#+LATEX_HEADER: %%%% specifications %%%%
#+LATEX_HEADER: %
** Latex command
#+LATEX_HEADER: \usepackage{ifthen}
#+LATEX_HEADER: \usepackage{xifthen}
#+LATEX_HEADER: \usepackage{xargs}
#+LATEX_HEADER: \usepackage{xspace}
#+LATEX_HEADER: \newcommand\Rlogo{\textbf{\textsf{R}}\xspace} % 
** Notations
** Code
# Documentation at https://org-babel.readthedocs.io/en/latest/header-args/#results
# :tangle (yes/no/filename) extract source code with org-babel-tangle-file, see http://orgmode.org/manual/Extracting-source-code.html 
# :cache (yes/no)
# :eval (yes/no/never)
# :results (value/output/silent/graphics/raw/latex)
# :export (code/results/none/both)
#+PROPERTY: header-args :session *R* :tangle yes :cache no ## extra argument need to be on the same line as :session *R*
# Code display:
#+LATEX_HEADER: \RequirePackage{fancyvrb}
#+LATEX_HEADER: \DefineVerbatimEnvironment{verbatim}{Verbatim}{fontsize=\small,formatcom = {\color[rgb]{0.5,0,0}}}
# ## change font size input
# ## #+ATTR_LATEX: :options basicstyle=\ttfamily\scriptsize
# ## change font size output
# ## \RecustomVerbatimEnvironment{verbatim}{Verbatim}{fontsize=\tiny,formatcom = {\color[rgb]{0.5,0,0}}}
** Display 
#+LATEX_HEADER: \RequirePackage{colortbl} % arrayrulecolor to mix colors
#+LATEX_HEADER: \RequirePackage{setspace} % to modify the space between lines - incompatible with footnote in beamer
#+LaTeX_HEADER:\renewcommand{\baselinestretch}{1.1}
#+LATEX_HEADER:\geometry{top=1cm}
#+LATEX_HEADER: \RequirePackage{colortbl} % arrayrulecolor to mix colors
# ## valid and cross symbols
#+LaTeX_HEADER: \RequirePackage{pifont}
#+LaTeX_HEADER: \RequirePackage{relsize}
#+LaTeX_HEADER: \newcommand{\Cross}{{\raisebox{-0.5ex}%
#+LaTeX_HEADER:		{\relsize{1.5}\ding{56}}}\hspace{1pt} }
#+LaTeX_HEADER: \newcommand{\Valid}{{\raisebox{-0.5ex}%
#+LaTeX_HEADER:		{\relsize{1.5}\ding{52}}}\hspace{1pt} }
#+LaTeX_HEADER: \newcommand{\CrossR}{ \textcolor{red}{\Cross} }
#+LaTeX_HEADER: \newcommand{\ValidV}{ \textcolor{green}{\Valid} }
# ## warning symbol
#+LaTeX_HEADER: \usepackage{stackengine}
#+LaTeX_HEADER: \usepackage{scalerel}
#+LaTeX_HEADER: \newcommand\Warning[1][3ex]{%
#+LaTeX_HEADER:   \renewcommand\stacktype{L}%
#+LaTeX_HEADER:   \scaleto{\stackon[1.3pt]{\color{red}$\triangle$}{\tiny\bfseries !}}{#1}%
#+LaTeX_HEADER:   \xspace
#+LaTeX_HEADER: }
# # change the color of the links
#+LaTeX_HEADER: \hypersetup{
#+LaTeX_HEADER:  citecolor=[rgb]{0,0.5,0},
#+LaTeX_HEADER:  urlcolor=[rgb]{0,0,0.5},
#+LaTeX_HEADER:  linkcolor=[rgb]{0,0,0.5},
#+LaTeX_HEADER: }
** Image
#+LATEX_HEADER: \RequirePackage{epstopdf} % to be able to convert .eps to .pdf image files
#+LATEX_HEADER: \RequirePackage{capt-of} % 
#+LATEX_HEADER: \RequirePackage{caption} % newlines in graphics
** List
#+LATEX_HEADER: \RequirePackage{enumitem} % to be able to convert .eps to .pdf image files
** Color
#+LaTeX_HEADER: \definecolor{lightred}{rgb}{1.0, 0.7, 0.7}
#+LaTeX_HEADER: \definecolor{lightblue}{rgb}{0.0, 0.8, 0.8}
#+LaTeX_HEADER: \newcommand{\darkblue}{blue!80!black}
#+LaTeX_HEADER: \newcommand{\darkgreen}{green!50!black}
#+LaTeX_HEADER: \newcommand{\darkred}{red!50!black}
** Algorithm
#+LATEX_HEADER: \RequirePackage{amsmath}
#+LATEX_HEADER: \RequirePackage{algorithm}
#+LATEX_HEADER: \RequirePackage[noend]{algpseudocode}
** Math
#+LATEX_HEADER: \RequirePackage{dsfont}
#+LATEX_HEADER: \RequirePackage{amsmath,stmaryrd,graphicx}
#+LATEX_HEADER: \RequirePackage{prodint} % product integral symbol (\PRODI)
# ## lemma
# #+LaTeX_HEADER: \RequirePackage{amsthm}
# #+LaTeX_HEADER: \newtheorem{theorem}{Theorem}
# #+LaTeX_HEADER: \newtheorem{lemma}[theorem]{Lemma}
*** Template for shortcut
#+LATEX_HEADER: \newcommand\defOperator[7]{%
#+LATEX_HEADER:	\ifthenelse{\isempty{#2}}{
#+LATEX_HEADER:		\ifthenelse{\isempty{#1}}{#7{#3}#4}{#7{#3}#4 \left#5 #1 \right#6}
#+LATEX_HEADER:	}{
#+LATEX_HEADER:	\ifthenelse{\isempty{#1}}{#7{#3}#4_{#2}}{#7{#3}#4_{#1}\left#5 #2 \right#6}
#+LATEX_HEADER: }
#+LATEX_HEADER: }
#+LATEX_HEADER: \newcommand\defUOperator[5]{%
#+LATEX_HEADER: \ifthenelse{\isempty{#1}}{
#+LATEX_HEADER:		#5\left#3 #2 \right#4
#+LATEX_HEADER: }{
#+LATEX_HEADER:	\ifthenelse{\isempty{#2}}{\underset{#1}{\operatornamewithlimits{#5}}}{
#+LATEX_HEADER:		\underset{#1}{\operatornamewithlimits{#5}}\left#3 #2 \right#4}
#+LATEX_HEADER: }
#+LATEX_HEADER: }
#+LATEX_HEADER: \newcommand{\defBoldVar}[2]{	
#+LATEX_HEADER:	\ifthenelse{\equal{#2}{T}}{\boldsymbol{#1}}{\mathbf{#1}}
#+LATEX_HEADER: }
*** Shortcuts
**** Probability
#+LATEX_HEADER: \newcommandx\Cov[2][1=,2=]{\defOperator{#1}{#2}{C}{ov}{\lbrack}{\rbrack}{\mathbb}}
#+LATEX_HEADER: \newcommandx\Esp[2][1=,2=]{\defOperator{#1}{#2}{E}{}{\lbrack}{\rbrack}{\mathbb}}
#+LATEX_HEADER: \newcommandx\Prob[2][1=,2=]{\defOperator{#1}{#2}{P}{}{\lbrack}{\rbrack}{\mathbb}}
#+LATEX_HEADER: \newcommandx\Qrob[2][1=,2=]{\defOperator{#1}{#2}{Q}{}{\lbrack}{\rbrack}{\mathbb}}
#+LATEX_HEADER: \newcommandx\Var[2][1=,2=]{\defOperator{#1}{#2}{V}{ar}{\lbrack}{\rbrack}{\mathbb}}
#+LATEX_HEADER: \newcommandx\Binom[2][1=,2=]{\defOperator{#1}{#2}{B}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Gaus[2][1=,2=]{\defOperator{#1}{#2}{N}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Wishart[2][1=,2=]{\defOperator{#1}{#2}{W}{ishart}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Likelihood[2][1=,2=]{\defOperator{#1}{#2}{L}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Information[2][1=,2=]{\defOperator{#1}{#2}{I}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Score[2][1=,2=]{\defOperator{#1}{#2}{S}{}{(}{)}{\mathcal}}
**** Operators
#+LATEX_HEADER: \newcommandx\Vois[2][1=,2=]{\defOperator{#1}{#2}{V}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\IF[2][1=,2=]{\defOperator{#1}{#2}{IF}{}{(}{)}{\mathcal}}
#+LATEX_HEADER: \newcommandx\Ind[1][1=]{\defOperator{}{#1}{1}{}{(}{)}{\mathds}}
#+LATEX_HEADER: \newcommandx\Max[2][1=,2=]{\defUOperator{#1}{#2}{(}{)}{min}}
#+LATEX_HEADER: \newcommandx\Min[2][1=,2=]{\defUOperator{#1}{#2}{(}{)}{max}}
#+LATEX_HEADER: \newcommandx\argMax[2][1=,2=]{\defUOperator{#1}{#2}{(}{)}{argmax}}
#+LATEX_HEADER: \newcommandx\argMin[2][1=,2=]{\defUOperator{#1}{#2}{(}{)}{argmin}}
#+LATEX_HEADER: \newcommandx\cvD[2][1=D,2=n \rightarrow \infty]{\xrightarrow[#2]{#1}}
#+LATEX_HEADER: \newcommandx\Hypothesis[2][1=,2=]{
#+LATEX_HEADER:         \ifthenelse{\isempty{#1}}{
#+LATEX_HEADER:         \mathcal{H}
#+LATEX_HEADER:         }{
#+LATEX_HEADER: 	\ifthenelse{\isempty{#2}}{
#+LATEX_HEADER: 		\mathcal{H}_{#1}
#+LATEX_HEADER: 	}{
#+LATEX_HEADER: 	\mathcal{H}^{(#2)}_{#1}
#+LATEX_HEADER:         }
#+LATEX_HEADER:         }
#+LATEX_HEADER: }
#+LATEX_HEADER: \newcommandx\dpartial[4][1=,2=,3=,4=\partial]{
#+LATEX_HEADER: 	\ifthenelse{\isempty{#3}}{
#+LATEX_HEADER: 		\frac{#4 #1}{#4 #2}
#+LATEX_HEADER: 	}{
#+LATEX_HEADER: 	\left.\frac{#4 #1}{#4 #2}\right\rvert_{#3}
#+LATEX_HEADER: }
#+LATEX_HEADER: }
#+LATEX_HEADER: \newcommandx\dTpartial[3][1=,2=,3=]{\dpartial[#1][#2][#3][d]}
#+LATEX_HEADER: \newcommandx\ddpartial[3][1=,2=,3=]{
#+LATEX_HEADER: 	\ifthenelse{\isempty{#3}}{
#+LATEX_HEADER: 		\frac{\partial^{2} #1}{\partial #2^2}
#+LATEX_HEADER: 	}{
#+LATEX_HEADER: 	\frac{\partial^2 #1}{\partial #2\partial #3}
#+LATEX_HEADER: }
#+LATEX_HEADER: } 
**** General math
#+LATEX_HEADER: \newcommand\Real{\mathbb{R}}
#+LATEX_HEADER: \newcommand\Rational{\mathbb{Q}}
#+LATEX_HEADER: \newcommand\Natural{\mathbb{N}}
#+LATEX_HEADER: \newcommand\trans[1]{{#1}^\intercal}%\newcommand\trans[1]{{\vphantom{#1}}^\top{#1}}
#+LATEX_HEADER: \newcommand{\independent}{\mathrel{\text{\scalebox{1.5}{$\perp\mkern-10mu\perp$}}}}
#+LaTeX_HEADER: \newcommand\half{\frac{1}{2}}
#+LaTeX_HEADER: \newcommand\normMax[1]{\left|\left|#1\right|\right|_{max}}
#+LaTeX_HEADER: \newcommand\normTwo[1]{\left|\left|#1\right|\right|_{2}}
