A formula object specifies the regression function, with the
response be a Surv object, with form Surv(time1, time2, event)
data
An optional data frame which contains the variables
named in the formula.
weights
Optional case weights, same as in rpart
subset
Optional expression saying that only a subset of the rows of the data should be
used in the fit, same as in rpart
no.SE
Number of standard errors used in pruning, with default value 0.
control
A list of control values used to control the rpart
algorithm, with default cp = 0.001. See rpart.control for details.
Value
An object of class rpart. See rpart.object.
References
Fu, W. and Simonoff, J.S. (2016). Survival trees for left-truncated and right-censored data,
with application to time-varying covariate data. arXiv:1606.03033 [stat.ME]
Examples
## The Assay of serum free light chain data in survival package
## Adjust data & clean data
library(survival)
library(LTRCtrees)
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,]
## Fit LTRCART survival tree
LTRCART.obj <- LTRCART(Surv(age, End, death) ~ sex + FLC + creatinine, Train)
## Putting Surv(End, death) in formula would result an error message
## since LTRCART is expecting Surv(time1, time2, event)
## Plot the fitted tree
library(rpart.plot)
rpart.plot(LTRCART.obj)
## Predict relative risk on test set
LTRCART.pred <- predict(LTRCART.obj, newdata = Test)
####################################################################
####### Survival tree with time-varying covariates ##################
####################################################################
## The pbcseq dataset of survival package
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 LTRCART tree with time-varying covariates
fit.cox <- coxph(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
LTRCART.fit <- LTRCART(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
rpart.plot(LTRCART.fit)
### transform the wide format data into long format data using tmerge function
### from survival function
## 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)
rpart.plot(LTRCART.fit)
Results
R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(LTRCtrees)
> png(filename="/home/ddbj/snapshot/RGM3/R_CC/result/LTRCtrees/LTRCART.Rd_%03d_medium.png", width=480, height=480)
> ### Name: LTRCART
> ### Title: Fit a relative risk survival tree for LTRC data
> ### Aliases: LTRCART
>
> ### ** Examples
>
> ## The Assay of serum free light chain data in survival package
> ## Adjust data & clean data
> library(survival)
> library(LTRCtrees)
> 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,]
>
> ## Fit LTRCART survival tree
> LTRCART.obj <- LTRCART(Surv(age, End, death) ~ sex + FLC + creatinine, Train)
>
> ## Putting Surv(End, death) in formula would result an error message
> ## since LTRCART is expecting Surv(time1, time2, event)
>
> ## Plot the fitted tree
> library(rpart.plot)
Loading required package: rpart
> rpart.plot(LTRCART.obj)
>
> ## Predict relative risk on test set
> LTRCART.pred <- predict(LTRCART.obj, newdata = Test)
>
>
>
> ####################################################################
> ####### Survival tree with time-varying covariates ##################
> ####################################################################
> ## The pbcseq dataset of survival package
> 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 LTRCART tree with time-varying covariates
> fit.cox <- coxph(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
> LTRCART.fit <- LTRCART(Surv(time1, time2, event) ~ age + sex + log(bili), pbcseq)
> rpart.plot(LTRCART.fit)
>
> ### transform the wide format data into long format data using tmerge function
> ### from survival function
> ## 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)
> rpart.plot(LTRCART.fit)
>
>
>
>
>
>
> dev.off()
null device
1
>