---
title: "Modeling the cumulative incidence function of clustered competing
        risks data: \\newline
        a multinomial GLMM approach"
subtitle: Semana Acadêmica de Estatística, UFPR
author: Henrique Laureano ([.github.io](https://henriquelaureano.github.io))
date: September 13, 2021
institute: IPPPP & LEG @ UFPR
classoption: [aspectratio=169]
bibliography: ../../THESIS/thesis/references.bib
link-citations: yes
output:
  beamer_presentation:
    includes:
      in_header: beamerheader.txt
---

### Giving context: defining where we are and what we did

\textbf{Object}

- Handle \textcolor{UniBlue}{clustered competing risks data} (a kind of
  failure time data)\
  through the \textcolor{UniBlue}{cumulative incidence function} (CIF).

\textbf{Goal}

- Perform \textcolor{UniBlue}{maximum likelihood estimation} in terms of
  a \textcolor{UniBlue}{full likelihood formulation}\
  based on @SCHEIKE's CIF specification (\textbf{Scheike's}).

\textbf{Contribution}

- The \textcolor{UniBlue}{full likelihood formulation} is in terms of a
  generalized linear mixed model (\textcolor{UniBlue}{GLMM}) - a
  conditional approach (with fixed and random/latent effects);
  
- The optimization and inference are tacked down via an
  \textcolor{UniBlue}{efficient model implementation} with the use of
  \textcolor{UniBlue}{\textit{state-of-art} computational libraries}
  (@TMB's \textcolor{UniBlue}{TMB}).

# Data

### Clustered competing risk data

Key ideas:
\begin{multicols}{2}
 \begin{enumerate}
  \item \textcolor{AlertOrange}{Clustered}:
        groups with a dependence structure (e.g. families);
  \item Causes \textcolor{AlertOrange}{competing} by \textit{something};
  \item Occurrence \textcolor{AlertOrange}{time} of this
        \textit{something}.
 \end{enumerate}
\end{multicols}

\vspace{-0.5cm}
Something?
\begin{columns}
 \column{5cm}
  \begin{itemize}
  \item \textbf{Failure} of an industrial or electronic component;
 \end{itemize}
 \column{6.25cm}
  \begin{itemize}
   \item \textbf{Occurrence} or \textbf{cure} of a disease or some
         biological process;
   \end{itemize}
 \column{4cm}
  \begin{itemize}
   \item \textbf{Progress} of a patient clinic state.
  \end{itemize}
\end{columns}

\vspace{0.15cm}
Independent of the application, always the same framework

\begin{tabular}{lc*{3}{>{\columncolor[gray]{0.8}}c}cr}
 Cluster & ID & Cause 1 & Cause 2 & Censorship & Time & Feature\\
 \hline
 1     & 1  & Yes     & No       & No        & 10   & A\\
 1     & 2  & No      & No       & Yes       &  8   & A\\
 2     & 1  & No      & No       & Yes       &  7   & B\\
 2     & 2  & No      & Yes      & No        &  5   & A\\
\end{tabular}

# Model

### Modeling clustered competing risks data

\bigskip
\begin{columns}
 \column{\linewidth/3}
  \centering
   \includegraphics[height=3.6cm]{logo/what.png}\\
   \bigskip
   \textcolor{UniBlue}{\textbf{What?}}
 \column{\linewidth/3}
  \centering
   \includegraphics[height=3.6cm]{logo/why.jpg}\\
   \bigskip
   \textcolor{UniBlue}{\textbf{Why?}}
 \column{\linewidth/3}
  \centering
   \includegraphics[height=3.6cm]{logo/roll_safe.png}\\
   \bigskip
   \textcolor{UniBlue}{\textbf{How?}}
\end{columns}

### Probability scale \(\rightarrow\) Cause-specific CIF

\vspace{0.2cm}
```{r cif, echo=FALSE,fig.height=3.25}
pacman::p_load(tidyverse, ## you need the pacman's package
               ggplot2,
               patchwork)
time  <- seq(30, 79.5, by=0.5)
delta <- 80
u     <- c(0, 0)
eta   <- c(0, 0)
beta  <- c(-2, -1.5)
gamma <- c(1.2, 1)
w     <- c(3, 5)
risk1 <- exp(beta[1] + u[1])
risk2 <- exp(beta[2] + u[2])
level <- 1 +  risk1 + risk2
risklevel1 <- risk1/level
risklevel2 <- risk2/level
traj1 <- pnorm(w[1] * atanh(2 * time/delta - 1) - gamma[1] - eta[1])
traj2 <- pnorm(w[2] * atanh(2 * time/delta - 1) - gamma[2] - eta[2])
cif1 <- risklevel1 * traj1
cif2 <- risklevel2 * traj2
cif3 <- 1 - cif1 - cif2
df <- as.data.frame(cbind(time, cif1, cif2))
df <- df%>%
    pivot_longer(cols=cif1:cif2, names_to="cif", values_to="value")
g1 <-
    ggplot(df, aes(time, value, group=cif, color=cif))+
    geom_line(size=1.5)+
    labs(x="Time", y="Incidence",
         title='Cumulative Incidence Function (CIF)')+
    scale_color_manual(values=c("#0096c8", "#262626"),
                       labels=c("Cause 1", "Cause 2"))+
    theme(legend.title=element_blank(),
          legend.text=element_text(size=14),
          ## legend.position=c(0.175, 0.85),
          ## legend.box.background=element_rect(color='black'),
          axis.text.x=element_text(size=13),
          axis.text.y=element_text(size=13),
          plot.title=element_text(
              size=16,
              face='bold', 
              margin=unit(c(t=0, r=0, b=3, l=0), 'mm')), 
          axis.title.x=element_text(
              size=14,
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")),
          axis.title.y=element_text(
              size=14,
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
df <- as.data.frame(cbind(time, cif1, cif2, cif3))
df <- df%>%
    pivot_longer(cols=cif1:cif3, names_to="cif", values_to="value")
df$cif <- factor(df$cif, levels=c('cif3', 'cif2', 'cif1'))
g2 <-
    ggplot(df, aes(time, value, fill=cif))+
    geom_area(alpha=1, size=1, colour='white')+
    scale_fill_manual(values=c('#ff4c00', '#262626', '#0096c8'),
                      labels=c('Censorship', 'Cause 2', 'Cause 1'))+
    labs(x='Time', y='Probability', title='All CIFs sum up to 1')+
    theme(legend.title=element_blank(),
          legend.text=element_text(size=14),
          ## legend.position=c(0.25, 0.75),
          ## legend.box.background=element_rect(color='black'),
          axis.text.x=element_text(size=13),
          axis.text.y=element_text(size=13),
          plot.title=element_text(
              size=16,
              face='bold',
              margin=unit(c(t=0, r=0, b=3, l=0), 'mm')), 
          axis.title.x=element_text(
              size=14, 
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")),
          axis.title.y=element_text(
              size=14, 
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
g1+g2
```

\begin{block}{}
\[
 \text{i.e.},\quad
 \text{CIF} =
 \mathbb{P}[~\text{failure time} \leq t,
            ~\text{a given cause} \mid \text{features \& latent effects}
            ~].
\]
\end{block}

Common applications: \textit{\textcolor{UniBlue}{family studies}}.
\newline
\hspace*{.5cm}\rotatebox[origin=c]{180}{$\color{UniBlue}{\Lsh}$}
Keywords:
*within-family/cluster dependence*;
*age at disease onset*;
*populations*.

### @SCHEIKE's CIF specification

For two competing causes of failure,\newline
the cause-specific CIFs are specified in the following manner
\begin{block}{}
\vspace{-0.5cm}
\begin{equation}
 F_{k} (t \mid \bm{x},~u_{1},~u_{2},~\eta_{k}) =
 \underbrace{\pi_{k}(\bm{x},~u_{1},~u_{2})}_{
 \substack{\text{cluster-specific}\\\text{risk level}}}\times
  \underbrace{\Phi[w_{k} g(t) - \bm{x}\bm{\gamma}_{k} - \eta_{k}]}_{
   \substack{\text{cluster-specific}\\\text{failure time trajectory}}
  }, \quad t > 0, \quad k = 1,~2,
  \label{eq:cif}
\end{equation}
\end{block}

with

1. \(\pi_{k}(\bm{x}, \bm{u}) =
     \exp\{\bm{x}\bm{\beta}_{k} + u_{k}\} \Big/
     \left(1 + \sum_{m=1}^{K-1} \exp\{\bm{x}\bm{\beta}_{m} + u_{m}\}
     \right),
     \quad k = 1,~2, \quad K = 3;\)

2. \(\Phi(\cdot)\) is the cumulative distribution function of a standard
   Gaussian distribution;

3. \(g(t) = \text{arctanh}(2t/\delta - 1),
     \quad t\in(0,~\delta), \quad g(t)\in(-\infty,~\infty).\)

\includegraphics[height=0.5cm]{logo/book.png}
In @SCHEIKE, this CIF specification is modeled under a pairwise
composite likelihood approach [@lindsay88; @varin11].

### Our contribution: a full likelihood analysis

\vspace{-0.3cm}
For two competing causes of failure, a subject \(i\), in the cluster
\(j\), in time \(t\), we have
\begin{block}{}
\vspace{-0.5cm}
\begin{equation}
 \begin{aligned}
  y_{ijt} \mid
  \underbrace{\{u_{1j}, u_{2j}, \eta_{1j}, \eta_{2j}\}}_{
  \substack{\text{\color{UniBlue}{latent effects}}}
  } & \sim
  \text{Multinomial}(p_{1ijt}, p_{2ijt}, p_{3ijt})\\
  \begin{bmatrix} u_{1}\\ u_{2}\\ \eta_{1}\\ \eta_{2} \end{bmatrix}
  & \sim
  \parbox{2cm}{\centering Multivariate Normal}
  \left(
   \begin{bmatrix} 0\\ 0\\ 0\\ 0 \end{bmatrix},
   \begin{bmatrix}
    \sigma_{u_{1}}^{2}&
    \text{cov}(u_{1}, u_{2})&
    \text{cov}(u_{1}, \eta_{1})&\text{cov}(u_{1}, \eta_{2})\\
    &\sigma_{u_{2}}^{2}&
    \text{cov}(u_{2}, \eta_{1})&\text{cov}(u_{2}, \eta_{2})\\
    &&\sigma_{\eta_{1}}^{2}&\text{cov}(\eta_{1}, \eta_{2})\\
    &&&\sigma_{\eta_{2}}^{2}
   \end{bmatrix}
  \right)\\  
  p_{ {\color{UniBlue}{k}} ijt} &=
  \frac{\partial}{\partial t}
  F_{\color{UniBlue}{k}}
  (t \mid \bm{x}, \bm{u}, \eta_{\color{UniBlue}{k}})\label{eq:model}\\
  &= \frac{\exp\{\bm{x}_{ {\color{UniBlue}{k}} ij}
                 \bm{\beta}_{\color{UniBlue}{k}} +
                 u_{ {\color{UniBlue}{k}} j}\}}{
  1 + \sum_{ {\color{UniBlue}{m}}=1}^{K-1}
      \exp\{\bm{x}_{ {\color{UniBlue}{m}} ij}
            \bm{\beta}_{\color{UniBlue}{m}} +
            u_{ {\color{UniBlue}{m}} j}\}}\\
  &\times w_{\color{UniBlue}{k}}\frac{\delta}{2\delta t - 2t^{2}}~
  \phi\left(
   w_{\color{UniBlue}{k}}
   \text{arctanh}\left(\frac{t-\delta/2}{\delta/2}\right)
   - \bm{x}_{ {\color{UniBlue}{k}} ij}
     \bm{\gamma}_{\color{UniBlue}{k}} -
     \eta_{ {\color{UniBlue}{k}} j}
  \right), \quad {\color{UniBlue}{k}} = 1,~2.
 \end{aligned}
\end{equation}
\end{block}

### Marginal likelihood function for two competing causes

\vspace{-0.75cm}
\begin{align}
 L(\bm{\theta}; y)
 &= \prod_{j=1}^{J}~\int_{\Re^{4}}
    \pi(y_{j} \mid \bm{r}_{j})\times\pi(\bm{r}_{j})~\text{d}\bm{r}_{j}
    \nonumber\\
 &= \prod_{j=1}^{J}~\int_{\Re^{4}}
    \Bigg\{
    \underbrace{\prod_{i=1}^{n_{j}}~\prod_{t=1}^{n_{ij}}
    \Bigg(
    \frac{(\sum_{k=1}^{K}y_{kijt})!}{y_{1ijt}!~y_{2ijt}!~y_{3ijt}!}~
    \prod_{k=1}^{K} p_{kijt}^{y_{kijt}}
    \Bigg)}_{\substack{\text{\color{UniBlue}{fixed effect component}}}}
  \Bigg\}\times\nonumber\\
 &\hspace{2cm}\underbrace{
   (2\pi)^{-2} |\Sigma|^{-1/2} \exp
   \left\{-\frac{1}{2}\bm{r}_{j}^{\top} \Sigma^{-1} \bm{r}_{j}\right\}
   }_{\substack{\text{\color{UniBlue}{latent effect component}}}}
   \text{d}\bm{r}_{j}\nonumber\\
 &= \prod_{j=1}^{J}~\int_{\Re^{4}}
    \Bigg\{
    \underbrace{\prod_{i=1}^{n_{j}}~\prod_{t=1}^{n_{ij}}
    \prod_{k=1}^{K} p_{kijt}^{y_{kijt}}
    }_{\substack{\color{UniBlue}{\text{fixed effect}}}}
   \Bigg\}\underbrace{
   (2\pi)^{-2} |\Sigma|^{-1/2} \exp
   \left\{-\frac{1}{2}\bm{r}_{j}^{\top} \Sigma^{-1} \bm{r}_{j}\right\}
   }_{\substack{\color{UniBlue}{\text{latent effect component}}}}
   \text{d}\bm{r}_{j}\label{eq:loglik},
\end{align}
with \(p_{kijt}\) from Equation \ref{eq:model} and where \(\bm{\theta} =
[\bm{\beta}~\bm{\gamma}~\bm{w}~\bm{\sigma^{2}}~ \bm{\rho}]^{\top}\) is
the parameters vector.

# TMB: Template Model Builder

### TMB: Template Model Builder

\includegraphics[height=0.5cm]{logo/book.png}
@TMB.

\bigskip
> An R [@R21] package for the quickly implementation of complex random
> effect models through simple C++ templates.

\bigskip
Key features:

1. Automatic differentiation;\newline
   \textit{The state-of-art in derivatives computation}

2. Laplace approximation.\newline
   \textit{An efficient fashion to approximate the latent effect
           integrals}


# Simulation study

### Simulation study results

First of all, the **time**.

+ In the most expensive scenarios (30K 4D Laplaces),\newline
  **the complete model takes 30 min**.\newline
  In a **full R** implementation with 10K 4D Laplaces, it **took
  30hrs**. \textcolor{UniBlue}{\textbf{TMB is fast}}.
 
+ We also did a Bayesian analysis via Stan/NUTS-HMC [@RStan].

  - **1 week of parallelized processing** for a 2500 size 2 clusters
    scenario with tuned NUTS. This just reinforces the MCMC
    impracticability for some complex models.

\bigskip
**Parameters estimation**.

+ The *non-complete* models fail to learn the data.\newline
  They appear to be *not structured enough* to capture the data
  characteristics.

### Simulation study results: High CIF scenario

\vspace{-0.3cm}
\includegraphics[height=8cm]{../../THESIS/thesis/figures/cifsaqua-1.png}

### Simulation study results: Low CIF scenario

\vspace{-0.3cm}
\includegraphics[height=8cm]{../../THESIS/thesis/figures/cifsaqua-2.png}

### Thanks for watching and have a great day

\includegraphics[height=0.5cm]{logo/book.png}
For more read @laurence master thesis.

\bigskip
Special thanks to

\bigskip
\begin{columns}
 \column{1.5cm}
  \centering\includegraphics{logo/ppgmne-logo.png}
 \column{13.75cm}
  {\large \textbf{PPGMNE}}\newline
  Programa de Pós-Graduação em\newline
  Métodos Numéricos em Engenharia
\end{columns}

\bigskip
\begin{columns}
 \column{2cm}
  \includegraphics[height=2cm]{logo/capes.jpg}
 \column{3cm}
  \includegraphics[height=2cm]{logo/ufpr.png}
 \column{4.5cm}
  Joint work with
  \vspace{0.2cm}\newline
  Wagner H. Bonat\newline
  \url{http://leg.ufpr.br/~wagner}
 \column{4.75cm}
  \textcolor{white}{Joint work with}
  \vspace{0.2cm}\newline
  Paulo Justiniano Ribeiro Jr.\newline
  \url{http://leg.ufpr.br/~paulojus}
\end{columns}

\vspace{0.75cm}
\begin{columns}
 \column{10cm}
 \column{5cm}
  \includegraphics[height=0.3cm,angle=90]{../../laurence.jpg}
  \hspace{0.05cm}
  \href{https://henriquelaureano.github.io}{henriquelaureano.github.io}
\end{columns}

# References

### References

\footnotesize
