R/Pseudovalues.R

In zrmacc/MCC: Functions for Comparing Mean Cumulative Count Curves

# Purpose: Calculations of the AUC.
# Updated: 2025-06-14


#' Generate Pseudovalues
#'
#' @param data Data.frame. 
#' @param cens_after_last Should subjects who lack an explicit censoring time
#'   be censored after their last observed event? 
#' @param idx_name Name of column containing a unique subject index.
#' @param status_name Name of column containing the status. Must be coded as 0 for
#'   censoring, 1 for event, 2 for death. Each subject should have an 
#'   observation-terminating event, either censoring or death.
#' @param tau Numeric truncation time.
#' @param time_name Name of column containing the observation time.
#' @param weights Optional column of weights, controlling the size of the jump
#'   in the cumulative count curve at times with status == 1.
#' @return Data.frame with the influence and pseudo-value for each unique observation.
#' @export
GenPseudo <- function(
    data,
    cens_after_last = TRUE,
    idx_name = "idx",
    status_name = "status",
    tau = NULL,
    time_name = "time",
    weights = NULL
) {
  
  # Rename columns as necessary.
  idx <- orig_idx <-  time <- status <- NULL
  data <- data %>%
    dplyr::rename(
      idx = {{idx_name}},
      status = {{status_name}},
      time = {{time_name}}
    )
  
  # Format data.
  data <- FormatData(
    data,
    arm_name = NULL,
    cens_after_last = cens_after_last,
    weights = weights
  )
  idx_map <- data %>%
    dplyr::select(orig_idx, idx) %>%
    unique()
  
  # Truncation time.
  if (is.null(tau)) {
    max_t <- NULL
    tau <- data %>% 
      dplyr::summarise(max_t = max(time)) %>% 
      dplyr::pull(max_t) %>% min()
  }
  
  # Calculate AUC.
  auc <- SingleArmAUC(data = data, tau = tau)
  param <- auc@MargAreas$area[1]
  
  # Tabulate MCF.
  mcf <- CalcMCF(
    idx = data$idx, 
    status = data$status, 
    time = data$time, 
    weights = data$weights, 
    calc_var = FALSE
  )
  
  # Calculate influence.
  data_tau <- data %>% dplyr::filter(time <= tau)
  mcf_tau <- mcf %>% dplyr::filter(time <= tau)
  
  out <- PsiAUC(
    event_rate = mcf_tau$weighted_event_rate,
    idx = data_tau$idx,
    haz = mcf_tau$haz,
    nar = mcf_tau$nar,
    status = data_tau$status,
    surv = mcf_tau$surv,
    tau = tau,
    time = data_tau$time,
    weights = data_tau$weights
  )
  
  # Output.
  out$pseudo <- param + out$psi
  
  # Restore original index.
  out <- out %>%
    dplyr::inner_join(idx_map, by = "idx") %>%
    dplyr::select(-idx) %>%
    dplyr::relocate(orig_idx) %>%
    dplyr::rename(idx = orig_idx)
  
  return(out)
}