R/Apply.calendar.censoring.2.R

In gsMeanFreq: Group Sequential Clinical Trial Designs for Composite Endpoints

#' @title Function to apply a given calendar time as effective censoring time for two-sample composite endpoint data.
#' @description
#' Applies administrative censoring at a specified calendar time by truncating
#' each subject’s observed event history; for subjects still under observation
#' at the calendar cutoff, a censoring record is added at the cutoff time.
#'
#' @param data A data frame generated by \code{TwoSample.generate.sequential()} containing simulated two-sample composite endpoint
#' data in long format.
#' @param calendar A positive numeric value specifying the calendar time (in years) at which administrative censoring is applied.
#' @importFrom dplyr %>% filter select add_row
#'
#' @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 <- TwoSample.generate.sequential(sizevec = c(100, 100), beta.trt = 0.8,
#' calendar = 5, recruitment = 3,
#' random.censor.rate = 0.05, seed = 2026)
#' df2 <- Apply.calendar.censoring.2(data= df, calendar = 3.9)
Apply.calendar.censoring.2 <- function(data, calendar){

  data_new <- NULL
  censoring.time <- calendar

  for (j in 1:max(data$id)){
    # j = 1
    # 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, .data$group))

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

      if (nrow(temp) == nrow(id.data)){
        # patient's last event (either death, censoring, or recurrent) is before this calendar time, the number of rows remains the same
        data_new <- rbind(data_new, temp)
      } else {
        # there were more events after this calendar time, the number of rows decreased, adding one more row as censoring
        temp <- temp %>%
          dplyr::add_row(group = unique(id.data$group), id = j, e = unique(id.data$e),
                                 event_time_cal = calendar, status = 0,
                                 death = 0, recurrent = 0, event = 0)
        data_new <- rbind(data_new, temp)
      }
    }
  } # end of the 'j' loop
  return(data_new)
}