Preprint published on medRxiv. doi:10.64898/2026.03.26.26349230

Plasma markers of phosphorylated tau-217 (such as %p-tau217) have rapidly emerged as robust markers of underlying Alzheimer’s Disease (AD) pathology.¹ Building on this excitement, recent work has focused on longitudinal measurements of plasma p-tau217, with this work suggesting significant change over time in at risk groups,² although with milder associations with concurrent cognitive changes.³

The article by Petersen et al.⁴ expands in this direction by applying disease clock models (Sampled Iterative Local Approximation [SILA]⁵ and Temporal Integration of Rate Accumulation [TIRA]⁶) to derive estimates of the age at plasma %p-tau217 positivity, based on estimation of group-level accumulation combined with individual level %p-tau217 magnitude. This measure of age at %p-tau217 positivity, defined as baseline age minus the estimated time from %p-tau217 positivity is then used to claim prediction of the age at onset of symptomatic (AD). We show that this apparent predictive performance is largely artifactual, arising from two structural features of the analysis: (1) restriction to individuals who progressed to symptomatic AD during limited follow-up, which induces a strong artifactual association between baseline age and age at symptom onset, and (2) the use of constructed predictors and outcomes that share age and timing components, making the resulting associations partly self-referential. More generally, this artifact arises when the outcome is constrained by an earlier time variable and the predictor contains that same or a related time component, inducing associations through shared structure rather than independent signal. Using digitized data from the published figures, we decomposed the clock-derived measure into baseline age and estimated time from plasma %p-tau217 positivity, quantified shared and unique explained variance using commonality analysis, and evaluated a null scenario by replacing the biomarker component of the clock measure with a randomly generated time from %p-tau217 positivity, drawn over the observed range. This randomization preserves the range of the predictor while removing any biomarker information, allowing the contribution of structural relationships to be assessed directly. In ADNI, baseline age alone explained substantially more variance in age at symptom onset than the reported plasma %p-tau217 clock-derived predictors ( versus and for TIRA and SILA), the estimated time from %p-tau217 component contributed little additional information, and randomly generated values produced a similar associations to baseline age alone (). These results indicate that the reported predictive performance of the plasma %p-tau217 clock is driven largely by structural age relationships rather than independent biomarker information.

The primary analysis links estimated age at %p-tau217 positivity to observed age at symptom onset in known progressors and forms a central results of the paper. However, this analysis evaluates when progression occurs in individuals who progress within a limited follow-up window—a substantially less clinically relevant problem than predicting onset in an all-comers population, which represents a key goal in the field. In the restricted sample, baseline age must precede age at symptom onset, and the interval between them is bounded by the observation period of the study. As a result, baseline age alone strongly predicts age at symptom onset, even in the absence of biomarker information.

This structure carries directly into the clock-based analysis, where age at symptom onset is regressed on estimated age at %p-tau217 positivity. Because the plasma %p-tau217 clock combines baseline age with an estimated timing component, and the outcome is itself constrained by baseline age, the resulting association reflects a mixture of structural age relationships and any true biomarker signal. To separate these components, the clock can be decomposed into baseline age and estimated time from %p-tau217 positivity, and age at symptom onset modeled as a function of both terms, allowing the independent contribution of the biomarker timing component to be assessed.

In their Alzforum response to this critique,⁷ the authors confirmed that in ADNI, baseline age alone predicts age at symptom onset with an of approximately 0.78 (Figure 1, left panels). The pink regions in Figure 1 depict the structural dependence that arises given that observed symptom onset occurs at most 10.4 years after baseline. In contrast to baseline age, the estimated age of %p-tau217 positivity achieves substantially lower values (0.337 and 0.470 for TIRA and SILA, respectively; Figure 4 in Petersen et al.⁴ and Figure 1, right panels). Thus, incorporating the biomarker-derived estimate of time from %p-tau217 positivity does not improve explained variance relative to baseline age alone and, in fact, reduces it. Consistent with this, the estimated time from %p-tau217 positivity shows little association with age at symptom onset, and adding it to baseline age does not improve model fit (Figure 1). Patterns obtained using a randomly generated time from %p-tau217 positivity, drawn uniformly over the observed range, are qualitatively similar to those obtained using the SILA and TIRA estimates (Figure 1, bottom).

To further quantify these relationships, Table 1 presents a commonality analysis⁹ partitioning the unique and shared variance between baseline age and the estimated age of %p-tau217 positivity (via SILA, TIRA, or the random comparator) as predictors of age at symptom onset. While a substantial proportion of explained variance is shared between predictors (50% for SILA; 42% for TIRA; 36% for random), the unique contributions differ markedly. Baseline age independently accounts for a large proportion of the variance (44% for SILA; 56% for TIRA; 64% for random), whereas the estimated age of %p-tau217 positivity contributes minimally (6% for SILA; 3% for TIRA; 0.07% for random). These results indicate that nearly all explained variance is either shared with or uniquely attributable to baseline age, with little additional contribution, only 3% to 6%, from the biomarker-derived timing component.

