1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
library(survival)
# A contrived example for the tt function
#
mkdata <- function(n, beta) {
age <- runif(n, 20, 60)
x <- rbinom(n, 1, .5)
futime <- rep(40, n) # everyone has 40 years of follow-up
status <- rep(0, n)
dtime <- runif(n/2, 1, 40) # 1/2 of them die
dtime <- sort(dtime)
# The risk is set to beta[1]*x + beta[2]* f(current_age)
# where f= 0 up to age 40, rises linear to age 70, flat after that
for (i in 1:length(dtime)) {
atrisk <- (futime >= dtime[i])
c.age <- age + dtime
age2 <- pmin(30, pmax(0, c.age-40))
xbeta <- beta[1]*x + beta[2]*age2
# Select a death according to risk
risk <- ifelse(atrisk, exp(xbeta), 0)
dead <- sample(1:n, 1, prob=risk/sum(risk))
futime[dead] <- dtime[i]
status[dead] <- 1
}
data.frame(futime=futime, status=status, age=age, x=x, risk=risk)
}
tdata <- mkdata(500, c(log(1.5), 2/30))
fit1 <- coxph(Surv(futime, status) ~ x + pspline(age), tdata)
fit2 <- coxph(Surv(futime, status) ~ x + tt(age), tdata,
tt= function(x, t, ...) pspline(x+t))
dfit <- coxph(Surv(futime, status) ~ x + tt(age), tdata,
tt= function(x, t, ...) x+t, iter=0, x=T)
|
