R/Apply.calendar.censoring.R

In gsMeanFreq: Group Sequential Clinical Trial Designs for Composite Endpoints

#' @title Function to apply a given calendar time as effective censoring time.
#' @description Applies administrative censoring at a specified calendar time by truncating each subject's observed
#' event history. For subjects who are still under observation at the calendar cutoff, a censoring record is added
#' at the specified calendar time.
#' @param data A data frame containing simulated composite endpoint data generated by \code{Onesample.generate.sequential()}.
#' @param calendar A positive numeric value specifying the calendar time (in years) at which administrative censoring is applied.
#' @import dplyr
#'
#' @returns A data frame in long format containing the censored composite endpoint data. Each subject contributes all events occurring
#' on or before the specified calendar time, with an additional censoring record added for subjects who have not
#' experienced a terminal event by that time.
#' @export
#'
#' @examples
#' df <- Onesample.generate.sequential(size = 200, recruitment = 3,
#' calendar = 5, random.censor.rate = 0.05, seed = 1123)
#' df2 <- Apply.calendar.censoring(data = df, calendar = 4)
Apply.calendar.censoring <- function(data, calendar){

  data_new <- NULL
  censoring.time <- calendar

  for (j in 1:max(data$id)){
    # Only keep patients who have been enrolled
    id.data <- data %>%
      dplyr::filter(.data$id == j & .data$e <= censoring.time) %>%
      dplyr::select(c(.data$id, .data$e, .data$event_time_cal, .data$status, .data$death,
                      .data$recurrent, .data$event))

    if (nrow(id.data) != 0){
      # Apply the censoring at calendar time
      temp <- id.data %>%
        dplyr::filter(.data$event_time_cal <= censoring.time)

      if (nrow(temp) == nrow(id.data)){
        # patient died before the trial ended
        data_new <- rbind(data_new, temp)
      } else {
        temp <- temp %>% add_row(id = j, e = unique(id.data$e),  event_time_cal = censoring.time, status = 0,
                                 death = 0, recurrent = 0, event = 0)
        data_new <- rbind(data_new, temp)
      }
    }
  } # end of the 'j' loop
  return(data_new)
}