The authors have also highlighted analyses that exclude age from the outcome. However, this does not remove the structural issue; rather, it shifts the source of the constraint from baseline age to age at %p-tau217 positivity. In Supplementary Figure 6, the analysis is framed as regressing time from %p-tau217 positivity to symptom onset on the estimated age at %p-tau217 positivity. The quantity that induces the artifact depends on how the outcome is defined. When the outcome is age at symptom onset, it is constrained by baseline age, and baseline age therefore induces the structural association, as shown above. If the outcome is instead the time from %p-tau217 positivity to symptom onset (i.e., duration of %p-tau217 positivity), then the constraint shifts to age at %p-tau217 positivity. Consider someone who becomes %p-tau217 positive at age 90: their duration of %p-tau217 positivity cannot be 15 years, since this would imply an age of 105, which is not observed in the data. Similarly, someone who becomes %p-tau217 positive at age 60 cannot have very short durations, since symptom onset must occur at the observed age range of the cohort. Thus, age at p-tau positivity tightly constrains the possible values of duration, and regressing duration on age at %p-tau217 positivity induces a strong negative association, with older ages at positivity associated with shorter durations, even in the absence of a true underlying relationship. This is the same structural mechanism described above, now operating through age at %p-tau217 positivity rather than baseline age.

In our analysis (Figure 2), when the estimated age of %p-tau217 positivity is replaced with age at baseline minus the randomly generated time from %p-tau217 positivity, the increases from 0.57 (TIRA) or 0.39 (SILA) to 0.68 (random). This shows that the magnitude of the association in Supplementary Fig. 6 can be reproduced using a predictor that contains no biomarker information, indicating that the observed relationship is driven by the structural dependence of the outcome on the predictor, rather than by the clock-estimated time to %p-tau217 positivity. This structural dependence is represented by the pink regions which show where the data must lie given that the observed ages of symptom onset occur between 69 to 94 years.

The survival analyses, and in particular the event time summaries shown in Petersen et al Figure 3b, reflect the same structural issue described above for the duration analysis in Supplementary Figure 6. These summaries are derived from the survival analysis and compare time from %p-tau217 positivity to symptom onset across groups defined by age at %p-tau217 positivity, making them a grouped version of the same duration outcome. Although the full survival analysis includes nonprogressors, the relationship between age at %p-tau217 positivity and time to symptom onset remains subject to the same structural constraints. Individuals who become %p-tau217 positive at older ages necessarily have less remaining observable time before symptom onset, censoring, and competing risks, including death. As a result, duration from %p-tau217 positivity to onset is inherently constrained by %p-tau217 age at positivity. Thus, just as in the duration regression, analyses that summarize time from %p-tau217 positivity to symptom onset as a function of age at %p-tau217 positivity embed this constraint, and shorter observed durations at older ages arise from these structural limits rather than from differences in disease progression.

Taken together, these analyses demonstrate that combining baseline age with estimated time from %p-tau217 positivity into a single predictor, and plugging it into second-stage analyses of progression within limited follow-up, induces structural dependencies in the data. The resulting associations reflect a mixture of shared age components from constructed variables, bounded follow-up, and structural constraints. Consistent with this, we find that the clock-derived formulation of time from %p-tau217 positivity contributes little independent information in these analyses. This limited contribution likely reflects, in part, the strong modeling assumption that individuals follow a common accumulation trajectory, such that time from %p-tau217 positivity can be inferred from a group-level mean trajectory given a single observation. Under this assumption, variation in individual trajectories is minimized, reducing the potential for the estimated timing component to provide additional predictive value. These structural features, including shared age components, bounded follow up, and constructed variables can produce strong and apparently meaningful relationships even in the absence of biomarker timing information, masking the underlying artifacts and giving the appearance of predictive performance that does not generalize beyond the constrained setting in which it is evaluated. Importantly, these structural issues are not unique to plasma p-tau217 clock models, but are also present in prior work applying similar frameworks to estimate age at amyloid positivity from amyloid PET and relating this quantity to age at symptom onset, as illustrated in Figure 3 in Schindler et al.,⁶ where the same combination of constructed predictors, shared age components, and restricted follow-up can induce analogous artifacts. Analyses using disease-time “clock” models with these structural features are becoming increasingly common, underscoring the importance of carefully evaluating their statistical properties.¹⁰

These methodological objections are not intended to dismiss the significance of plasma p-tau217 as a predictor. Indeed, we and others have found it to be a robust predictor of cognitive decline in cognitively unimpaired populations. These analyses have yielded more modest effect sizes, indicating that plasma p-tau217 is associated with subsequent cognitive decline, but with limited precision at the individual level, especially when incorporating plasma p-tau217 changes over time.³ In this same sample of cognitively unimpaired (median follow-up six years), a model incorporating baseline p-tau217, hippocampal atrophy, amyloid PET, APOE status, and demographics achieved a cross-validated area under the precision–recall curve (AUPRC) of approximately 70% for discriminating clinical decline from stability.¹¹

Notably, 77% of the 1,629 cognitively unimpaired individuals in this cohort remained cognitively stable throughout follow-up. While accuracy metrics can be inflated by focusing only on individuals who decline (a small minority) and ignoring the stable majority, such an approach does not reflect the clinical reality of population screening. Given the clear clinical potential of plasma measures of AD, and the availability of direct-to-consumer p-tau217 measurements, it is critical that scientific research evaluating these tools portrays an accurate representation of what these measurements can and cannot provide. Rather than assuming that all individuals are on a common declining trajectory, the latent class approach we employed explicitly estimates the probability that an individual will be a progressor.¹² It is clinically imperative to convey the degree of certainty regarding an individual’s trajectory before counseling them on their “clock” under an unsupported assumption of inevitable decline.

