R/sn_ic_adtneh2.R

In curesurv: Mixture and Non Mixture Parametric Cure Models to Estimate Cure Indicators

#' @title sn_ic_adtneh2 function
#'
#' @description calculates the net survival at time t. It also provides
#'  the related confidence intervals using plain_method.
#'
#' @param object ouput from a model implemented in curesurv
#'
#' @param z_alpha Covariates matrix acting on parameter alpha of the density of
#'  time-to-null excess hazard model
#'
#' @param z_tau Covariates matrix acting on time-to-null parameter.
#'
#' @param x time at which the predictions are provided
#'
#' @param level (1-alpha/2)-order quantile of a normal distribution
#'
#' @param cumLexctopred a pre-prediction thing obtained from cumLexc_ad2_topred, calculated if not NULL
#'
#' @param Dsn partial derivatives of Sn obtained from dsndtheta_adtneh2 function, calculated if not NULL
#'
#' @author Juste Goungounga, Judith Breaud, Olayide Boussari, Laura Botta, Valerie Jooste
#'
#' @references Boussari O, Bordes L, Romain G, Colonna M, Bossard N, Remontet L,
#'  Jooste V. Modeling excess hazard with time-to-cure as a parameter.
#'   Biometrics. 2021 Dec;77(4):1289-1302. doi: 10.1111/biom.13361.
#'    Epub 2020 Sep 12. PMID: 32869288.
#' (\href{https://pubmed.ncbi.nlm.nih.gov/32869288/}{pubmed})
#'
#' @keywords internal


sn_ic_adtneh2 <-  function(z_tau = z_tau,
                          z_alpha = z_alpha,
                          x = x,
                          object = object,
                          level = level,
                          cumLexctopred=NULL,
                          Dsn=NULL){
  if (!inherits(object, "curesurv"))
    stop("Primary argument much be a curesurv object")
  if(is.null(cumLexctopred)){
    cumLexctopred=cumLexc_ad2_topred(z_tau = z_tau,z_alpha = z_alpha,x=x,theta=object$coefficient)
  }
  if(is.null(Dsn)){
    Dpi <- dpidtheta_adtneh2(z_tau = z_tau,
                             z_alpha = z_alpha,
                             x = x,
                             object,
                             cumLexctopred=cumLexctopred)
    Dsn<-dsndtheta_adtneh2(z_tau=z_tau,
                           z_alpha=z_alpha,
                           x=x,
                           object,
                           cumLexctopred=cumLexctopred,
                           Dpi=Dpi)
  }

  sn <- cumLexctopred$netsurv
  varsn <- diag(Dsn %*% object$varcov_star %*% t(Dsn))
  lower_bound <-  sn - stats::qnorm(level) * sqrt(varsn)
  upper_bound <-  sn + stats::qnorm(level) * sqrt(varsn)

  IC <- list(sn = sn,
             lower_bound = lower_bound,
             upper_bound = upper_bound)

  return(IC)

}