---
title: "Cumulative Incidence Regression"
author: Klaus Holst & Thomas Scheike
date: "`r Sys.Date()`"
output:
  rmarkdown::html_vignette:
    fig_caption: yes
    fig_width: 7.15
    fig_height: 5.5    
vignette: >
  %\VignetteIndexEntry{Cumulative Incidence Regression}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(mets)
```

The cifreg function can fit the Fine-Gray model and the logit-link cumulative incidence function for the 
cause of interest for competing risks, and is completely scalable, that is, linear in the data. This includes
computation of standard errors that is also linear in data. In addition for the Fine-Gray model 
predictions can be provided standard errors for specific time-points based on influence functions 
for the baseline and the regression coeficients.  

To summarize

  - the baseline can be stratified 
  - the censoring weights can be strata dependent
  - predictions can be computed with standard errors (only for Fine-Gray)
  - computation time linear in data
     - including standard errors
  - only Fine-Gray: influence functions of baseline and regression coefficients computed and given by IC, iid and iidBaseline functions
  - clusters can be given and then cluster corrected standard errors are computed




Fine-Gray model
================

\cite{fine:gray:1999} considered a cumulative incidence on the form 
\begin{align*}
 F_1(t,X) & = P(T \leq t, \epsilon=1) = 1 - exp( - \Lambda_0(t) \exp(X^T \beta)).
\end{align*}

In the case of independent right-censoring with the censoring distribtion $G_c(t,X) = P(C > t | S(X))$ where
$S(X)$  is a set of strata defined from $X$, then an ubiased estimating equation is given by 
\begin{align*}
  U^{FG}_{n}(\beta) = \sum_{i=0}^{n} \int_0^{+\infty} \left( X_i- E_n(t,\beta) \right) w_i(t,X_i) dN_{1,i}(t)  \text{ where } 
	E_n(t,\beta)=\frac{\tilde S_1(t,\beta) }{\tilde S_0(t,\beta)},
\end{align*}
with \(w_i(t,X_i) = \frac{G_c(t,X_i)}{G_c(T_i \wedge t,X_i)} I( C_i > T_i \wedge t ) \) 
,$\tilde S_k(t,\beta) = \sum_{j=1}^n X_j^k \exp(X_j^T\beta) Y_{1,j}(t)$
for $k=0,1$, and with with $\tilde Y_{1,i}(t) = Y_{1,i}(t) w_i(t,X_i)$ for $i=1,...,n$.
$w_i(t)$ needs to be replaced by an estimator of the 
censoring distribution, and since it does not depend on $X$ the 
$\hat w_i(t) = \frac{\hat G_c(t,X_i)}{\hat G_c(T_i \wedge t,X_i)} I(C_i > T_i \wedge t)$ 
where $\hat G_c$ is the Kaplan-Meier estimator of the censoring distribution. 

First we simulate some competing risks data using some utility functions.

We simulate data with two causes based on the Fine-Gray model:
\begin{align}
F_1(t,X) &  = P(T\leq t, \epsilon=1|X)=( 1 - exp(-\Lambda_1(t) \exp(X^T \beta_1))) \\
F_2(t,X) & = P(T\leq t, \epsilon=2|X)= ( 1 - exp(-\Lambda_2(t) \exp(X^T \beta_2))) \cdot (1 - F_1(\infty,X))  
\end{align}
where the baselines are given as $\Lambda_j(t) = \rho_j (1- exp(-t/\nu_j))$ for $j=1,2$, and the 
$X$ being two independent binomials. 
Alternatively, one can also replace the FG-model with a logistic link 
$\mbox{expit}( \Lambda_j(t) + \exp(X^T \beta_j))$.

The advantage of the model is that it is easy to fit and to get standard errors, and that it is
quite flexible essentially being a Cox-model. On the downside 
is that the coefficients must be interpreted on $cloglog$-scale. 
Specifically, 
\begin{align}
\log(-\log( 1-F_1(t,X_1+1,X_2))) - \log(-\log( 1-F_1(t,X_1,X_2))) & =  \beta_1,
\end{align}
so the effect of an increase in $X_1$ is $\beta_1$ and leads to $1-F_1(t,X)$ on the $cloglog$ scale. 


```{r}
 library(mets)
 options(warn=-1)
 set.seed(1000) # to control output in simulatins for p-values below.

 rho1 <- 0.2; rho2 <- 10
 n <- 400
 beta=c(0.0,-0.1,-0.5,0.3)
 ## beta1=c(0.0,-0.1); beta2=c(-0.5,0.3)
 dats <- simul.cifs(n,rho1,rho2,beta,rc=0.5,rate=7)
 dtable(dats,~status)
 dsort(dats) <- ~time
