``````#### Modified by Mai Zhou, 9/2007, 10/2007.
#### For two samples of right censored data.
#### Both samples use nonparametric likelihood = EL.
#### We test the Ho: ROC curve  R(t0) = b0
#### Or testing the (1-b0)th quantile of sample one equals to
#### the (1-t0)th quantile of sample two.
#### There could be several versions: either use optimize() or optim() to
#### minimize over the value of commom quantile (the cstar value in output)
#### and either use el.cen.EM2() or use emplikH.disc()  to compute EL.
#### It seems the el.cen.EM2() version is more stable.
####
#### input: t1; right censored times, sample 1.
####        d1; censoring status, d1=1 means uncensored.

ROCnp <- function(t1, d1, t2, d2, b0, t0) {

if ( length(b0) != 1) stop ("check length of b0")
if ( length(t0) != 1) stop ("check length of t0")
if ( b0 >=1 | b0 <=0) stop ("check the value of b0")
if ( t0 >=1 | t0 <=0) stop ("check the value of t0")

tempnp2 <- WKM(x=t2, d=d2)
place2 <- sum(tempnp2\$surv >= t0)
c2 <- tempnp2\$times[place2]

tempnp1 <- WKM(x=t1, d=d1)
place1 <- sum(tempnp1\$surv > b0)
c1 <- tempnp1\$times[place1]

if(c2 <= c1)  c1 <- tempnp1\$times[place1 +1]  #### need to do this??

#llr <- function(const, t1, d1, t2, d2, b0, t0) {
#             npllik2 <- emplikH.disc(x=t2, d=d2, K=log(t0),
#                   fun=function(x,theta){as.numeric(x <= theta)},
#                   theta=const)\$"discrete.-2LLR"
#             npllik1 <- emplikH.disc(x=t1, d=d1, K=log(b0),
#                   fun=function(x,theta){as.numeric(x <= theta)},
#                   theta=const)\$"discrete.-2LLR"
#       return( npllik2 + npllik1 )
#       }
#
###  distribution version
llr <- function(const, t1, d1, t2, d2, b0, t0) {
npllik1 <- el.cen.EM2(x=t1, d=d1,
fun= function(x,theta){as.numeric(x <= theta)},
mu=1-b0, theta=const)\$"-2LLR"
npllik2 <- el.cen.EM2(x=t2, d=d2,
fun= function(x,theta){as.numeric(x <= theta)},
mu=1-t0, theta=const)\$"-2LLR"
return(npllik1+npllik2)
}

##temp <- optim(par=(c2+c1)/2, fn=llr, method="L-BFGS-B", lower=min(c2,c1),
##           upper=max(c2,c1), t1=t1,d1=d1,t2=t2,d2=d2,b0=b0,t0=t0)

temp <- optimize(f=llr, lower=min(c2,c1), upper=max(c2,c1),
t1=t1, d1=d1, t2=t2, d2=d2, b0=b0, t0=t0)

##cstar <- temp\$par
cstar <- temp\$minimum

##val <- temp\$value
val <- temp\$objective

list("-2LLR"=val, cstar=cstar)
}
``````