R/surv_measure.R

In HCsnip: Semi-supervised adaptive-height snipping of the Hierarchical Clustering tree

surv_measure <-
function(parti, surv.time, status, method = "BIC")
{
   if (length(parti) != length(surv.time) || length(status) != length(surv.time))  
      stop("input arguments dimension mismatch")
   if (!any(status %in% c(0, 1)))
      stop("Status vector must be zeros and ones")
   if (!is.vector(surv.time, mode = "numeric"))
      stop("'surv.time' should be numeric vector")   
   if (sum(method %in% c("AIC", "BIC")) == 0)
      stop("'method' must be 'AIC' or 'BIC'")
   data <- data.frame(st = surv.time, event = status, var = as.factor(parti))
   fit <- coxph(Surv(st, event) ~ var, data)
   p <- length(unique(parti))
   n <- length(parti)
   d <- sum(status)  
   if (method == "AIC") {
      aic <- - 2*fit$loglik[2] +  2*(p+2)
      aic <- (aic + (2 * (p + 2) * (p + 3))/(n - p - 3))
      return(-aic)
   } else if (method == "BIC") {
      bic <- (- 2*fit$loglik[2] +  p * log(d))
      return(-bic)
   }
}