# NOT RUN {
set.seed(123)
## Simulate survival data
## with random intercepts/slopes and a linear effect of time,
## constant association alpha and no effect of the derivative
d <- simJM(nsub = 200, long_setting = "linear",
alpha_setting = "constant",
dalpha_setting = "zero", full = FALSE)
## Formula of the according joint model
f <- list(
Surv2(survtime, event, obs = y) ~ s(survtime, bs = "ps"),
gamma ~ s(x1, bs = "ps"),
mu ~ obstime + s(id, bs = "re") +
s(id, obstime, bs = "re"),
sigma ~ 1,
alpha ~ 1,
dalpha ~ -1
)
## Joint model estimation
## jm_bamlss() sets the default optimizer and sampler function.
## First, posterior mode estimates are computed using function
## jm.mode(), afterwards the sampler jm.mcmc() is started.
b <- bamlss(f, data = d, family = "jm",
timevar = "obstime", idvar = "id")
## Plot estimated effects.
plot(b)
## Predict event probabilities for two individuals
## at 12 time units after their last longitudinal measurement.
## The event probability is conditional on their survival
## up to their last observed measurement.
p <- predict(b, type = "probabilities", id = c(1, 2), dt = 12, FUN = c95)
print(p)
## Plot of survival probabilities and
## corresponding longitudinal effects
## for individual id.
jm.survplot(b, id = 3)
jm.survplot(b, id = 30)
## Simulate survival data
## with functional random intercepts and a nonlinear effect
## of time, time-varying association alpha and no effect
## of the derivative.
## Note: This specification is the simJM default.
d <- simJM(nsub = 200, full = FALSE)
## Formula of the according joint model
## number of knots for the smooth nonlinear effect of time
klong <- 8
f <- list(
Surv2(survtime, event, obs = y) ~ s(survtime, bs = "ps"),
gamma ~ s(x1, bs = "ps"),
mu ~ ti(id, bs = "re") +
ti(obstime, bs = "ps", k = klong) +
ti(id, obstime, bs = c("re", "ps"),
k = c(nlevels(d$id), klong)) +
s(x2, bs = "ps"),
sigma ~ 1,
alpha ~ s(survtime, bs = "ps"),
dalpha ~ -1
)
## Estimating posterior mode only using jm.mode()
b_mode <- bamlss(f, data = d, family = "jm",
timevar = "obstime", idvar = "id",
sampler = FALSE)
## Estimating posterior means using jm.mcmc()
## with starting values generated from posterior mode
b_mean <- bamlss(f, data = d, family = "jm",
timevar = "obstime", idvar = "id", optimizer = FALSE,
start = parameters(b_mode), results = FALSE)
## Plot effects.
plot(b_mean, model = "alpha")
## Simulate survival data
## with functional random intercepts and an association nonlinear in mu
set.seed(234)
d <- simJM(nsub = 300, long_setting = "functional", alpha_setting = "nonlinear",
nonlinear = TRUE, full = FALSE, probmiss = 0.9)
## Calculate longitudinal model to obtain starting values for mu
long_df <- 7
f_start <- y ~ ti(id, bs = "re") + ti(obstime, bs = "ps", k = long_df) +
ti(id, obstime, bs = c("re", "ps"), k = c(nlevels(d$id), long_df)) +
s(x2, bs = "ps")
b_start <- bamlss(f_start, data = d, sampler = FALSE)
mu <- predict(b_start)$mu
## Fit joint model with nonlinear association (nonlinear = TRUE)
f <- list(
Surv2(survtime, event, obs = y) ~ s(survtime, bs = "ps"),
gamma ~ x1,
mu ~ ti(id, bs = "re") + ti(obstime, bs = "ps", k = long_df) +
ti(id, obstime, bs = c("re", "ps"), k = c(nlevels(d$id), long_df)) +
s(x2, bs = "ps"),
sigma ~ 1,
alpha ~ 1,
dalpha ~ -1
)
b <- bamlss(f, data = d, family = "jm", timevar = "obstime", idvar = "id",
nonlinear = TRUE, start_mu = mu,
n.iter = 6000, burnin = 2000, thin = 2)
plot(b)
samplestats(b$samples)
# }
Run the code above in your browser using DataLab