if (FALSE) {
##################################################
# MULTISTATE SURVIVAL MODELLING with CAV DATA ####
##################################################
library(flexmsm)
# Import data
Data <- IDM_cav
# MODEL SPECIFICATION ####
formula <- list(years ~ s(years, bs = 'cr', k = 10) + dage + pdiag, # 1-2
years ~ s(years, bs = 'cr', k = 10) + dage + pdiag, # 1-3
0, # 2-1
years ~ s(years, bs = 'cr', k = 10) + dage + pdiag, # 2-3
0, # 3-1
0 # 3-2
)
# Counts of pairs of consecutive states observed (C = counts, T = times)
counts.CT <- state.pairs.CT(formula = formula, data = Data, time = 'years',
state = 'state', id = 'PTNUM')
counts.CT$counts
# MODEL FITTING ###
# NOTE ***
# Takes about 18 minutes on a machine with Windows 10,
# Intel 2.20 GHz core, 16 GB of RAM and 8 cores, using all cores.
# The default is to use 2 cores, this takes about 26 minutes.
# To use all available cores on your device input no_cores = NULL.
# ****
fmsm.out <- fmsm(formula = formula, data = Data,
id = 'PTNUM', state = 'state', death = TRUE,
fit = TRUE, parallel = TRUE, no_cores = 2,
pmethod = 'analytic')
print(fmsm.out)
AIC(fmsm.out)
BIC(fmsm.out)
# FITTING SUMMARY ####
summary(fmsm.out)
conv.check(fmsm.out)
####################
# VISUALISATION ####
####################
# PLOT THE SMOOTHS OF TIME FOR EACH TRANSITION ####
# par(mfrow = c(1,3))
plot(fmsm.out)
# Consider a patient with:
dage.pred <- 16 # - 16 year old donor
pdiag.pred <- 0 # - IDC as principal diagnosis
start.pred <- 0 # - start observation at time t = 0
stop.pred <- 15 # - t = 15 years for time horizon
n.pred <- 21 # - 21 time points
no.state.pred <- -13 # - (because we don't need this, so anything is fine)
newdata <- data.frame(PTNUM = rep(1, n.pred),
years = seq(start.pred, stop.pred, length.out = n.pred),
state = rep(no.state.pred, n.pred),
dage = rep(dage.pred, n.pred), pdiag = rep(pdiag.pred, n.pred))
# ESTMATED TRANSITION INTENSITIES ####
# Plot of estimated transition intensities
# par(mfrow = c(1,3))
Q.hat <- Q.pred(fmsm.out, newdata = newdata, get.CI = TRUE, plot.Q = TRUE, rug = TRUE,
ylim = c(0, 1.5))
# Estimated transition intensity matrix at, e.g., t = 0
round(Q.hat$Q.hist[,,1], 3)
# ESTMATED TRANSITION PROBABILITIES ####
# Plot of estimated transition probabilities
# par(mfrow = c(2,3))
P.hat <- P.pred(fmsm.out, newdata = newdata, get.CI = TRUE, plot.P = TRUE, rug = TRUE)
# Estimated 15 year transition probability matrix
round(P.hat$P.pred, 3)
# e.g., there is a 6.2% chance of observing CAV onset 15 years after transplant
}
Run the code above in your browser using DataLab