Constrained Longitudinal Data Analysis

Liang and Zeger (2000) describe a constrained longitudinal data analysis for comparing the time course of two randomized groups in which the model constains the two groups to share a common mean at baseline. Lu (2010) compared the power of this approach to a longitudinal analysis of covariance approach. We conduct a few simple simulation studies to interrogate the effect of the constraint on power to detect group differences. We do not simulate any missing data here.

library(longpower)
library(nlme)
library(mvtnorm)
library(parallel)
library(ggplot2)
library(contrast)
library(tidyr)
library(dplyr)

sigma_residual <- 1
sigma_random_intercept <- 1
sigma_random_slope <- 0
Time <- 0:1
Beta <- c('(Intercept)'=1, time=0.5, 'trt:time'=0.4)
Beta.null <- c('(Intercept)'=1, time=0.5, 'trt:time'=0)
n <- 200 # per group
N <- 2*n

cov.t <- function(t1, t2, sig2.i, sig2.s, cov.s.i){
        sig2.i + t1*t2*sig2.s + (t1+t2)*cov.s.i
}
m = length(Time)
R = outer(Time, Time, function(x,y){cov.t(x,y, sigma_random_intercept^2, sigma_random_slope^2, 0)})
R = R + diag(sigma_residual^2, m, m)

power.t.test(n=n, delta=Beta['trt:time'], sd=sqrt(2*sigma_random_intercept))

     Two-sample t test power calculation 

              n = 200
          delta = 0.4
             sd = 1.414214
      sig.level = 0.05
          power = 0.8055549
    alternative = two.sided

NOTE: n is number in *each* group

lmmpower(n=n, delta=Beta['trt:time'], t=Time, 
  sig2.e=sigma_residual^2, sig2.s=sigma_random_slope^2, 
  sig2.i=sigma_random_intercept, cov.s.i=0)

     Longitudinal linear model slope power calculation (Diggle et al 2002, page 29) 

              N = 400
              n = 200, 200
          delta = 0.4
         sigma2 = 1
      sig.level = 0.05
          power = 0.8074296
    alternative = two.sided

 NOTE: N is *total* sample size and n is sample size in *each* group 

 R:
     [,1] [,2]
[1,]    2    1
[2,]    1    2

diggle.linear.power(n=n, delta=Beta['trt:time'], t=Time, R=R)

     Longitudinal linear model slope power calculation (Diggle et al 2002, page 29) 

              N = 400
              n = 200, 200
          delta = 0.4
         sigma2 = 1
      sig.level = 0.05
          power = 0.8074296
    alternative = two.sided

 NOTE: N is *total* sample size and n is sample size in *each* group 

 R:
     [,1] [,2]
[1,]    2    1
[2,]    1    2

dd0 <- expand.grid(time = Time, id = 1:N)
dd0$trt <- ifelse(dd0$id <= N/2, 0, 1)
dd0 <- as.data.frame(model.matrix(~ id+trt*time, data = dd0))
dd0$Trt <- as.factor(dd0$trt)
dd0$Y0 <- as.matrix(dd0[, names(Beta)]) %*% Beta
dd0$Y0.null <- as.matrix(dd0[, names(Beta.null)]) %*% Beta.null
ggplot(dd0, aes(x=time, y=Y0, color=Trt)) + geom_line()

set.seed(20130318)
dd1 <- merge(dd0, data.frame(
  id = 1:N, 
  ran.intercept = rnorm(N, sd=sigma_random_intercept),
  ran.slope     = rnorm(N, sd=sigma_random_slope)
))
dd1$e <- rnorm(nrow(dd1), sd=sigma_residual)

dd1$Y <- with(dd1, Y0 + ran.intercept + ran.slope*time + e)
ggplot(dd1, aes(x=time, y=Y, color=Trt, group = id)) + geom_line()

# unconstrained:
fit.LDA <- lme(Y~trt*time, random=~1|id, data=dd1)
printCoefmat(summary(fit.LDA)$tTable)

                 Value  Std.Error         DF t-value   p-value    
(Intercept)   0.994529   0.101708 398.000000  9.7783 < 2.2e-16 ***
trt          -0.172352   0.143837 398.000000 -1.1982  0.231533    
time          0.481055   0.097516 398.000000  4.9331 1.191e-06 ***
trt:time      0.450842   0.137908 398.000000  3.2692  0.001173 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# constrained:
fit.cLDA <- lme(Y~time+time:trt, random=~1|id, data=dd1)
printCoefmat(summary(fit.cLDA)$tTable)

                 Value  Std.Error         DF t-value   p-value    
(Intercept)   0.908353   0.071944 399.000000 12.6259 < 2.2e-16 ***
time          0.520646   0.091756 398.000000  5.6742 2.686e-08 ***
time:trt      0.371660   0.121052 398.000000  3.0703  0.002285 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

newdat0 <- expand.grid(trt=0:1, time=Time)

mods <- list(LDA = fit.LDA, cLDA=fit.cLDA)

pd <- do.call(rbind, lapply(names(mods), function(name){
  cbind(newdat0, 
    Y=predict(mods[[name]], newdat0, level=0),
    model = name
  ) 
}))
pd$Trt <- as.factor(pd$trt)
ggplot(pd, aes(y=Y, x=time, color = Trt)) + geom_line() + facet_grid(.~model)

