mcsa.Rnw

<<echo=FALSE>>=
opts_chunk$set(comment=NA, tidy=FALSE, highlight=FALSE, echo=FALSE,
               fig.with=7, fig.height=5.5, fig.path="figures/",
               out.width="\\textwidth", out.height="!", device="pdf",
               cache=FALSE, background="#ffffff",
               warning=FALSE, error=FALSE, prompt=TRUE)
options(contrasts= c("contr.treatment", "contr.poly"),
        show.signif.stars = FALSE, continue=" ", width=60)
par(mar=c(4.1, 4.1, 1.1, 1.1))
library("survival", quietly=TRUE)

# Note: this data set is NOT available to others
load("mcsa_grant_data_20180613.rda")  # creates mcsa.new
mdata <- subset(mcsa.new,, c(ptnum, agevis, male, educ, apoepos, htn, pib.ratio,
                         thickness, tau.ratio, pzmemory))
@

\begin{frame}{Mayo Clinic Study of Aging}
  \begin{itemize}
    \item On autopsy, Alzheimer's patients have amyloid plaques and 
      neurofibrollary tangles in their brain tissue.
    \item The population is aging.
    \item Studies
      \begin{itemize}
        \item Alzhiemer's Disease Neuroimaging Initiative (ADNI)
        \item Religious Orders Study (ROS), Memory and Aging Project (MAP)
        \item Mayo Clinic Study of Aging (MCSA)
          \begin{itemize}
            \item Enroll a stratified population sample
            \item Equal number of males and females, larger cohorts at older 
              ages
            \item Follow all subjects at a regular intervals
            \item Replenish the cohort for drop-out and death.
          \end{itemize}
      \end{itemize}
  \end{itemize}
\end{frame}


\begin{frame}{Key Measurements}
  \begin{itemize}
    \item Clinical assessment
       \begin{itemize}
          \item Cognitive tests
          \item Care team
        \end{itemize}
       \pause
    \item MRI structural scan
    \item Amyloid PET
    \item FDG PET 
    \item Tau PET 
      \pause
    \item CSF tau and fractions
 \end{itemize}
\end{frame}

<<counts, echo=FALSE>>=
first <- which(!duplicated(mdata$ptnum))
enroll <- table(mdata$male[first])

itau <- tapply(!is.na(mdata$tau.ratio), mdata$ptnum, any)
ipib <- tapply(!is.na(mdata$pib.ratio), mdata$ptnum, any)
ithick <- tapply(!is.na(mdata$thickness), mdata$ptnum, any)
@ 

\begin{frame}{Enrollment}
  \begin{itemize}
    \item Ever enrolled \Sexpr{sum(enroll[1])} females, 
      \Sexpr{sum(enroll[2])} males
    \item Carrying capacity of 2500--2700
    \item Clinical visits every 15 months
    \item Imaged subset: \Sexpr{sum(itau | ithick | ipib)}
      \begin{itemize}
        \item Neurodegeneration: \Sexpr{sum(ithick)}
        \item Neurodegeneration and amyloid: \Sexpr{sum(ithick & ipib)}
        \item Neurodegeneration, amyloid, and tau: \Sexpr{sum(ipib & ithick & itau)}
      \end{itemize}
  \end{itemize}
\end{frame}

\begin{frame}
<<model1, echo=FALSE>>=
#layout(matrix(c(1,1,1,2,3,4), 3,2), width=c(3,1))
oldpar <- par(mar=c(2.1, 2.1, 2.1, 2.1))
sname = c("A/N-", "A-N+", "A+N-",  "A+N+", "Dementia","Death")
connect <- matrix(0, 6, 6, dimnames=list(sname, sname))
connect[1,2] <- connect[1,3] <- connect[2,4] <- connect[3,4] <- 1
connect[2,5] <- connect[4,5] <- 1
statefig(matrix(c(1, 2, 1, 2), nrow=1), connect, cex=1,
         alty=c(rep(1,6), rep(2,5)), acol=rep(1:2, c(6,5)))
par(oldpar)
@ 
\end{frame}

\begin{frame}
<<model1b, echo=FALSE>>= 
oldpar <- par(mar=c(2.1, 2.1, 2.1, 2.1))
connect[1:5, 6] <- 1
connect[2,6] <- .7
statefig(matrix(c(1, 2, 1,2), nrow=1), connect, cex=1,
         alty=c(rep(1,6), rep(2,5)), acol=rep(1:2, c(6,5)))
par(oldpar)
@ 
\end{frame}

\begin{frame}
<<model1c>>=
oldpar <- par(mar=c(2.1, 2.1, 2.1, 2.1))
s2 <- c("A0", "A1", paste0("N", 0:2), "T0", "T1")
c2 <- matrix(0, 7, 7, dimnames=list(s2, s2))
c2[1,2] <- c2[3,4] <- c2[4,5] <- c2[6,7]<- 1
statefig(matrix(c(2,3,2), ncol=1), c2, cex=1)
par(oldpar)
@ 
\end{frame}

\begin{frame}{States}
  \begin{itemize}
    \item A0/A1: none/mild vs moderate/severe amyloid burden
    \item T0/T1: none/mild vs moderate/severe tau burden
    \item N0/N1/N2: increasing neurodegeneration
    \item 13 states (boxes)
    \item 32 transitions (arrows)
  \end{itemize}
\end{frame}

\begin{frame}
  \begin{itemize}
    \item 5 covariates: intercept, age, sex, APOE positivity, hypertension
    \item 32 transitions
    \item 160 potential parameters
    \item plus HMM parameters
      \pause
    \item Don't get carried away!
  \end{itemize}
