```
library(survival)
library(rpact)
library(reporttools)
```

`Lade nötiges Paket: xtable`

```
# Quantile function for a Weibull distribution with a cure proportion
<- function(p, p0, shape = 1, scale){
qWeibullCure <- rep(NA, length(p))
res <- (p <= p0)
ind1 <- (p > p0)
ind2 <- Inf
res[ind1] <- qweibull(1 - (p[ind2] - p0) / (1 - p0), shape = shape, scale = scale)
res[ind2] return(res)
}
# censored time-to-event data with censoring after pre-specified number of events
<- function(shape = 1, scale, cure = 0, recruit, dropout = 0, start.accrual = 0, cutoff, seed = NA){
rWeibull1arm
# shape Weibull shape parameter.
# scale: Weibull scale parameter
# cure: Proportion of patients assumed to be cured, i.e. with an event at +infty.
# recruit: Recruitment.
# dropout: Drop-out rate, on same time scale as med.
# start.accrual: Time unit where accrual should start. Might be useful when simulating multi-stage trials.
# cutoff: Cutoff, #events the final censored data should have (can be a vector of multiple cutoffs).
# seed: If different from NA, seed used to generate random numbers.
#
# Kaspar Rufibach, June 2014
if (is.na(seed) == FALSE){set.seed(seed)}
<- sum(recruit)
n
# generate arrival times
<- rep(1:length(recruit), times = recruit)
arrive <- NULL
arrivetime for (i in 1:n){arrivetime[i] <- runif(1, min = arrive[i] - 1, max = arrive[i])}
<- start.accrual + sort(arrivetime)
arrivetime
# generate event times: Exp(lambda) = Weibull(shape = 1, scale = 1 / lambda)
<- qWeibullCure(runif(n), p0 = cure, shape = shape, scale = scale)
eventtime
# Apply drop-out. Do this before applying the cutoff below, in order to correctly count necessary #events.
<- rep(Inf, n)
dropouttime if (dropout > 0){dropouttime <- rexp(n, rate = dropout)}
<- ifelse(eventtime > dropouttime, 0, 1)
event.dropout <- ifelse(event.dropout == 1, eventtime, dropouttime)
time.dropout
# observed times, taking into account staggered entry
<- arrivetime + eventtime
tottime
# find cutoff based on number of targeted events
# only look among patients that are not considered dropped-out
<- data.frame(matrix(NA, ncol = length(cutoff), nrow = n))
time <- time
event <- rep(NA, length(cutoff))
cutoff.time
for (j in 1:length(cutoff)){
<- sort(tottime[event.dropout == 1])[cutoff[j]]
cutoff.time[j]
# apply administrative censoring at cutoff
== 1, j] <- ifelse(tottime[event.dropout == 1] > cutoff.time[j], 0, 1)
event[event.dropout == 0, j] <- 0
event[event.dropout
# define time to event, taking into account both types of censoring
== 1, j] <- ifelse(event[, j] == 1, eventtime, cutoff.time[j] - arrivetime)[event.dropout == 1] # same as: pmin(tottime, cutoff.time) - arrive
time[event.dropout == 0, j] <- pmin(cutoff.time[j] - arrivetime, time.dropout)[event.dropout == 0]
time[event.dropout
# remove times for patients arriving after the cutoff
<- (arrivetime > cutoff.time[j])
rem if (TRUE %in% rem){time[rem, j] <- NA}
}
# generate output
<- data.frame(cbind(1:n, arrivetime, eventtime, tottime, dropouttime, time, event))
tab colnames(tab) <- c("pat", "arrivetime", "eventtime", "tottime", "dropouttime", paste("time cutoff = ", cutoff, sep = ""), paste("event cutoff = ", cutoff, sep = ""))
<- list("cutoff.time" = cutoff.time, "tab" = tab)
res return(res)
}
# censored time-to-event data with censoring after pre-specified number of events, for two treatment arms
<- function(shape = c(1, 1), scale, cure = c(0, 0), recruit, dropout = c(0, 0), start.accrual = c(0, 0), cutoff, seed = NA){
rWeibull2arm
# shape 2-d vector of Weibull shape parameter.
# scale 2-d vector of Weibull scale parameter.
# cure: 2-d vector with cure proportion assumed in each arm.
# recruit: List with two elements, vector of recruitment in each arm.
# dropout: 2-d vector with drop-out rate for each arm, on same time scale as med.
# start.accrual: 2-d vector of time when accrual should start. Might be useful when simulating multi-stage trials.
# cutoff: Cutoff, #events the final censored data should have (can be a vector of multiple cutoffs).
# seed: If different from NA, seed used to generate random numbers.
#
# Kaspar Rufibach, June 2014
if (is.na(seed) == FALSE){set.seed(seed)}
<- rWeibull1arm(scale = scale[1], shape = shape[1], recruit = recruit[[1]], cutoff = 1,
dat1 dropout = dropout[1], cure = cure[1], start.accrual = start.accrual[1], seed = NA)$tab
<- rWeibull1arm(scale = scale[2], shape = shape[2], recruit = recruit[[2]], cutoff = 1,
dat2 dropout = dropout[2], cure = cure[2], start.accrual = start.accrual[2], seed = NA)$tab
<- c(nrow(dat1), nrow(dat2))
n
# treatment variable
<- factor(c(rep(0, n[1]), rep(1, n[2])), levels = 0:1, labels = c("A", "B"))
tmt
<- c(dat1[, "arrivetime"], dat2[, "arrivetime"])
arrivetime <- c(dat1[, "eventtime"], dat2[, "eventtime"])
eventtime <- c(dat1[, "tottime"], dat2[, "tottime"])
tottime <- c(dat1[, "dropouttime"], dat2[, "dropouttime"])
dropouttime
# Apply drop-out. Do this before applying the cutoff below, in order to correctly count necessary #events.
<- ifelse(eventtime > dropouttime, 0, 1)
event.dropout <- ifelse(event.dropout == 1, eventtime, dropouttime)
time.dropout
# find cutoff based on number of targeted events
# only look among patients that are not considered dropped-out
<- data.frame(matrix(NA, ncol = length(cutoff), nrow = sum(n)))
time <- time
event <- rep(NA, length(cutoff))
cutoff.time
for (j in 1:length(cutoff)){
<- sort(tottime[event.dropout == 1])[cutoff[j]]
cutoff.time[j]
# apply administrative censoring at cutoff
== 1, j] <- ifelse(tottime[event.dropout == 1] > cutoff.time[j], 0, 1)
event[event.dropout == 0, j] <- 0
event[event.dropout
# define time to event, taking into account both types of censoring
== 1, j] <- ifelse(event[, j] == 1, eventtime, cutoff.time[j] - arrivetime)[event.dropout == 1]
time[event.dropout == 0, j] <- pmin(cutoff.time[j] - arrivetime, time.dropout)[event.dropout == 0]
time[event.dropout
# remove times for patients arriving after the cutoff
<- (arrivetime > cutoff.time[j])
rem if (TRUE %in% rem){time[rem, j] <- NA}
}
# generate output
<- data.frame(cbind(1:sum(n), tmt, arrivetime, eventtime, tottime, dropouttime, time, event))
tab colnames(tab) <- c("pat", "tmt", "arrivetime", "eventtime", "tottime", "dropouttime",
paste("time cutoff = ", cutoff, sep = ""), paste("event cutoff = ", cutoff, sep = ""))
<- list("cutoff.time" = cutoff.time, "tab" = tab)
res return(res)
}
# functions to plot results
<- function(vert = FALSE){
horiz segments(0, 1, 1, 1, col = 5, lwd = 4, lty = 1)
segments(0, hr, 1, hr, col = 4, lwd = 4, lty = 1)
segments(0, mdd_no_interim, 1, mdd_no_interim, col = 2, lwd = 4, lty = 1)
legend("topright", paste("HR = ", disp(c(1, mdd_no_interim, hr), 2), " (",
c("futility boundary", "minimal detectable difference", "effect we power at"), ")",
sep = ""), bty = "n", lty = 1, col = c(5, 2, 4), lwd = 4)
# vertical line
if (vert){segments(inter_x[1], 0, inter_x[1], 1.42, lty = 2, col = 6)}
}
<- function(){
plot_empty <- cutoff / max(cutoff)
inter_x <- c(0.4, 1.5)
yli_traj
par(las = 1)
par(mar = c(3, 4, 1, 4), las = 1)
plot(0, 0, type = "n", xlim = c(0, 1), ylim = yli_traj, xlab = "", xaxt = "n", ylab = "hazard ratio")
axis(side = 4, at = seq(0, 2, by = 0.2), labels = disp(seq(0, 2, by = 0.2), 1))
axis(side = 1, at = inter_x[2], labels = c("interim", "final")[2])
}
```