set.seed(20130318)
results <- do.call(rbind, mclapply(1:10000, function(x){
  dd1 <- merge(dd0, data.frame(
    id = 1:N,
    ran.intercept = rnorm(N, sd=sigma_random_intercept),
    ran.slope     = rnorm(N, sd=sigma_random_slope)
  ))
  dd1$e <- rnorm(nrow(dd1), sd=sigma_residual)
  dd1$Y <- with(dd1, Y0 + ran.intercept + ran.slope*time + e)
  dd1$Y.null <- with(dd1, Y0.null + ran.intercept + ran.slope*time + e)
  ddw <- merge(
    subset(dd1, time==0, c('id', 'trt', 'Y', 'Y.null')),
    subset(dd1, time==1, c('id', 'trt', 'Y', 'Y.null')),
    by=c('id', 'trt'), suffixes=c('.0','.1')
  )
  ddw$d <- with(ddw, Y.1-Y.0)
  ddw$d.null <- with(ddw, Y.null.1-Y.null.0)

  prepost <- list(
    ttest.power   = t.test(         d~trt, data=ddw)$p.value,
    ttest.alpha   = t.test(    d.null~trt, data=ddw)$p.value,
    ancova1.power = summary(lm(     d~Y.0 + trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
    ancova1.alpha = summary(lm(d.null~Y.null.0 + trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
    ancova2.power = summary(lm(     d~scale(Y.0)*trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
    ancova2.alpha = summary(lm(d.null~scale(Y.null.0)*trt, data=ddw))$coef['trt', 'Pr(>|t|)']
  )

  fits <- list(
    LDA.power  = lme(     Y~time*trt, random=~1|id, data=dd1),
    LDA.alpha  = lme(Y.null~time*trt, random=~1|id, data=dd1),
    cLDA.power = lme(     Y~time+time:trt, random=~1|id, data=dd1),
    cLDA.alpha = lme(Y.null~time+time:trt, random=~1|id, data=dd1)
  )

  c(unlist(prepost),
    slopes = unlist(lapply(fits, function(fit){
      summary(fit)$tTable['time:trt', 'p-value']
    })),
    contrasts = unlist(lapply(fits[1:2], function(fit){
      pv <- try(as.numeric(contrast(fit,
        a=list(time=Time[length(Time)], trt=0),
        b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
      if(class(pv) == 'try-error'){
        fit <- update(fit, random=~1|id)
        pv <- try(as.numeric(contrast(fit,
          a=list(time=Time[length(Time)], trt=0),
          b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
      }
      pv
    }))
  )
}, mc.cores = 10))

knitr::kable(cbind('Pr(p<0.05)'=apply(results, 2, function(x){
  sum(x < 0.05)/length(x)*100
})))

sigma_residual <- 1
sigma_random_intercept <- 1
sigma_random_slope <- 1
Time <- 0:3
Beta <- c('(Intercept)'=1, time=0.5, 'trt:time'=0.434)
Beta.null <- c('(Intercept)'=1, time=0.5, 'trt:time'=0)
n <- 100 # per group
N <- 2*n

m = length(Time)
R = outer(Time, Time, function(x,y){cov.t(x,y, sigma_random_intercept^2, sigma_random_slope^2, 0)})
R = R + diag(sigma_residual^2, m, m)

lmmpower(n=n, delta=Beta['trt:time'], t=Time, 
  sig2.e=sigma_residual^2, sig2.s=sigma_random_slope^2, 
  sig2.i=sigma_random_intercept^2, cov.s.i=0)

     Longitudinal linear model slope power calculation (Diggle et al 2002, page 29) 

              N = 200
              n = 100, 100
          delta = 0.434
         sigma2 = 1
      sig.level = 0.05
          power = 0.7999644
    alternative = two.sided

 NOTE: N is *total* sample size and n is sample size in *each* group 

 R:
     [,1] [,2] [,3] [,4]
[1,]    2    1    1    1
[2,]    1    3    3    4
[3,]    1    3    6    7
[4,]    1    4    7   11

diggle.linear.power(n=n, delta=Beta['trt:time'], t=Time, R=R)

     Longitudinal linear model slope power calculation (Diggle et al 2002, page 29) 

              N = 200
              n = 100, 100
          delta = 0.434
         sigma2 = 1
      sig.level = 0.05
          power = 0.7999644
    alternative = two.sided

 NOTE: N is *total* sample size and n is sample size in *each* group 

 R:
     [,1] [,2] [,3] [,4]
[1,]    2    1    1    1
[2,]    1    3    3    4
[3,]    1    3    6    7
[4,]    1    4    7   11

dd0 <- expand.grid(time = Time, id = 1:N)
dd0$trt <- ifelse(dd0$id <= N/2, 0, 1)
dd0$t <- as.factor(dd0$time)
dd0 <- as.data.frame(model.matrix(~ id+trt*time+t, data = dd0))
dd0$t <- as.factor(dd0$time)
dd0$Trt <- as.factor(dd0$trt)
dd0$Y0 <- as.matrix(dd0[, names(Beta)]) %*% Beta
dd0$Y0.null <- as.matrix(dd0[, names(Beta.null)]) %*% Beta.null

ggplot(dd0, aes(x=time, y=Y0, color=Trt)) + geom_line()

set.seed(20130318)
dd1 <- merge(dd0, data.frame(
  id = 1:N, 
  ran.intercept = rnorm(N, sd=sigma_random_intercept),
  ran.slope     = rnorm(N, sd=sigma_random_slope)
))
dd1$e <- rnorm(nrow(dd1), sd=sigma_residual)

dd1$Y <- with(dd1, Y0 + ran.intercept + ran.slope*time + e)
ggplot(dd1, aes(x=time, y=Y, color=Trt, group = id)) + geom_line()

# unconstrained:
fit.LDA <- lme(Y~trt*time, random=~time|id, data=dd1)
printCoefmat(summary(fit.LDA)$tTable)

                Value Std.Error        DF t-value   p-value    
(Intercept)   0.94916   0.13384 598.00000  7.0919 3.749e-12 ***
trt           0.14495   0.18928 198.00000  0.7658  0.444712    
time          0.31195   0.11256 598.00000  2.7714  0.005755 ** 
trt:time      0.48156   0.15918 598.00000  3.0251  0.002592 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# constrained:
fit.cLDA <- lme(Y~time+time:trt, random=~time|id, data=dd1)
printCoefmat(summary(fit.cLDA)$tTable)

                 Value  Std.Error         DF t-value   p-value    
(Intercept)   1.021636   0.094539 598.000000 10.8065 < 2.2e-16 ***
time          0.290433   0.108989 598.000000  2.6648 0.0079117 ** 
time:trt      0.524594   0.148934 598.000000  3.5223 0.0004604 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

newdat0 <- expand.grid(trt=0:1, time=Time)

mods <- list(LDA = fit.LDA, cLDA=fit.cLDA)

pd <- do.call(rbind, lapply(names(mods), function(name){
  cbind(newdat0, 
    Y=predict(mods[[name]], newdat0, level=0),
    model = name
  ) 
}))
pd$Trt <- as.factor(pd$trt)
ggplot(pd, aes(y=Y, x=time, color = Trt)) + geom_line() + facet_grid(.~model)

set.seed(20130318)
results <- do.call(rbind, mclapply(1:10000, function(x){
  dd1 <- merge(dd0, data.frame(
    id = 1:N,
    ran.intercept = rnorm(N, sd=sigma_random_intercept),
    ran.slope     = rnorm(N, sd=sigma_random_slope)
  ))
  dd1$e <- rnorm(nrow(dd1), sd=sigma_residual)
  dd1$Y <- with(dd1, Y0 + ran.intercept + ran.slope*time + e)
  dd1$Y.null <- with(dd1, Y0.null + ran.intercept + ran.slope*time + e)

  fits.cts <- list(
    LDA.power  = lme(     Y~time*trt, random=~time|id, data=dd1, control=lmeControl(returnObject=TRUE)),
    LDA.alpha  = lme(Y.null~time*trt, random=~time|id, data=dd1, control=lmeControl(returnObject=TRUE)),
    cLDA.power = lme(     Y~time+time:trt, random=~time|id, data=dd1, control=lmeControl(returnObject=TRUE)),
    cLDA.alpha = lme(Y.null~time+time:trt, random=~time|id, data=dd1, control=lmeControl(returnObject=TRUE))
  )

  fits.cat <- list(
    LDA.power  = gls(     Y~(t1+t2+t3)*trt, data=dd1,
      correlation = corCompSymm(form = ~ time | id), weights = varIdent(form = ~ 1 | time)),
    LDA.alpha  = gls(Y.null~(t1+t2+t3)*trt, data=dd1,
      correlation = corCompSymm(form = ~ time | id), weights = varIdent(form = ~ 1 | time)),
    cLDA.power = gls(     Y~t1+t2+t3+(t1+t2+t3):trt, data=dd1,
      correlation = corCompSymm(form = ~ time | id), weights = varIdent(form = ~ 1 | time)),
    cLDA.alpha = gls(Y.null~t1+t2+t3+(t1+t2+t3):trt, data=dd1,
      correlation = corCompSymm(form = ~ time | id), weights = varIdent(form = ~ 1 | time))
  )

  c(slopes = unlist(lapply(fits.cts, function(fit){
      summary(fit)$tTable['time:trt', 'p-value']
    })),
    contrasts.cts = unlist(lapply(fits.cts[1:2], function(fit){
      pv <- try(as.numeric(contrast(fit,
        a=list(time=Time[length(Time)], trt=0),
        b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
      if(class(pv) == 'try-error'){
        fit <- update(fit, random=~1|id)
        pv <- try(as.numeric(contrast(fit,
          a=list(time=Time[length(Time)], trt=0),
          b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
      }
      pv
    })),
    contrasts.cat = c(
      unlist(lapply(fits.cat[1:2], function(fit){
        pv <- try(as.numeric(contrast(fit,
          a=list(t1=0, t2=0, t3=1, trt=0),
          b=list(t1=0, t2=0, t3=1, trt=1))$Pvalue), silent = TRUE)
        pv
      })),
      unlist(lapply(fits.cat[3:4], function(fit){
        summary(fit)$tTable['t3:trt', 'p-value']
      }))
    )
  )
}, mc.cores = 10))

knitr::kable(cbind('Pr(p<0.05)'=apply(results, 2, function(x){
  sum(x < 0.05)/length(x)*100
})))

Time <- 0:1
Beta <- c('(Intercept)'=1, time=0.0514, 'trt:time'=0.0514*0.30)
Beta.null <- c('(Intercept)'=1, time=0.0514, 'trt:time'=0)
corr <- c(0.2, 0.5, 0.7)
n <- 64 # per group
N <- 2*n
sd_diff <- 0.0309

power.t.test(n=n, delta=Beta['trt:time'], sd=sd_diff)

     Two-sample t test power calculation 

              n = 64
          delta = 0.01542
             sd = 0.0309
      sig.level = 0.05
          power = 0.7999361
    alternative = two.sided

NOTE: n is number in *each* group

dd0 <- expand.grid(time = Time, id = 1:N)
dd0$trt <- ifelse(dd0$id <= N/2, 0, 1)
dd0 <- as.data.frame(model.matrix(~ id+trt*time, data = dd0))
dd0$Trt <- as.factor(dd0$trt)
dd0$Y0 <- as.matrix(dd0[, names(Beta)]) %*% Beta
dd0$Y0.null <- as.matrix(dd0[, names(Beta.null)]) %*% Beta.null

set.seed(20130318)
results <- do.call(rbind, mclapply(1:10000, function(x){
  ll <- lapply(corr, function(rho){
    sd_resid <- sqrt(sd_diff^2/(2*(1-rho)))
    cov_resid <- rho * sd_resid^2
    resids <- gather(
      data.frame(
        id = 1:N,
        rmvnorm(n=N, mean=c(0,0), sigma=matrix(c(sd_resid^2,cov_resid,cov_resid,sd_resid^2), nrow=2))), 
      time, e, 2:3) %>% 
      mutate(time = as.numeric(gsub('X', '', time))-1)
    dd1 <- merge(dd0, resids, by=c('id', 'time'))
    dd1$Y <- with(dd1, Y0 + e)
    dd1$Y.null <- with(dd1, Y0.null + e)
    ddw <- merge(
      subset(dd1, time==0, c('id', 'trt', 'Y', 'Y.null')),
      subset(dd1, time==1, c('id', 'trt', 'Y', 'Y.null')),
      by=c('id', 'trt'), suffixes=c('.0','.1')
    )
    ddw$d <- with(ddw, Y.1-Y.0)
    ddw$d.null <- with(ddw, Y.null.1-Y.null.0)

    prepost <- list(
      ttest.power   = t.test(         d~trt, data=ddw)$p.value,
      ttest.alpha   = t.test(    d.null~trt, data=ddw)$p.value,
      ancova1.power = summary(lm(     d~Y.0 + trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
      ancova1.alpha = summary(lm(d.null~Y.null.0 + trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
      ancova2.power = summary(lm(     d~scale(Y.0)*trt, data=ddw))$coef['trt', 'Pr(>|t|)'],
      ancova2.alpha = summary(lm(d.null~scale(Y.null.0)*trt, data=ddw))$coef['trt', 'Pr(>|t|)']
    )

    fits <- list(
      LDA.power  = lme(     Y~time*trt, random=~1|id, data=dd1, control=lmeControl(returnObject=TRUE)),
      LDA.alpha  = lme(Y.null~time*trt, random=~1|id, data=dd1, control=lmeControl(returnObject=TRUE)),
      cLDA.power = lme(     Y~time+time:trt, random=~1|id, data=dd1, control=lmeControl(returnObject=TRUE)),
      cLDA.alpha = lme(Y.null~time+time:trt, random=~1|id, data=dd1, control=lmeControl(returnObject=TRUE))
    )

    c(unlist(prepost),
      slopes = unlist(lapply(fits, function(fit){
        summary(fit)$tTable['time:trt', 'p-value']
      })),
      contrasts = unlist(lapply(fits[1:2], function(fit){
        pv <- try(as.numeric(contrast(fit,
          a=list(time=Time[length(Time)], trt=0),
          b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
        if(class(pv) == 'try-error'){
          fit <- update(fit, random=~1|id)
          pv <- try(as.numeric(contrast(fit,
            a=list(time=Time[length(Time)], trt=0),
            b=list(time=Time[length(Time)], trt=1))$Pvalue), silent = TRUE)
        }
        pv
      }))
    )
  })
  names(ll) <- corr
  unlist(ll)
}, mc.cores = 10))

knitr::kable(cbind('Pr(p<0.05)'=apply(results, 2, function(x){
  sum(x < 0.05)/length(x)*100
})))

Slides and poster from AAIC 2016, Toronto

Slides from PIA Day at AAIC 2016: Clinical Trials Advancement and Methods

Poster P3-034

Power for MMRM

We use the power calculation formula of Lu, Luo and Chen (2008) for Mixed Models of Repeated Measures, which accomodates general missing data patterns. This formula is implemented in the longpower package. We also verify the formula with a simple simulation.

library(longpower)
library(nlme)
library(mvtnorm)
library(parallel)
library(ggplot2)
library(contrast)

gls_sigma <- 2
gls_weights <- c(1, 1.5, 1.75, 2.0)
placebo_mean <- c(0, 0, 0, 0)
active_mean <- c(0, 1, 1.5, 1.8)
retention <- c(1, 0.9, 0.8, 0.7)
# compound symmetric R
R <- matrix(0.5, nrow = 4, ncol = 4)
diag(R) <- 1
N <- 200

power.mmrm(power=0.80, ra = retention, Ra=R, N=N, sigmaa = gls_sigma*gls_weights[4])

     Power for Mixed Model of Repeated Measures (Lu, Luo, & Chen, 2008) 

             n1 = 100
             n2 = 100
     retention1 = 1.0, 0.9, 0.8, 0.7
     retention2 = 1.0, 0.9, 0.8, 0.7
          delta = 1.798283
      sig.level = 0.05
          power = 0.8
    alternative = two.sided

power.t.test(power=0.80, n = N/2*retention[4], sd = gls_sigma*gls_weights[4])

     Two-sample t test power calculation 

              n = 70
          delta = 1.907529
             sd = 4
      sig.level = 0.05
          power = 0.8
    alternative = two.sided

NOTE: n is number in *each* group

dd0 <- expand.grid(time = as.factor(1:4), id = 1:N)
dd0$Time <- as.numeric(dd0$time)
dd0$trt <- ifelse(dd0$id <= N/2, 0, 1)
dd0 <- as.data.frame(model.matrix(~ -1+id+trt*time+Time, data = dd0))
dd0[,'trt:time1'] <- with(dd0, trt*time1)
dd0$Trt <- as.factor(dd0$trt)
dd0$time <- as.factor(dd0$Time)
dd0$Y0[dd0$trt==1] <- as.matrix(subset(dd0, trt==1, c('trt:time1', 'trt:time2', 
  'trt:time3', 'trt:time4'))) %*% active_mean
dd0$Y0[dd0$trt==0] <- as.matrix(subset(dd0, trt==0, c('time1', 'time2', 
  'time3', 'time4'))) %*% placebo_mean
ggplot(dd0, aes(x=Time, y=Y0, color=Trt)) + geom_line()

set.seed(20130318)
dd1 <- merge(dd0, data.frame(id = 1:N, drop = sample(1:5, N, replace=TRUE, p=c(0,0.1,0.1,0.1,0.7))))
dd1$e <- as.numeric(t(rmvnorm(n=N, mean=rep(0,4), sigma=gls_sigma^2*diag(gls_weights)%*%R%*%diag(gls_weights))))
dd1$Y <- with(dd1, Y0 + e)
dd1 <- subset(dd1, Time < drop)
ggplot(dd1, aes(x=Time, y=Y, color=Trt, group = id)) + geom_line()

fit0 <- gls(Y~-1+(time1+time2+time3+time4)+(time1+time2+time3+time4):trt, 
    correlation = corCompSymm(form = ~ Time | id),
        weights = varIdent(form = ~ 1 | Time),
        data=dd1)
summary(fit0)$tTable

               Value Std.Error    t-value      p-value
time1     -0.2498166 0.1857705 -1.3447591 0.1791507434
time2     -0.7536542 0.2990315 -2.5203167 0.0119523864
time3     -0.3253077 0.3665450 -0.8874973 0.3751245464
time4     -0.8114158 0.4966029 -1.6339329 0.1027351200
time1:trt  0.2980273 0.2627192  1.1343948 0.2570281147
time2:trt  1.5625956 0.4238492  3.6866786 0.0002452827
time3:trt  1.3327856 0.5136925  2.5945204 0.0096761153
time4:trt  2.7390980 0.6883514  3.9792145 0.0000765598

fit1 <- gls(Y~-1+time*Trt, 
  correlation = corCompSymm(form = ~ Time | id),
    weights = varIdent(form = ~ 1 | Time),
    data=dd1)

(ctrast <- contrast(fit1, 
  list(time=levels(dd1$time), Trt=levels(dd1$Trt)[2]),
  list(time=levels(dd1$time), Trt=levels(dd1$Trt)[1])))

gls model parameter contrast

  Contrast      S.E.      Lower     Upper    t  df Pr(>|t|)
 0.2980273 0.2627192 -0.2178097 0.8138642 1.13 681   0.2570
 1.5625955 0.4238486  0.7303884 2.3948026 3.69 681   0.0002
 1.3327868 0.5136947  0.3241710 2.3414026 2.59 681   0.0097
 2.7390986 0.6883513  1.3875528 4.0906444 3.98 681   0.0001

newdat <- rbind(
  with(contrast(fit1, list(time=levels(dd1$time), Trt=levels(dd1$Trt)[1])),
       data.frame(time = time, Trt = Trt, Estimate = Contrast, SE = SE,
                  Lower = Lower, Upper = Upper, 't-value' = testStat, 'p-value' = Pvalue)
       ),
  with(contrast(fit1, list(time=levels(dd1$time), Trt=levels(dd1$Trt)[2])),
       data.frame(time = time, Trt = Trt, Estimate = Contrast, SE = SE,
                  Lower = Lower, Upper = Upper, 't-value' = testStat, 'p-value' = Pvalue)
       )
  )
newdat$Time <- as.numeric(newdat$time)
ggplot(newdat, aes(y=Estimate, x=Time, color = Trt)) +
    geom_smooth(aes(ymax = Upper, ymin = Lower), stat = 'identity')

set.seed(20130318)  
results <- mclapply(1:10000, function(x){
    dd1 <- merge(dd0, data.frame(id = 1:N, drop = sample(1:5, N, replace=TRUE, p=c(0,0.1,0.1,0.1,0.7))))
    dd1$e <- as.numeric(t(rmvnorm(n=N, mean=rep(0,4), sigma=gls_sigma^2*diag(gls_weights)%*%R%*%diag(gls_weights))))
    dd1$Y <- with(dd1, Y0 + e)
    dd1 <- subset(dd1, Time < drop)
    try(summary(update(fit0, data = dd1))$tTable['time4:trt', 'p-value'], silent = TRUE)
}, mc.cores = 10)

cat(sum(results < 0.05)/length(results)*100)

79.99

The issue

The gls routine in the nlme package is sensitive to the data order when using corCompSymm, particularly when data is missing. This is alluded to in the corCompSymm documentation. Below are some examples.

library(nlme)
set.seed(20130506)
fm1Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont,
  correlation = corSymm(form = ~ 1 | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm1Orth.gls)$tTable

                           Value  Std.Error   t-value      p-value
(Intercept)           24.9371232 0.47286660 52.736063 7.204876e-77
SexFemale             -2.2717427 0.74083959 -3.066443 2.760865e-03
I(age - 11)            0.8268037 0.08221771 10.056272 5.037413e-17
SexFemale:I(age - 11) -0.3504390 0.12881040 -2.720580 7.640131e-03

fm2Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont[nrow(Orthodont):1, ], # reverse order
  correlation = corSymm(form = ~ 1 | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm2Orth.gls)$tTable # same as sorted

                           Value  Std.Error   t-value      p-value
(Intercept)           24.9371337 0.47286148 52.736658 7.196740e-77
SexFemale             -2.2717535 0.74083155 -3.066491 2.760460e-03
I(age - 11)            0.8268026 0.08221817 10.056203 5.039201e-17
SexFemale:I(age - 11) -0.3504379 0.12881111 -2.720557 7.640630e-03

fm3Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont[sample(1:nrow(Orthodont), replace = TRUE), ],
  correlation = corSymm(form = ~ 1 | Subject),
  weights = varIdent(form = ~ 1 | age) )

# Generate some missingness
Orthodont$missing <- sample(c(TRUE, FALSE), 
  size = nrow(Orthodont), prob = c(0.2, 0.8), 
  replace = TRUE)

fm4Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont, subset = !missing,
  correlation = corSymm(form = ~ 1 | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm4Orth.gls)$tTable

                           Value  Std.Error   t-value      p-value
(Intercept)           24.6507074 0.49253896 50.048239 1.936427e-66
SexFemale             -1.8766129 0.76806327 -2.443305 1.655051e-02
I(age - 11)            0.6845546 0.07834144  8.738091 1.420426e-13
SexFemale:I(age - 11) -0.1694028 0.11714233 -1.446128 1.516937e-01

fm5Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont[nrow(Orthodont):1, ], # reverse order
  subset = !missing,
  correlation = corSymm(form = ~ 1 | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm5Orth.gls)$tTable

                           Value Std.Error   t-value      p-value
(Intercept)           24.7529072 0.4946600 50.040246 1.962908e-66
SexFemale             -2.0630955 0.7715183 -2.674072 8.932466e-03
I(age - 11)            0.7260246 0.0785608  9.241563 1.305493e-14
SexFemale:I(age - 11) -0.2256612 0.1175943 -1.918981 5.822792e-02

Orthodont$t <- as.numeric(factor(Orthodont$age, levels = c(8, 10, 12, 14)))
with(Orthodont, table(t, age))

   age
t    8 10 12 14
  1 27  0  0  0
  2  0 27  0  0
  3  0  0 27  0
  4  0  0  0 27

fm6Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont, subset = !missing,
  correlation = corSymm(form = ~ t | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm6Orth.gls)$tTable

                           Value  Std.Error   t-value      p-value
(Intercept)           24.7022356 0.49498531 49.904987 2.470935e-66
SexFemale             -2.0520703 0.77463325 -2.649086 9.566568e-03
I(age - 11)            0.6883899 0.08674632  7.935667 6.270004e-12
SexFemale:I(age - 11) -0.1690610 0.12987781 -1.301693 1.964188e-01

fm7Orth.gls <- gls( distance ~ Sex * I(age - 11), 
  Orthodont[nrow(Orthodont):1, ], 
  subset = !missing,
  correlation = corSymm(form = ~ t | Subject),
  weights = varIdent(form = ~ 1 | age) )
summary(fm7Orth.gls)$tTable

                           Value  Std.Error   t-value      p-value
(Intercept)           24.7022356 0.49498315 49.905205 2.470016e-66
SexFemale             -2.0520687 0.77462980 -2.649096 9.566314e-03
I(age - 11)            0.6883909 0.08674715  7.935602 6.271927e-12
SexFemale:I(age - 11) -0.1690623 0.12987912 -1.301690 1.964198e-01

Estimating long-term progression from short-term data

Diseases that progress over long periods of time are often studied by observing cohorts at different stages of disease for shorter periods of time. We apply an Alternating Conditional Expectation (ACE) algorithm to estimate long-term multivariate monotone growth curves from short-term observations with unknown relative observation times. The iterative algorithm is demonstrated with the movies below.

Slides from AAIC 2012 are available here.

An R package to fit this model is available from https://bitbucket.org/mdonohue/grace