The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

Example 2: Delayed treatment effect

Godwin Yung

2024-05-08

We provide here code to replicate Figures 3 and 4A from Example 2 of our manuscript. We rely on R packages tidyverse, plyr, and ggplot2 for cleaner coding and advanced visualizations.

library(npsurvSS)
library(dplyr)
library(tidyr)
library(tibble)
library(ggplot2)

Figure 3

Suppose 240 active and 120 control patients are enrolled over the course of 14 months and followed for 11 months. Assume that accrual follows a truncated exponential distribution with shape parameter 0.1; loss to follow-up follows a Weibull distribution with shape parameter 2 and scale parameter \(log(1/0.99)^{1/2}/25\), so that 1% of patients are permanently censored over 25 months of follow-up; and survivals follow exponential distributions with 9 and 6 month medians. All these information are captured in the following “arm” objects:

# Active
arm1 <- create_arm(size=240,
                   accr_time=14,
                   accr_dist="truncexp",
                   accr_param=0.1,
                   surv_scale=per2haz(9),
                   loss_scale=log(1/0.99)^(1/2)/25,
                   loss_shape=2,
                   total_time=25)

# Control
arm0 <- create_arm(size=120,
                   accr_time=14,
                   accr_dist="truncexp",
                   accr_param=0.1,
                   surv_scale=per2haz(6),
                   loss_scale=log(1/0.99)^(1/2)/25,
                   loss_shape=2,
                   total_time=25)

To visualize accrual and loss-to-follow-up:

# Accrual
tibble(
  x = seq(0, 14, 0.1),
  y = paccr(x, arm0)
) %>%
  ggplot(aes(x, y)) +
  geom_line() +
  labs(x = "Time from first patient in (months)",
       y = "Accrual CDF")

# Loss to follow-up
tibble(
  x = seq(0, 25, 0.1),
  y = ploss(x, arm0)
) %>%
  ggplot(aes(x, y)) +
  geom_line() +
  labs(x = "Time from study entry (months)",
       y = "Loss to follow-up CDF")

In the manuscript, we explore the impact on power when survival in the active arm follows instead a 2-piece exponential distribution, where the first piece overlaps with the control arm and the second piece deviates in such a way that median survival remains at 9 months. Denoting the changepoint by \(\tau_1\) and the arm-specific hazard rates by \(\lambda_0\) and \((\lambda_{11}, \lambda_{12})=(\lambda_0, \lambda_{12})\), simple algebra dictates that \(\lambda_{12}=\{\lambda: e^{-\lambda(9-\tau_1)}=\frac{0.5}{e^{-\lambda_0 \tau_1}}\}\). We can utilize functions in npsurvSS to calculate and visualize survival in the active arm under various changepoints:

# Calculate survival curves
x.vec     <- seq(0, 25, 0.1)  # vector of unique x-coordinates
tau1.vec  <- seq(0, 4.5, 1.5) # vector of unique changepoints
arm1t     <- arm1             # initialize active arm
y         <- c()              # vector or all y-coordinates
for (tau1 in tau1.vec) {
  # Update scale and interval parameters for the active arm
  arm1t$surv_scale    <- c(arm0$surv_scale[1], per2haz(9-tau1, 1-0.5/psurv(tau1, arm0, lower.tail=F)))
  arm1t$surv_interval <- c(0, tau1, Inf)
  
  # Calculate y-coordinates
  y <- c(y, psurv(x.vec, arm1t, lower.tail=F))
}

# Visualize survival curves
tibble(
  tau1 = rep(tau1.vec, each=length(x.vec)), 
  x = rep(x.vec, length(tau1.vec)),
  y = y
) %>%
  ggplot(aes(x, y)) +
  geom_line(aes(color=factor(tau1), lty=factor(tau1))) +
  labs(x = "Time from study entry (months)",
       y = "Survival function",
       color = "Changepoint",
       lty = "Changepoint")

Figure 4A

Finally, to calculate power for various non-parametric tests, we take advantage of power_two_arm’s ability to accomodate multiple tests at a time. For the sake of efficiency here, we will only consider changepoints 0, 0.5, 1, …, 5.5. In the manuscript, we consider changepoints 0, 0.1, 0.2, …, 5.9.

tau1.vec <- seq(0, 5.5, 0.5) # vector of changepoints
table_4a <- data.frame(matrix(0, nrow=length(tau1.vec), ncol=7)) # initialize results table
for (r in 1:length(tau1.vec)) {
  
  tau1 <- tau1.vec[r]
  
  # Update scale and interval parameters for the active arm
  arm1t$surv_scale    <- c(arm0$surv_scale[1], per2haz(9-tau1, 1-0.5/psurv(tau1, arm0, lower.tail=F)))
  arm1t$surv_interval <- c(0, tau1, Inf)
  
  # Calculate power and store results
  table_4a[r,] <- c(tau1,
                    power_two_arm(arm0, arm1t,
                                  test = list(list(test="weighted logrank"),
                                              list(test="weighted logrank", weight="n"),
                                              list(test="weighted logrank", weight="FH_p1_q1"),
                                              list(test="survival difference", milestone=11),
                                              list(test="rmst difference", milestone=11),
                                              list(test="percentile difference", percentile=0.5)))$power)
  
}

# Convert table to long format and re-label tests
table_4a <- gather(table_4a, "test", "power", 2:7) %>%
  mutate(test = recode(test, X2 = "wlogrank (1)",
                       X3 = "wlogrank (GB)",
                       X4 = "wlogrank (FH)",
                       X5 = "11-month surv diff",
                       X6 = "11-month rmst diff",
                       X7 = "median diff")) %>%
  as_tibble()
names(table_4a)[1] <- "tau1"

The resulting table looks like this:

table_4a
#> # A tibble: 72 × 3
#>     tau1 test         power
#>    <dbl> <chr>        <dbl>
#>  1   0   wlogrank (1) 0.915
#>  2   0.5 wlogrank (1) 0.912
#>  3   1   wlogrank (1) 0.912
#>  4   1.5 wlogrank (1) 0.913
#>  5   2   wlogrank (1) 0.917
#>  6   2.5 wlogrank (1) 0.924
#>  7   3   wlogrank (1) 0.934
#>  8   3.5 wlogrank (1) 0.946
#>  9   4   wlogrank (1) 0.959
#> 10   4.5 wlogrank (1) 0.974
#> # ℹ 62 more rows

It can be used to generate Figure 4A in the manuscript:

ggplot(table_4a, aes(x=tau1, y=power)) +
  geom_line(aes(color=test, lty=test)) +
  labs(x = "tau1",
       y = "Power",
       color = "Test",
       lty = "Test")

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.