R/get_treatment_rate.R

In sutsabs/rwToT2: Real World Time on Treatment R Package

#' Get Treatment Rate
#'
#' Uses the survival fit object to compute the estimation of treatment/survival
#' at time point of interest using Kaplan–Meier product-limit estimate.
#' @param fit_km A \code{\link[survival]{survfit}} object.
#' @param t A numeric value: the time point of interest on the curve
#' @return Number of subjects at risk and the estimation of event at time \code{t} with Lower and Upper CI.
#' @seealso \code{\link[survival]{survfit}}, \code{\link[survival]{summary.survfit}}
#' @examples
#' require(survival)
#' fit_km <- survfit(Surv(time, status) ~ 1, data = aml)
#' get_treatment_rate(fit_km, 20)
#' @export
get_treatment_rate <- function(fit_km, t) {

  #error handling for cases when t is too far from time T----------------------
  tryCatch({
      summary_fit_km <- summary(fit_km, time = t)
      surv <- round(summary_fit_km$surv * 100, 1)
      lower <- round(summary_fit_km$lower * 100, 1)
      upper <- round(summary_fit_km$upper * 100, 1)
      treatment_rate <- paste("N=", summary_fit_km$n.risk, ", ", surv, "% (",
        lower, "% - ", upper, "%)",
        sep = ""
      )
      return(treatment_rate)
      },
    #when t is too large and returns error--------------------------------------
    error = function(e) {
      return("Not Available")
    }
  )
}