R/marginal_nonparametric.R

In godwinyung/mmsurv: Multiple measures for the comparison of two survival curves

#' Nelson-Aelen cumulative hazard
#'
#' Theoretical mean or estimated value and the asymptotic variance.
#'
#' @param object An object of class "survdist or "survfit".
#'   For object of class "survdist", function calculates the thereotical
#'   mean and asymptotic variance of the Nelson-Aelen cumulative hazard.
#'   For object of class "survfit", function estimates the cumulative hazard
#'   and the corresponding estimation variance.
#' @param eval_time Time of evaluation.
#' @return
#'   \item{mu}{Theoretical mean or estimated value.}
#'   \item{Sigma}{Theoretical or estimated asymptotic variance (divided by sample size).}
#' @seealso \code{\link{create_survdist}}, \code{\link[survival]{survfit}}
#' @export
na_cumh <- function(object, eval_time) {
  UseMethod("na_cumh")
}

#' @export
na_cumh.survdist <- function(object, eval_time) {
  mu    <- object$surv_exphazard * eval_time
  Sigma <- integrate(function(x) object$surv_exphazard / prob_risk(object, eval_time=x), lower=0, upper=eval_time)$value / object$size
  return(list(mu=mu, Sigma=Sigma))
}

#' @export
na_cumh.survfit <- function(object, eval_time) {
  keep  <- object$time<=eval_time
  mu    <- sum(object$n.event[keep] / object$n.risk[keep])
  Sigma <- sum(object$n.event[keep] / object$n.risk[keep]^2)
  return(list(mu=mu, Sigma=Sigma))
}

###
# Kaplan-Meier milestone survival
###

###
# Restricted mean survival time
###

km_rmst <- function(object, eval_time) {
  UseMethod("km_rmst")
}

km_rmst.survdist <- function(object, eval_time) {
  mu    <- (1 - exp(-object$surv_exphazard * eval_time)) / object$surv_exphazard
  Sigma <- integrate(function(x) (exp(-object$surv_exphazard * x) - exp(-object$surv_exphazard * eval_time))^2 / object$surv_exphazard / prob_risk(object, eval_time=x), lower=0, upper=eval_time)$value / object$size
  return(list(mu=mu, Sigma=Sigma))
}