if (FALSE) {
library("survival") # used for constructing survival formulas
library("BSGW") # used for Bayesian survival regression
data("bmt")
# splitting data into training and prediction sets
idx.train <- sample(1:nrow(bmt), size = 0.7 * nrow(bmt))
idx.pred <- setdiff(1:nrow(bmt), idx.train)
nobs.train <- length(idx.train)
nobs.pred <- length(idx.pred)
# prepare data and formula for Bayesian cause-specific survival regression
# using R package BSGW
out.prep <- cfc.prepdata(Surv(time, cause) ~ platelet + age + tcell, bmt)
f1 <- out.prep$formula.list[[1]]
f2 <- out.prep$formula.list[[2]]
dat <- out.prep$dat
tmax <- out.prep$tmax
# estimating cause-specific models
# set nsmp to larger number in real-world applications
nsmp <- 10
reg1 <- bsgw(f1, dat[idx.train, ], control = bsgw.control(iter = nsmp)
, ordweib = T, print.level = 0)
reg2 <- bsgw(f2, dat[idx.train, ], control = bsgw.control(iter = nsmp)
, ordweib = T, print.level = 0)
# defining survival function for this model
survfunc <- function(t, args, n) {
nobs <- args$nobs; natt <- args$natt; nsmp <- args$nsmp
alpha <- args$alpha; beta <- args$beta; X <- args$X
idx.smp <- floor((n - 1) / nobs) + 1
idx.obs <- n - (idx.smp - 1) * nobs
return (exp(- t ^ alpha[idx.smp] *
exp(sum(X[idx.obs, ] * beta[idx.smp, ]))));
}
# preparing function and argument lists
X.pred <- as.matrix(cbind(1, bmt[idx.pred, c("platelet", "age", "tcell")]))
arg.1 <- list(nobs = nobs.pred, natt = 4, nsmp = nsmp
, alpha = exp(reg1$smp$betas), beta = reg1$smp$beta, X = X.pred)
arg.2 <- list(nobs = nobs.pred, natt = 4, nsmp = nsmp
, alpha = exp(reg2$smp$betas), beta = reg2$smp$beta, X = X.pred)
arg.list <- list(arg.1, arg.2)
f.list <- list(survfunc, survfunc)
# cause-specific competing-risk
# set rel.tol to smaller number in real-world applications
tout <- seq(from = 0.0, to = tmax, length.out = 10)
out.cfc <- cfc(f.list, arg.list, nobs.pred * nsmp, tout, rel.tol = 1e-2)
}
Run the code above in your browser using DataLab