inst/doc/LTRCtrees.R

In LTRCtrees: Survival Trees to Fit Left-Truncated and Right-Censored and Interval-Censored Survival Data

## -----------------------------------------------------------------------------
 ## Adjust data & clean data
 library(survival)
 set.seed(0)
 ## Since LTRCART uses cross-validation to prune the tree, specifying the seed 
 ## guarantees that the results given here will be duplicated in other analyses
 Data <- flchain
 Data <- Data[!is.na(Data$creatinine),]
 Data$End <- Data$age + Data$futime/365
 DATA <- Data[Data$End > Data$age,]
 names(DATA)[6] <- "FLC"

## -----------------------------------------------------------------------------
 ## Setup training set and test set
 Train = DATA[1:500,]
 Test = DATA[1000:1020,]

## ---- fig.show='hold', fig.width = 3.4, fig.height = 4.5,warning = FALSE------
 ## Fit LTRCART and LTRCIT survival tree
 library(LTRCtrees)
 LTRCART.obj <- LTRCART(Surv(age, End, death) ~ sex + FLC + creatinine, Train)
 LTRCIT.obj <- LTRCIT(Surv(age, End, death) ~ sex + FLC + creatinine, Train)
 
 ## Putting Surv(End, death) in formula would result an error message
 ## since both LTRCART and LTRCIT are expecting Surv(time1, time2, event)
 
 ## Plot the fitted LTRCART tree using rpart.plot function in rpart.plot[6] package
 library(rpart.plot)
 prp(LTRCART.obj, roundint=FALSE)

 ## Plot the fitted LTRCIT tree
 plot(LTRCIT.obj)

## ----fig.show='hold', fig.width = 7, fig.height = 5,warning = FALSE-----------
library(partykit)
LTRCART.obj.party <- as.party(LTRCART.obj) 
LTRCART.obj.party$fitted[["(response)"]]<- Surv(Train$age, Train$End, Train$death)
plot(LTRCART.obj.party)

## -----------------------------------------------------------------------------
 ## predict median survival time on test data using fitted LTRCIT tree
 LTRCIT.pred <- predict(LTRCIT.obj, newdata=Test, type = "response")
 head(LTRCIT.pred)

 ## predict Kaplan Meier survival curve on test data
 ## return a list of survfit objects -- the predicted KM curves
 LTRCIT.pred <- predict(LTRCIT.obj, newdata=Test, type = "prob")
 head(LTRCIT.pred,2)

## -----------------------------------------------------------------------------
## Predict relative risk on test set
LTRCART.pred <- predict(LTRCART.obj, newdata=Test)
head(LTRCART.pred)

## -----------------------------------------------------------------------------
## Predict median survival time and Kaplan Meier survival curve
## on test data using Pred.rpart
LTRCART.pred <- Pred.rpart(Surv(age, End, death) ~ sex + FLC + creatinine, Train, Test)
head(LTRCART.pred$KMcurves, 2)  ## list of predicted KM curves
head(LTRCART.pred$Medians)  ## vector of predicted median survival time

## ---- echo=FALSE,results='hide'-----------------------------------------------
Patient.ID <- c(1,1,1,2,2)
Sex <- c('F', 'F', 'F', 'M', 'M')
Blood.pressure <- c(100,89, 120, 110, 105)
Start <- c(0,10,20,0,10)
End <- c(10,20,27,10,19)
Death <- c(0,0,1,0,0)
table1 <- cbind(Patient.ID , Sex, Blood.pressure,Start, End, Death)
Table <- as.data.frame(table1)

## ---- echo=FALSE, results='asis'----------------------------------------------
knitr::kable(Table)

## ----fig.show='hold', fig.width = 7, fig.height = 5,warning = FALSE-----------
set.seed(0)
library(survival)
## Create the start-stop-event triplet needed for coxph and LTRC trees
first <- with(pbcseq, c(TRUE, diff(id) !=0)) #first id for each subject
last <- c(first[-1], TRUE) #last id
time1 <- with(pbcseq, ifelse(first, 0, day))
time2 <- with(pbcseq, ifelse(last, futime, c(day[-1], 0)))
event <- with(pbcseq, ifelse(last, status, 0))
event <- 1*(event==2)

pbcseq$time1 <- time1
pbcseq$time2 <- time2
pbcseq$event <-  event

## Fit the Cox model and LTRC trees with time-varying covariates
fit.cox <- coxph(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
LTRCIT.fit <- LTRCIT(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
LTRCART.fit <- LTRCART(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)

## Result of the Cox model with time-varying covariates
fit.cox 

## plots of fitted survival trees with time-varying covariates
prp(LTRCART.fit,type=0, roundint=FALSE)
plot(LTRCIT.fit)

## ----fig.show='hold', fig.width = 3.4, fig.height = 4,warning = FALSE---------
library(survival)
### transform the wide format data into the long format data using tmerge function
### from survival package on Stanford Heart Transplant data
jasa$subject <- 1:nrow(jasa)

tdata <- with(jasa, data.frame(subject = subject,
	futime= pmax(.5, fu.date - accept.dt),
	txtime= ifelse(tx.date== fu.date,
	(tx.date -accept.dt) -.5,
	(tx.date - accept.dt)),
	fustat = fustat))

sdata <- tmerge(jasa, tdata, id=subject,death = event(futime, fustat),trt = tdc(txtime), options= list(idname="subject"))

sdata$age <- sdata$age - 48

sdata$year <- as.numeric(sdata$accept.dt - as.Date("1967-10-01"))/365.25

Cox.fit <- coxph(Surv(tstart, tstop, death) ~ age+ surgery, data= sdata)
LTRCART.fit <- LTRCART(Surv(tstart, tstop, death) ~ age + transplant, data = sdata)
LTRCIT.fit <- LTRCIT(Surv(tstart, tstop, death) ~ age + transplant, data = sdata)

## results
Cox.fit
prp(LTRCART.fit, roundint=FALSE)
plot(LTRCIT.fit)

## ----fig.show='hold', fig.width = 7, fig.height = 5,warning = FALSE-----------
library(interval)
data(bcos)

## Fit ICtree survival tree
Ctree <- ICtree(Surv(left,right,type="interval2")~treatment, bcos)

## Plot the fitted tree
plot(Ctree)