```

We have a look at the non-parametric cumulative incidence curves

```{r}
 par(mfrow=c(1,2))
 cifs1 <- cif(Event(time,status)~strata(Z1,Z2),dats,cause=1)
 plot(cifs1)

 cifs2 <- cif(Event(time,status)~strata(Z1,Z2),dats,cause=2)
 plot(cifs2)
```

Now fitting the Fine-Gray model 

```{r}
 fg <- cifregFG(Event(time,status)~Z1+Z2,data=dats,cause=1)
 summary(fg)

 dd <- expand.grid(Z1=c(-1,1),Z2=0:1)
 pfg <- predict(fg,dd)
 plot(pfg,ylim=c(0,0.2))
```

and GOF based on cumulative residuals (Li et al. 2015) 

```{r}
gofFG(Event(time,status)~Z1+Z2,data=dats,cause=1)
```

showing no problem with the proportionality of the model. 


SE's for the baseline and predictions of FG
===========================================

The standard errors reported for the FG-estimator are based on the i.i.d 
decompostion (influence functions) of the estimator that we give later. A similar decompostion
exist for the baseline and is needed when standard errors of predictions are computed. These
are a bit harder to compute for all time-points simultaneously, but they can be
obtained for specific timepoints jointly with the iid decomposition of the regression coefficients and
then used to get standard errors for predictions. 

We here plot the predictions with jittered confidence intervals for the predictions
at time point 5

```{r,pred-cif}
### predictions with CI based on iid decomposition of baseline and beta
fg <- cifregFG(Event(time,status)~Z1+Z2,data=dats,cause=1)
Biid <- iidBaseline(fg,time=5)
pfgse <- FGprediid(Biid,dd)
pfgse
plot(pfg,ylim=c(0,0.2))
for (i in 1:4) lines(c(5,5)+i/10,pfgse[i,3:4],col=i,lwd=2)
```

The iid decompostions are stored inside Biid, in addition we note that the 
iid decompostions for $\hat \beta - \beta_0$ are obtained by the command iid()

# Comparison 

We compare with the cmprsk function, that gives exactly the same, but without running it to avoid dependencies: 

```{r,cmprsk}
run <- 0
if (run==1) {
library(cmprsk)
mm <- model.matrix(~Z1+Z2,dats)[,-1]
cr <- with(dats,crr(time,status,mm))
cbind(cr$coef,diag(cr$var)^.5,fg$coef,fg$se.coef,cr$coef-fg$coef,diag(cr$var)^.5-fg$se.coef)
#          [,1]      [,2]       [,3]      [,4]          [,5]          [,6]
# Z1  0.6968603 0.3876029  0.6968603 0.3876029 -2.442491e-15 -2.553513e-15
# Z2 -0.8592892 0.6245258 -0.8592892 0.6245258 -2.997602e-15  1.776357e-15
}
```


When comparing with the results from the coxph based on setting up the data using
the finegray function, we get the same estimates but note that the standard errors
of the coxph is missing a term and therefore slightly different. When comparing to 
the estimates from coxph missing the additional censoring term we see that we 
get also the same standard errors

```{r,coxph}
if (run==1) {
 library(survival)
 dats$id <- 1:nrow(dats)
 dats$event <- factor(dats$status,0:2, labels=c("censor", "death", "other"))
 fgdats <- finegray(Surv(time,event)~.,data=dats)
 coxfg <- survival::coxph(Surv(fgstart, fgstop, fgstatus) ~ Z1+Z2 + cluster(id), weight=fgwt, data=fgdats)

 fg0 <- cifreg(Event(time,status)~Z1+Z2,data=dats,cause=1,propodds=NULL)
 cbind( coxfg$coef,fg0$coef, coxfg$coef-fg0$coef)
#          [,1]       [,2]          [,3]
# Z1  0.6968603  0.6968603 -1.110223e-16
# Z2 -0.8592892 -0.8592892 -1.110223e-15
 cbind(diag(coxfg$var)^.5,fg0$se.coef,diag(coxfg$var)^.5-fg0$se.coef)
#           [,1]      [,2]          [,3]
# [1,] 0.3889129 0.3876029  0.0013099915
# [2,] 0.6241225 0.6245258 -0.0004033148
 cbind(diag(coxfg$var)^.5,fg0$se1.coef,diag(coxfg$var)^.5-fg0$se1.coef)
#           [,1]      [,2]          [,3]
# [1,] 0.3889129 0.3889129 -2.331468e-15
# [2,] 0.6241225 0.6241225  2.553513e-15
}
```

We also remove all censorings from the data to compare the estimates with those 
based on coxph, and observe that the estimates as well as the standard errors agree 

```{r,no-cens}
datsnc <- dtransform(dats,status=2,status==0)
dtable(datsnc,~status)
datsnc$id <- 1:n
datsnc$entry <- 0
max <- max(dats$time)+1
## for cause 2 add risk interaval 
datsnc2 <- subset(datsnc,status==2)
datsnc2 <- transform(datsnc2,entry=time)
datsnc2 <- transform(datsnc2,time=max)
datsncf <- rbind(datsnc,datsnc2)
#
cifnc <- cifreg(Event(time,status)~Z1+Z2,data=datsnc,cause=1,propodds=NULL)
cc <- phreg(Surv(entry,time,status==1)~Z1+Z2+cluster(id),datsncf)
cbind(cc$coef-cifnc$coef, diag(cc$var)^.5-diag(cifnc$var)^.5)
#            [,1]          [,2]
# Z1 1.332268e-15 -4.440892e-16
# Z2 4.218847e-15  2.220446e-16
```

the cmprsk also gives the same 

```{r}
if (run==1) {
 library(cmprsk)
 mm <- model.matrix(~Z1+Z2,datsnc)[,-1]
 cr <- with(datsnc,crr(time,status,mm))
 cbind(cc$coef-cr$coef, diag(cr$var)^.5-diag(cc$var)^.5)
#             [,1]         [,2]
# Z1 -4.218847e-15 1.443290e-15
# Z2  7.549517e-15 1.110223e-16
}
```


# Strata dependent Censoring weights 

We can improve efficiency and avoid bias by allowing the censoring weights to depend on 
the covariates 

```{r}
 fgcm <- cifregFG(Event(time,status)~Z1+Z2,data=dats,cause=1,cens.model=~strata(Z1,Z2))
 summary(fgcm)
 summary(fg)
```

We note that the standard errors are slightly smaller for the more efficient estimator.

The influence functions of the FG-estimator is given by \cite{fine:gray:1999},  
\begin{align*}
\phi_i^{FG}  & = \int (X_i- e(t))  \tilde w_i(t) dM_{i1}(t,X_i)  + \int \frac{q(t)}{\pi(t)} dM_{ic}(t),  \\
             & = \phi_i^{FG,1}  + \phi_i^{FG,2},
\end{align*}
where the first term is what would be achieved for a known censoring distribution, and the second term is
due to the variability from the Kaplan-Meier estimator. 
Where $M_{ic}(t) = N_{ic}(t) - \int_0^t Y_i(s) d\Lambda_c (s)$
with $M_{ic}$ the standard censoring martingale. 

The function $q(t)$ that reflects that the censoring only 
affects the terms related to cause "2" jumps, can be written as (see Appendix B2)
\begin{align*} 
	q(t) & =   E( H(t,X) I(T  \leq t, \epsilon=2) I(C > T)/G_c(T)) = E( H(t,X) F_2(t,X) ), 
\end{align*}
with $H(t,X) =  \int_t^{\infty} (X- e(s))  G(s) d \Lambda_1(s,X)$ and since $\pi(t)=E(Y(t))=S(t) G_c(t)$.

In the case where the censoring weights are stratified (based on $X$)
we get the influence functions related to the censoring term with 
\begin{align*} 
	q(t,X) & =   E( H(t,X) I(T  \leq t, \epsilon=2) I(T < C)/G_c(T,X) | X) = H(t,X) F_2(t,X), 
\end{align*}
so that the influence function becomes 
\begin{align*}
\int (X-e(t)) w(t) dM_1(t,X) +  \int H(t,X) \frac{F_2(t,X)}{S(t,X)} \frac{1}{G_c(t,X)} dM_c(t,X).
\end{align*}
with $H(t,X) =  \int_t^{\infty} (X- e(s))  G(s,X) d \Lambda_1(s,X)$.


Augmenting the FG-estimator 
===========================

Rather than using a larger censoring model we can also compute the augmentation term directly and
then fit the FG-model based on this augmentation term and do a couple of iterations 

```{r}
  fgaugS <- FG_AugmentCifstrata(Event(time,status)~Z1+Z2+strata(Z1,Z2),data=dats,cause=1,E=fg$E)
  summary(fgaugS)

  fgaugS2 <- FG_AugmentCifstrata(Event(time,status)~Z1+Z2+strata(Z1,Z2),data=dats,cause=1,E=fgaugS$E)
  summary(fgaugS2)

  fgaugS3 <- FG_AugmentCifstrata(Event(time,status)~Z1+Z2+strata(Z1,Z2),data=dats,cause=1,E=fgaugS2$E)
  summary(fgaugS3)
