# NOT RUN {
# }
# NOT RUN {
#####################################################
#### prediction on a COX or SHARED frailty model ####
#####################################################
data(readmission)
#-- here is a generated cluster (31 clusters of 13 subjects)
readmission <- transform(readmission,group=id%%31+1)
#-- we compute predictions of death
#-- we extract last row of each subject for the time of death
readmission <- aggregate(readmission,by=list(readmission$id),
FUN=function(x){x[length(x)]})[,-1]
##-- predictions on a Cox proportional hazard model --##
cox <- frailtyPenal(Surv(t.stop,death)~sex+dukes,
n.knots=10,kappa=10000,data=readmission)
#-- construction of the data frame for predictions
datapred <- data.frame(sex=0,dukes=0)
datapred$sex <- as.factor(datapred$sex)
levels(datapred$sex)<- c(1,2)
datapred$dukes <- as.factor(datapred$dukes)
levels(datapred$dukes)<- c(1,2,3)
datapred[1,] <- c(1,2) # man, dukes 2
datapred[2,] <- c(2,3) # woman, dukes 3
#-- prediction of death for two patients between 100 and 100+w,
#-- with w in (50,100,...,1900)
pred.cox <- prediction(cox,datapred,t=100,window=seq(50,1900,50))
plot(pred.cox)
#-- prediction of death for two patients between t and t+400,
#-- with t in (100,150,...,1500)
pred.cox2 <- prediction(cox,datapred,t=seq(100,1500,50),window=400)
plot(pred.cox2)
##-- predictions on a shared frailty model for clustered data --##
sha <- frailtyPenal(Surv(t.stop,death)~cluster(group)+sex+dukes,
n.knots=10,kappa=10000,data=readmission)
#-- marginal prediction
# a group must be specified but it does not influence the results
# in the marginal predictions setting
datapred$group[1:2] <- 1
pred.sha.marg <- prediction(sha,datapred,t=100,window=seq(50,1900,50))
plot(pred.sha.marg)
#-- conditional prediction, given a specific cluster (group=5)
datapred$group[1:2] <- 5
pred.sha.cond <- prediction(sha,datapred,t=100,window=seq(50,1900,50),
conditional = TRUE)
plot(pred.sha.cond)
##-- marginal prediction of a recurrent event, on a shared frailty model
data(readmission)
datapred <- data.frame(t.stop=0,event=0,id=0,sex=0,dukes=0)
datapred$sex <- as.factor(datapred$sex)
levels(datapred$sex)<- c(1,2)
datapred$dukes <- as.factor(datapred$dukes)
levels(datapred$dukes)<- c(1,2,3)
datapred[1,] <- c(100,1,1,1,2) #man, dukes 2, 3 recurrent events
datapred[2,] <- c(200,1,1,1,2)
datapred[3,] <- c(300,1,1,1,2)
datapred[4,] <- c(350,0,2,1,2) #man, dukes 2 0 recurrent event
#-- Shared frailty model with gamma distribution
sha <- frailtyPenal(Surv(t.stop,event)~cluster(id)+sex+dukes,n.knots=10,
kappa=10000,data=readmission)
pred.sha.rec.marg <- prediction(sha,datapred,t=200,window=seq(50,1900,50),
event='Recurrent',MC.sample=100)
plot(pred.sha.rec.marg,conf.bands=TRUE)
##-- conditional prediction of a recurrent event, on a shared frailty model
pred.sha.rec.cond <- prediction(sha,datapred,t=200,window=seq(50,1900,50),
event='Recurrent',conditional = TRUE,MC.sample=100)
plot(pred.sha.rec.cond,conf.bands=TRUE)
#####################################################
######## prediction on a JOINT frailty model ########
#####################################################
data(readmission)
##-- predictions of death on a joint model --##
joi <- frailtyPenal(Surv(t.start,t.stop,event)~cluster(id)
+sex+dukes+terminal(death),formula.terminalEvent=~sex
+dukes,data=readmission,n.knots=10,kappa=c(100,100),recurrentAG=TRUE)
#-- construction of the data frame for predictions
datapredj <- data.frame(t.stop=0,event=0,id=0,sex=0,dukes=0)
datapredj$sex <- as.factor(datapredj$sex)
levels(datapredj$sex) <- c(1,2)
datapredj$dukes <- as.factor(datapredj$dukes)
levels(datapredj$dukes) <- c(1,2,3)
datapredj[1,] <- c(100,1,1,1,2)
datapredj[2,] <- c(200,1,1,1,2)
datapredj[3,] <- c(300,1,1,1,2)
datapredj[4,] <- c(400,1,1,1,2)
datapredj[5,] <- c(380,1,2,1,2)
#-- prediction of death between 100 and 100+500 given relapses
pred.joint0 <- prediction(joi,datapredj,t=100,window=500,event = "Terminal")
print(pred.joint0)
#-- prediction of death between 100 and 100+w given relapses
# (with confidence intervals)
pred.joint <- prediction(joi,datapredj,t=100,window=seq(50,1500,50),
event = "Terminal",MC.sample=100)
plot(pred.joint,conf.bands=TRUE)
# each y-value of the plot corresponds to the prediction between [100,x]
#-- prediction of death between t and t+500 given relapses
pred.joint2 <- prediction(joi,datapredj,t=seq(100,1000,50),
window=500,event = "Terminal")
plot(pred.joint2)
# each y-value of the plot corresponds to the prediction between [x,x+500],
#or in the next 500
#-- prediction of relapse between 100 and 100+w given relapses
# (with confidence intervals)
pred.joint <- prediction(joi,datapredj,t=100,window=seq(50,1500,50),
event = "Recurrent",MC.sample=100)
plot(pred.joint,conf.bands=TRUE)
# each y-value of the plot corresponds to the prediction between [100,x]
#-- prediction of relapse and death between 100 and 100+w given relapses
# (with confidence intervals)
pred.joint <- prediction(joi,datapredj,t=100,window=seq(50,1500,50),
event = "Both",MC.sample=100)
plot(pred.joint,conf.bands=TRUE)
# each y-value of the plot corresponds to the prediction between [100,x]
#############################################################################
### prediction on a JOINT model for longitudinal data and a terminal event ####
#############################################################################
data(colorectal)
data(colorectalLongi)
# Survival data preparation - only terminal events
colorectalSurv <- subset(colorectal, new.lesions == 0)
#-- construction of the data-frame for predictions
#-- biomarker observations
datapredj_longi <- data.frame(id = 0, year = 0, tumor.size = 0, treatment = 0,
age = 0, who.PS = 0, prev.resection = 0)
datapredj_longi$treatment <- as.factor(datapredj_longi$treatment)
levels(datapredj_longi$treatment) <- 1:2
datapredj_longi$age <- as.factor(datapredj_longi$age)
levels(datapredj_longi$age) <- 1:3
datapredj_longi$who.PS <- as.factor(datapredj_longi$who.PS)
levels(datapredj_longi$who.PS) <- 1:3
datapredj_longi$prev.resection <- as.factor(datapredj_longi$prev.resection)
levels(datapredj_longi$prev.resection) <- 1:2
# patient 1: increasing tumor size
datapredj_longi[1,] <- c(1, 0,1.2 ,2,1,1,1)
datapredj_longi[2,] <- c(1,0.3,1.4,2,1,1,1)
datapredj_longi[3,] <- c(1,0.6,1.9,2,1,1,1)
datapredj_longi[4,] <- c(1,0.9,2.5,2,1,1,1)
datapredj_longi[5,] <- c(1,1.5,3.9,2,1,1,1)
# patient 2: decreasing tumor size
datapredj_longi[6,] <- c(2, 0,1.2 ,2,1,1,1)
datapredj_longi[7,] <- c(2,0.3,0.7,2,1,1,1)
datapredj_longi[8,] <- c(2,0.5,0.3,2,1,1,1)
datapredj_longi[9,] <- c(2,0.7,0.1,2,1,1,1)
datapredj_longi[10,] <- c(2,0.9,0.1,2,1,1,1)
#-- terminal event
datapredj <- data.frame(id = 0, treatment = 0, age = 0, who.PS = 0,
prev.resection = 0)
datapredj$treatment <- as.factor(datapredj$treatment)
levels(datapredj$treatment) <- 1:2
datapredj$age <- as.factor(datapredj$age)
levels(datapredj$age) <- 1:3
datapredj$who.PS <- as.factor(datapredj$who.PS)
datapredj$prev.resection <- as.factor(datapredj$prev.resection)
levels(datapredj$prev.resection) <- 1:2
levels(datapredj$who.PS) <- 1:3
datapredj[1,] <- c(1,2,1,1,1)
datapredj[2,] <- c(2,2,1,1,1)
model.spli.CL <- longiPenal(Surv(time1, state) ~ age + treatment + who.PS
+ prev.resection, tumor.size ~ year * treatment + age + who.PS ,
colorectalSurv, data.Longi = colorectalLongi, random = c("1", "year"),
id = "id", link = "Current-level", left.censoring = -3.33, n.knots = 6,
kappa = 1)
#-- prediction of death between 1 year and 1+2 given history of the biomarker
pred.jointLongi0 <- prediction(model.spli.CL, datapredj, datapredj_longi,
t = 1, window = 2)
print(pred.jointLongi0)
#-- prediction of death between 1 year and 1+w given history of the biomarker
pred.jointLongi <- prediction(model.spli.CL, datapredj, datapredj_longi,
t = 1, window = seq(0.5, 2.5, 0.2), MC.sample = 100)
plot(pred.jointLongi, conf.bands = TRUE)
# each y-value of the plot corresponds to the prediction between [1,x]
#-- prediction of death between t and t+0.5 given history of the biomarker
pred.jointLongi2 <- prediction(model.spli.CL, datapredj, datapredj_longi,
t = seq(1, 2.5, 0.5), window = 0.5, MC.sample = 100)
plot(pred.jointLongi2, conf.bands = TRUE)
# each y-value of the plot corresponds to the prediction between [x,x+0.5],
#or in the next 0.5
#############################################################################
##### marginal prediction on a JOINT NESTED model for a terminal event ######
#############################################################################
#*--Warning! You can compute this prediction method with ONLY ONE family
#*--by dataset of prediction.
#*--Please make sure your data frame contains a column for individuals AND a
#*--column for the reference number of the family chosen.
data(readmission)
readmissionNested <- transform(readmission,group=id%%30+1)
#-- construction of the data frame for predictions :
#-- family 5 was selected for the prediction
DataPred <- readmissionNested[which(readmissionNested$group==5),]
#-- Fitting the model
modJointNested_Splines <-
frailtyPenal(formula = Surv(t.start, t.stop, event)~subcluster(id)+
cluster(group) + dukes + terminal(death),formula.terminalEvent
=~dukes, data = readmissionNested, recurrentAG = TRUE,n.knots = 8,
kappa = c(9.55e+9, 1.41e+12), initialize = TRUE)
#-- Compute prediction over the individuals 274 and 4 of the family 5
predRead <- prediction(modJointNested_Splines, data=DataPred,t=500,
window=seq(100,1500,200), conditional=FALSE, individual = c(274, 4))
#########################################################################
##### prediction on TRIVARIATE JOINT model (linear and non-linear) ######
#########################################################################
data(colorectal)
data(colorectalLongi)
#-- construction of the data frame for predictions
#-- history of recurrences and terminal event
datapredj <- data.frame(time0 = 0, time1 = 0, new.lesions = 0, id = 0,
treatment = 0, age = 0, who.PS = 0, prev.resection =0)
datapredj$treatment <- as.factor(datapredj$treatment)
levels(datapredj$treatment) <- 1:2
datapredj$age <- as.factor(datapredj$age)
levels(datapredj$age) <- 1:3
datapredj$who.PS <- as.factor(datapredj$who.PS)
levels(datapredj$who.PS) <- 1:3
datapredj$prev.resection <- as.factor(datapredj$prev.resection)
levels(datapredj$prev.resection) <- 1:2
datapredj[1,] <- c(0,0.4,1,1,2,1,1,1)
datapredj[2,] <- c(0.4,1.2,1,1,2,1,1,1)
datapredj[3,] <- c(0,0.5,1,2,2,1,1,1)
# Linear trivariate joint model
# (computation takes around 40 minutes)
model.trivPenal <-trivPenal(Surv(time0, time1, new.lesions) ~ cluster(id)
+ age + treatment + who.PS + terminal(state),
formula.terminalEvent =~ age + treatment + who.PS + prev.resection,
tumor.size ~ year * treatment + age + who.PS, data = colorectal,
data.Longi = colorectalLongi, random = c("1", "year"), id = "id",
link = "Random-effects", left.censoring = -3.33, recurrentAG = TRUE,
n.knots = 6, kappa=c(0.01, 2), method.GH="Pseudo-adaptive",
n.nodes=7, init.B = c(-0.07, -0.13, -0.16, -0.17, 0.42, #recurrent events covarates
-0.23, -0.1, -0.09, -0.12, 0.8, -0.23, #terminal event covariates
3.02, -0.30, 0.05, -0.63, -0.02, -0.29, 0.11, 0.74)) #biomarker covariates
#-- prediction of death between 1 year and 1+2
pred.jointTri0 <- prediction(model.trivPenal, datapredj,
datapredj_longi, t = 1, window = 2)
print(pred.jointTri0)
#-- prediction of death between 1 year and 1+w
pred.jointTri <- prediction(model.trivPenal, datapredj,
datapredj_longi, t = 1, window = seq(0.5, 2.5, 0.2), MC.sample = 100)
plot(pred.jointTri, conf.bands = TRUE)
#-- prediction of death between t and t+0.5
pred.jointTri2 <- prediction(model.trivPenal, datapredj,
datapredj_longi, t = seq(1, 2.5, 0.5), window = 0.5, MC.sample = 100)
plot(pred.jointTri2, conf.bands = TRUE)
###############################
# No information on dose - creation of a dummy variable
colorectalLongi$dose <- 1
# (computation can take around 40 minutes)
model.trivPenalNL <- trivPenalNL(Surv(time0, time1, new.lesions) ~ cluster(id) + age + treatment
+ terminal(state), formula.terminalEvent =~ age + treatment, biomarker = "tumor.size",
formula.KG ~ 1, formula.KD ~ treatment, dose = "dose", time.biomarker = "year",
data = colorectal, data.Longi =colorectalLongi, random = c("y0", "KG"), id = "id",
init.B = c(-0.22, -0.16, -0.35, -0.19, 0.04, -0.41, 0.23), init.Alpha = 1.86,
init.Eta = c(0.5, 0.57, 0.5, 2.34), init.Biomarker = c(1.24, 0.81, 1.07, -1.53),
recurrentAG = TRUE, n.knots = 5, kappa = c(0.01, 2), method.GH = "Pseudo-adaptive")
#-- prediction of death between 1 year and 1+2
pred.jointTriNL0 <- prediction(model.trivPenalNL, datapredj,
datapredj_longi, t = 1, window = 2)
print(pred.jointTriNL0)
#-- prediction of death between 1 year and 1+w
pred.jointTriNL <- prediction(model.trivPenalNL, datapredj,
datapredj_longi, t = 1, window = seq(0.5, 2.5, 0.2), MC.sample = 100)
plot(pred.jointTriNL, conf.bands = TRUE)
#-- prediction of death between t and t+0.5
pred.jointTriNL2 <- prediction(model.trivPenalNL, datapredj,
datapredj_longi, t = seq(2, 3, 0.2), window = 0.5, MC.sample = 100)
plot(pred.jointTriNL2, conf.bands = TRUE)
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab