library (survival)
## LM's function for IPCW (with se)
source ("DORfunctions.R" )
rm (list= ls ())
# input: (x1, delta1, x2, delta2, tau)
# LT's function for IPCW
dorsurvfun1= function (x1, delta1, x2, delta2, tau, n.t.grd= 100 )
{
n= length (x1)
x1= pmin (x1, tau)
delta1[x1== tau]= 1
x2= pmin (x2, tau)
delta2[x2== tau]= 1
fitc= survfit (Surv (x2, 1 - delta2)~ 1 )
time0= c (0 , fitc$ time)
surv0= c (1 , fitc$ surv)
weight= rep (0 , n)
for (ii in 1 : n)
{if (delta2[ii]> 0 )
weight[ii]= 1 / min (surv0[time0<= x2[ii]])
}
t.grd= seq (0 , tau, length= n.t.grd)
surv.grd= rep (NA , n.t.grd)
for (i in 1 : n.t.grd)
{ t0= t.grd[i]
surv.grd[i]= sum ((x2> x1+ t0)* weight)/ n
}
return (list (time= t.grd, surv= surv.grd))
}
## example
n= 200
n.t.grd= 100
tau= 1.25
B= 1000 # number of simulation
surv1 = matrix (0 , B, n.t.grd)
surv1LM = matrix (0 , B, n.t.grd)
for (b in 1 : B){
t1= pmin (rexp (n), runif (n, 0 , 0.75 ))
t2= rexp (n)* 1.5
t1[t1> t2]= t2[t1> t2]
c= runif (n, 0 , 1.5 )
x1= pmin (t1, c)
delta1= 1 * (t1< c)
x2= pmin (t2, c)
delta2= 1 * (t2< c)
fit1= dorsurvfun1 (x1, delta1, x2, delta2, tau, n.t.grd= n.t.grd)
surv1[b,]= fit1$ surv
time0= fit1$ time
## added by LM
fitLM <- dorfit (x1, delta1, x2, delta2, tau, M= n.t.grd)
m <- length (fitLM$ t1)
surv1LM[b,] <- fitLM$ surv1[ecdf (fitLM$ t1)(time0) * m]
cat (b," \n " )
}
par (mfrow= c (1 ,1 ))
plot (c (0 , tau), c (0 , 1 ), type= "n" , xlab = "t" , ylab = expression (S[D](t)))
lines (time0, apply (surv1, 2 , mean), col= 2 , lwd = 2 ) #LT
lines (time0, apply (surv1LM, 2 , mean), col= 3 ) #LM
legend ("topright" , lwd = c (2 , 1 ), col = 2 : 3 , c ("LT" , "LM" ))