library(survival)
library(JM)
# Compare Local constant and local linear estimator for a single covariate,
# use KM for reference.
# Albumin marker, use landmarking
Landmark <- 2
pbcT1 <- pbc2[which(pbc2$year< Landmark & pbc2$years> Landmark),]
b=0.9
arg1ll<-get_h_xll(pbcT1, 'albumin', event_time_name = 'years', time_name = 'year',
event_name = 'status2', 2, 0.9)
arg1lc<-get_h_x(pbcT1, 'albumin', event_time_name = 'years', time_name = 'year',
event_name = 'status2', 2, 0.9)
#Calculate the local contant and local linear survival functions
br_s = seq(Landmark, 14, length=99)
sfalb2ll<- make_sf((br_s[2]-br_s[1])/4 , arg1ll)
sfalb2lc<- make_sf((br_s[2]-br_s[1])/4 , arg1lc)
#For comparison, also calculate the Kaplan-Meier
kma2<- survfit(Surv(years , status2) ~ 1, data = pbcT1)
#Plot the survival functions:
plot(br_s, sfalb2ll, type="l", col=1, lwd=2, ylab="Survival probability",
xlab="Marker level")
lines(br_s, sfalb2lc, lty=2, lwd=2, col=2)
lines(kma2$time, kma2$surv, type="s", lty=2, lwd=2, col=3)
legend("topright", c( "Local linear HQM", "Local constant HQM", "Kaplan-Meier"),
lty=c(1, 2, 2), col=1:3, lwd=2, cex=1.7)
if (FALSE) {
#Example of get_h_xll with a single covariate (no indexing):
#Compare JM, HQM and KM for Bilirubin
b = 10
Landmark <- 1
lmeFit <- lme(serBilir ~ year, random = ~ year | id, data = pbc2)
coxFit <- coxph(Surv(years, status2) ~ serBilir, data = pbc2.id, x = TRUE)
jointFit0 <- jointModel(lmeFit, coxFit, timeVar = "year",
method = "piecewise-PH-aGH")
pbcT1 <- pbc2[which(pbc2$year< Landmark & pbc2$years> Landmark),]
timesS1 <- seq(1,14,by=0.5)
predT1 <- survfitJM(jointFit0, newdata = pbcT1,survTimes = timesS1)
nm<-length(predT1$summaries)
mat.out1<-matrix(nrow=length(timesS1), ncol=nm)
for(r in 1:nm)
{
SurvLand <- predT1$summaries[[r]][,"Mean"][1]
mat.out1[,r] <- predT1$summaries[[r]][,"Mean"]/SurvLand
}
sfit1y<-rowMeans(mat.out1, na.rm=TRUE)
arg1<- get_h_xll(pbcT1, 'serBilir', event_time_name = 'years',
time_name = 'year', event_name = 'status2', 1, 10)
br_s1 = seq(Landmark, 14, length=99)
sfbil1<- make_sf((br_s1[2]-br_s1[1])/5.4 , arg1)
kma1<- survfit(Surv(years , status2) ~ 1, data = pbcT1)
plot(br_s1, sfbil1, type="l", ylim=c(0,1), xlim=c(Landmark,14),
ylab="Survival probability", xlab="years",lwd=2)
lines(timesS1, sfit1y, col=2, lwd=2, lty=2)
lines(kma1$time, kma1$surv, type="s", lty=2, lwd=2, col=3 )
legend("bottomleft", c("HQM est.", "Joint Model est.", "Kaplan-Meier"),
lty=c(1,2,2), col=1:3, lwd=2, cex=1.7)
#Example of get_h_xll with two indexed covariates:
#First, estimate the joint model for Albumin and Bilirubin combined:
lmeFit <- lme(albumin + serBilir~ year, random = ~ year | id, data = pbc2)
coxFit <- coxph(Surv(years, status2) ~ albumin + serBilir, data = pbc2.id,
x = TRUE)
jointFit <- jointModel(lmeFit, coxFit, timeVar = "year",
method = "piecewise-PH-aGH")
Landmark <- 1
pbcT1 <- pbc2[which(pbc2$year< Landmark & pbc2$years> Landmark),]
# Index Albumin and Bilirubin:
t.alb = 3 # slightly low albumin value
t.bil = 1.9 # slightly high bilirubin value
par.alb <- 0.0702
par.bil <- 0.0856
X = par.alb * pbcT1$albumin + par.bil *pbcT1$serBilir # X is now the indexed marker
t = par.alb * t.alb + par.bil *t.bil #conditioning value
pbcT1$drug<- X ## store X in place of 'drug' column which is redundant here
## i.e. 'drug' corresponds to indexed bilirubin and albumin
timesS2 <- seq(Landmark,14,by=0.5)
predT1 <- survfitJM(jointFit, newdata = pbcT1,survTimes = timesS2)
nm<-length(predT1$summaries)
mat.out1<-matrix(nrow=length(timesS2), ncol=nm)
for(r in 1:nm)
{
SurvLand <- predT1$summaries[[r]][,"Mean"][1] #obtain mean predictions
mat.out1[,r] <- predT1$summaries[[r]][,"Mean"]/SurvLand
}
JM.surv.est<-rowMeans(mat.out1, na.rm=TRUE) #average the resulting JM estimates
# calculate indexed local linear HQM estimator for bilirubin and albumin
b.alb = 1.5
b.bil = 4
b.hqm = par.alb * b.alb + par.bil *b.bil # bandwidth for HQM estimator
arg1<- get_h_xll(pbcT1, 'drug', event_time_name = 'years', time_name = 'year',
event_name = 'status2', t, b.hqm)
br_s2 = seq(Landmark, 14, length=99) #grid points for HMQ estimator
hqm.surv.est<- make_sf((br_s2[2]-br_s2[1])/5 ,arg1) # transform HR to Survival func.
km.land<- survfit(Surv(years , status2) ~ 1, data = pbcT1) #KM estimate
#Plot the survival functions:
plot(br_s2, hqm.surv.est, type="l", ylim=c(0,1), xlim=c(Landmark,14),
ylab="Survival probability", xlab="years",lwd=2)
lines(timesS2, JM.surv.est, col=2, lwd=2, lty=2)
lines(km.land$time, km.land$surv, type="s",lty=2, lwd=2, col=3)
legend("bottomleft", c("HQM est.", "Joint Model est.", "Kaplan-Meier"),
lty=c(1,2,2), col=1:3, lwd=2, cex=1.7)
}
Run the code above in your browser using DataLab