\end{frame}
 
\begin{frame}{Amyloid scan timing}
<<tauplot>>=
mpib <- subset(mdata, !is.na(pib.ratio))
indx <- match(mpib$ptnum, mpib$ptnum)
ptime <- mpib$agevis - mpib$agevis[indx]
pcount <- 1 + (1:nrow(mpib)) - (1:nrow(mpib))[indx]
plot(jitter(pcount), ptime, xlab="Amyloid scan number", 
     ylab="Time since first")
abline(-15/12, 15/12, col=2, lwd=2)
@ 
\end{frame}

\begin{frame}{Interval censoring}
  \begin{itemize}
    \item Standard survival
      \begin{itemize}
        \item $(t, s)$  time $t$ at which subject entered state $s$
        \item Kaplan-Meier, Cox model, parametric AFT, \ldots
        \item Multi-state is a simple extension
      \end{itemize}
    \item Panel data
      \begin{itemize}
        \item $(t, s)$ time $t$ at which the subject was measured, they
          were in state $s$ at that time
        \item Exact same box and arrow diagram
        \item Same parameters: $\lambda_{jk}(t)$, time in state, visits, ...
        \item Completely different software
        \item \code{msm} in R
      \end{itemize}
  \end{itemize}
\end{frame}

\begin{frame}{Key assumptions}
  \begin{itemize}
    \item Standard survival
      \begin{itemize}
        \item Delays are small enough that ``time till we saw it'' is a good
          surrogate for ``time until it happened''
        \item Non-informative censoring
      \end{itemize}
    \item Interval censored
      \begin{itemize}
        \item Hazard is constant over the intervals between visits\\
          (or a smooth model)
        \item Non-informative visits
      \end{itemize}
  \end{itemize}
\end{frame}

  
\begin{frame}
  \myfig{rate1}
\end{frame}

\begin{frame}
  \myfig{rate2}
\end{frame}

\begin{frame}
  \myfig{rate3}
\end{frame}

\begin{frame}
  \myfig{rate4}
\end{frame}

\begin{frame}{Results}
  \begin{itemize}
    \item Rates
      \begin{itemize}
        \item What is the pattern of rates?
          \begin{itemize}
            \item The T0$\rightarrow$T1 rate is higher in the presence of
              A1, but not vice versa.  (Amyloid deposits promote tau.)
            \item A1/T1 promotes changes in N
          \end{itemize}
        \item The role of covariates.
          \begin{itemize}
            \item A positive APOE genotype affects A0/A1 transitions, but
              not others.
            \item Other covariates affect N but not A or T
          \end{itemize}
      \end{itemize}
    \item Outcomes
      \begin{itemize}
        \item What is the probability of ever visiting the N2 state? 
          \item What is the average duration of time spent in N2?
          \item What is the predicted fraction who go down each path?
        \item What is the impact of a change in one rate?
      \end{itemize}
  \end{itemize}
\end{frame}

\begin{frame}{Hidden Markov Model}
  \begin{itemize}
    \item  The data consists of time, outcomes and covariates
      \begin{itemize}
        \item The state is not observed directly, rather we see one or
          more outcomes that depend on the underlying state.
        \item No need for (time1, time2, endpoint) notation
        \item Data will have missing values, e.g., covariates on the day
          of death
      \end{itemize}
    \item Same box and arrow model for the states, covariates connect to
      $\lambda$ as before
    \item Another set of parameters for the arrows that connect state to outcome
    \item Allows for more episodic data.
    \item Much of the software is special purpose.
  \end{itemize}
\end{frame}

\begin{frame}
<<model1cc>>=
oldpar <- par(mar=c(2.1, 2.1, 2.1, 2.1))
s2 <- c("A0", "A1", paste0("N", 0:2), "T0", "T1")
c2 <- matrix(0, 7, 7, dimnames=list(s2, s2))
c2[1,2] <- c2[3,4] <- c2[4,5] <- c2[6,7]<- 1
statefig(matrix(c(2,3,2), ncol=1), c2, cex=1)
par(oldpar)
@ 
\end{frame}
 
\begin{frame}
  \begin{itemize}
    \item log(measured amyloid binding) $ \sim N(A^-/A^+, \sigma)$
    \item global memory score $\sim N(\mu, \tau)$ \\
      $\mu = \beta_0 + \beta_1N + \beta_2\mbox{sex} + \beta_3\mbox{education}$
    \item $A^-:A^+$ rate depends on APOE status, but on gender
    \item $N$ transition rates depend on $A$ but not vice-versa
  \end{itemize}
\end{frame}

\begin{frame}
  \myfig{response4b-1}
\end{frame}

\begin{frame}
  \myfig{response4b-2}
\end{frame}

\begin{frame}
  \myfig{response4b-4}
\end{frame}

\begin{frame}{HMM}
  \begin{itemize}
    \item Very powerful concept
    \item Downsides
      \begin{itemize}
        \item Easy to get carried away
        \item Computation is \emph{much} harder than a Cox model
          \begin{itemize}
            \item good starting estimates
            \item compute cluster
            \item patience
          \end{itemize}
        \item Few model checking methods
        \item Long manual
      \end{itemize}
  \end{itemize}
\end{frame}

\begin{frame}{Conclusions}
  \begin{itemize}
    \item Multi-state data ranges from the simple to the complex
    \item Good tools are available
    \item You need more than just a hazard ratio
    \item There is wide opportunity for new methods and software
  \end{itemize}
\end{frame}