R/predictrcure.R

In echohan/rcure: Robust Cure Models for Survival Analysis

#' Prediction of robust cure model
#'
#' @description Prediction of survival probability from rcure() in order to pass subjects to plotpredictrcure().
#' @param object an object of rcure
#' @param newX new value(s) of X
#' @param newZ new value(s) of Z
#' @param model specifies survival part in cure model, "ph" or "aft"
#' @param ... further arguments to be passed to the predictrcure function
#' @references Cai, C., Zou, Y., Peng, Y., & Zhang, J. (2012). smcure: An R-Package for estimating semiparametric mixture cure models. Computer methods and programs in biomedicine, 108(3), 1255-1260
##' @export
predictrcure <-
function(object, newX, newZ,model=c("ph","aft"), ...)
{
	call <- match.call()
	if(!inherits(object, "rcure")) stop("Object must be results of rcure")
	if(is.vector(newZ)) newZ=as.matrix(newZ)
	newZ=cbind(1,newZ)
	if(is.vector(newX)) newX=as.matrix(newX)
	s0=as.matrix(object$s,ncol=1)
	n=nrow(s0)
	uncureprob=exp(object$b%*%t(newZ))/(1+exp(object$b%*%t(newZ)))
	scure=array(0,dim=c(n,nrow(newX)))
	t=array(0,dim=c(n,nrow(newX)))
	spop=array(0,dim=c(n,nrow(newX)))
  if(model=='ph')
    {ebetaX=exp(object$beta%*%t(newX))
  	for( i in 1:nrow(newZ))
     		{scure[,i]=s0^ebetaX[i]}
     for (i in 1:n){
        for (j in 1:nrow(newX)){
      spop[i,j]=uncureprob[j]*scure[i,j]+(1-uncureprob[j])
    }
   }
     prd=cbind(spop,Time=object$Time)
 }
  if(model=='aft')
 {
  newX=cbind(1,newX)
  ebetaX=exp(object$beta%*%t(newX))
  for( i in 1:nrow(newX))
     {t[,i]=ebetaX[i]*exp(object$error)}
 for (i in 1:n){
    for (j in 1:nrow(newX)){
     spop[i,j]=uncureprob[j]*s0[i]+(1-uncureprob[j])
     }
    }
  prd=cbind(spop=spop,Time=t)
}
 structure(list(call=call,newuncureprob=uncureprob,prediction=prd),class="predictrcure")
}