```
Again we note slightly smaller standard errors when augmenting the estimator. 

The function \verb+FG_AugmentCifstrata+ 
compute the augmentation term for fixed $E(t)$ based on the current $\hat \beta$
\begin{align*}
 U_n^{A} = \sum_{i=1}^n \int_{0}^{+\infty}  \frac{F_2(t,X_i)}{S(t,X_i)G_c(t,X_i)}  
	H(t,X_i,E,G_c,\Lambda_1)  dM_{ci}(t)
\end{align*}
using working models based on stratification to get $F_1^s$ and $F_2^s$ where the strata are given by
$strata()$ in the call.  Then fits the FG model so solve the 
\begin{align*}
 U_n^{A}(\beta_p)  + U^{FG}_{n}(\beta) = 0. 
\end{align*}

Then we may iterate to get a solution to the augmented score equation
\begin{align*}
 U_n^{A}(\beta_\infty)  + U^{FG}_{n}(\beta_\infty) = 0.
\end{align*}

The censoring model here is one overall Kaplan-Meier. 

The influence funtion for the augmented estimator is 
\begin{align*}
\int (X-e(t)) w(t) dM_1(t,X) +  \int H(t,X) \frac{F_2(t,X)}{S(t,X)} \frac{1}{G_c(t)} dM_c.
\end{align*}
and standard errors are based on this formula. 

Logistic-link 
================

```{r}
 rho1 <- 0.2; rho2 <- 10
 n <- 400
 beta=c(0.0,-0.1,-0.5,0.3)
 dats <- simul.cifs(n,rho1,rho2,beta,rc=0.5,rate=7,type="logistic")
 dtable(dats,~status)
 dsort(dats) <- ~time
```

The model where 
\begin{align*}
 \mbox{logit}(F_1(t,X)) & =  \alpha(t) + X^T \beta
\end{align*}
that then leads to OR interpretation of the $F_1$, can also be fitted easily, however, the standard errors
are harder to compute and only approximative 
(assuming that the censoring weights are known) but this gives typically only a small error. 
In the ${{\bf timereg}}$-package the model can be 
fitted using different estimators that are more efficient using different weights but this is much slower.  

Fitting the model and getting OR's 

```{r}
 or <- cifreg(Event(time,status)~Z1+Z2,data=dats,cause=1)
 summary(or)
```


Administrative Censoring
===========================

In the case with administrative censoring we can simply provide the 
risk-set given by the administrative censoring times for the Fine-Gray 
or logistic link cumulative incidence regression models. 

```{r}
library(mets)
rho1 <- 0.3; rho2 <- 5.9
set.seed(100)
n <- 100
beta=c(0.3,-0.3,-0.5,0.3)
rc <- 0.9
###
dats <- mets:::simul.cifsRA(n,rho1,rho2,beta,bin=1,rc=rc,rate=c(3,7))
dats$status07 <- dats$status
dats$status07[dats$status %in% c(0,7)] <- 0
tt <- seq(0,6,by=0.1)
base1 <- rho1*(1-exp(-tt/3))

ccA  <-  cifregFG(Event(timeA,statusA)~Z1+Z2,dats,
		  adm.cens.time=dats$censorA,no.codes=7)
estimate(ccA)
```

The Fine-Gray model can similarly be estimated using the modified risk-set and the phreg function

```{r}
dats$entry <- 0
dats$id <- 1:n
datA <- dats
datA2 <- subset(datA,statusA==2)
datA2$entry <- datA2$timeA
datA2$timeA <- datA2$censorA
datA2$statusA <- 0
datA <- rbind(datA,datA2)
ddA <- phreg(Event(entry,timeA,statusA==1)~Z1+Z2+cluster(id),datA)
estimate(ddA)

## also checking the cumulative baseline 
###plotl(tt,base1) 
###plot(ccA,add=TRUE,col=3)
###plot(ddA,col=2,add=TRUE)
```



SessionInfo
============


```{r}
sessionInfo()
```


