R/cr_components.R

In jatherrien/largeRCRF: Large Random Competing Risks Forests

#' Competing Risk Function Combiner
#'
#' Creates a CompetingRiskFunctionCombiner rJava object, which is used
#' internally for constructing a forest. The forest uses it when creating
#' predictions to average the cumulative incidence curves, cause-specific
#' cumulative hazard functions, and Kaplan-Meier curves generated by each tree
#' into individual functions.
#'
#' The user only needs to pass this object into \code{\link{train}} as the
#' \code{forestResponseCombiner} parameter.
#'
#' @param events A vector of integers specifying which competing risks event
#'   functions should be processed. This should correspond to all of the
#'   competing risk events that can occur, from 1 to the largest number.
#' @param times An optional numeric vector that forces the output functions to
#'   only update at these time points. Pre-specifying the values can result in
#'   faster performance when predicting, however if the times are not exhaustive
#'   then the resulting curves will not update at that point (they'll be flat).
#'   If left blank, the package will default to using all of the time points.
#' @export
#' @examples
#' T1 <- rexp(1000)
#' T2 <- rweibull(1000, 1, 2)
#' C <- rexp(1000)
#'
#' u <- round(pmin(T1, T2, C))
#' # ...
#'
#' forestCombiner <- CR_FunctionCombiner(1:2) # there are two possible events
#' # or, since we know that u is always an integer
#' forestCombiner <- CR_FunctionCombiner(1:2, 0:max(u))
CR_FunctionCombiner <- function(events, times = NULL){
  # need to first change events into array of int
  eventArray <- .jarray(events, "I")

  if(is.null(times)){
    timeArray <- .jnull(class="[D")
  }
  else{
    timeArray <- .jarray(as.numeric(times), "D")
  }

  javaObject <- .jnew(.class_CompetingRiskFunctionCombiner, eventArray, timeArray)
  javaObject <- .jcast(javaObject, .class_ForestResponseCombiner)

  combiner <- list(javaObject=javaObject,
                   call=match.call(),
                   events=events,
                   outputClass="CompetingRiskFunctions",
                   convertToRFunction=convertCompetingRiskFunctions)
  class(combiner) <- "ResponseCombiner"

  return(combiner)
}

#' Competing Risk Response Combiner
#'
#' Creates a CompetingRiskResponseCombiner rJava object, which is used
#' internally for constructing a forest. It is used when each tree in the forest
#' is constructed, as it combines response level information (u & delta) into
#' functions such as cumulative incidence curves, cause-specific cumulative
#' hazard functions, and an overall Kaplan-Meier curve. This combination is done
#' for each terminal node for each tree.
#'
#' The user only needs to pass this object into \code{\link{train}} as the
#' \code{nodeResponseCombiner} parameter.
#'
#' @param events A vector of integers specifying which competing risks event
#'   functions should be processed. This should correspond to all of the
#'   competing risk events that can occur, from 1 to the largest number.
#' @export
#' @examples
#' T1 <- rexp(1000)
#' T2 <- rweibull(1000, 1, 2)
#' C <- rexp(1000)
#'
#' u <- round(pmin(T1, T2, C))
#' # ...
#'
#' forestCombiner <- CR_ResponseCombiner(1:2) # there are two possible events
CR_ResponseCombiner <- function(events){
  # need to first change events into array of int
  eventArray <- .jarray(events, "I")


  javaObject <- .jnew(.class_CompetingRiskResponseCombiner, eventArray)
  javaObject <- .jcast(javaObject, .class_ResponseCombiner)

  combiner <- list(javaObject=javaObject,
                   call=match.call(),
                   outputClass="CompetingRiskFunctions",
                   convertToRFunction=convertCompetingRiskFunctions
                   )
  class(combiner) <- "ResponseCombiner"

  return(combiner)
}


#' Competing Risk Split Finders
#'
#' Creates a SplitFinder rJava Java object, which is then used internally when
#' training a competing risk random forest. The split finder is responsible for
#' finding the best split according to the logic of the split finder.
#'
#' These split finders require that the response be \code{\link{CR_Response}}.
#'
#' The user only needs to pass this object into \code{\link{train}} as the
#' \code{splitFinder} parameter.
#'
#' @return An internal rJava Java object used in \code{\link{train}}.
#' @note The Gray log-rank split finder \strong{requires} that the response
#'   include the censoring time.
#' @param events A vector of integers specifying which competing risk events
#'   should be focused on when determining differences. Currently, equal weights
#'   will be assigned to all included groups.
#' @param eventsOfFocus The split finder will only maximize differences
#'   between the two groups with respect to these specified events. Default is
#'   \code{NULL}, which will cause the split finder to focus on all events
#'   included in \code{events}.
#' @details Roughly speaking, the Gray log-rank split finder looks at
#'   differences between the cumulative incidence functions of the two groups,
#'   while the plain log-rank split finder look at differences between the
#'   cause-specific hazard functions. See the references for a more detailed
#'   discussion.
#' @references Kogalur, U., Ishwaran, H. Random Forests for Survival,
#'   Regression, and Classification: A Parallel Package for a General
#'   Implemention of Breiman's Random Forests: Theory and Specifications. URL
#'   https://kogalur.github.io/randomForestSRC/theory.html#section8.2
#'
#'   Ishwaran, H., et. al. (2014) Random survival forests for competing risks,
#'   Biostatistics (2014), 15, 4, pp. 757–773
#'
#' @name CompetingRiskSplitFinders
NULL

#' @rdname CompetingRiskSplitFinders
#' @export
#' @examples splitFinder <- GrayLogRankSplitFinder(1:2)
GrayLogRankSplitFinder <- function(events, eventsOfFocus = NULL){
  return(java.LogRankSplitFinder(events, eventsOfFocus, .class_GrayLogRankSplitFinder, match.call()))
}

#' @rdname CompetingRiskSplitFinders
#' @export
#' @examples splitFinder <- LogRankSplitFinder(1:2)
LogRankSplitFinder <- function(events, eventsOfFocus = NULL){
  return(java.LogRankSplitFinder(events, eventsOfFocus, .class_LogRankSplitFinder, match.call()))
}

# Internal function for creating a competing risk split finder
java.LogRankSplitFinder <- function(events, eventsOfFocus, java.class, call = match.call()){
  events <- sort(events)
  
  if(is.null(eventsOfFocus)){
    eventsOfFocus <- events
  }
  
  # Check the events
  if(any(diff(events) != 1) | min(events) != 1){
    stop("The events provided for creating a log rank split finder do not run from 1 to the maximum")
  }
  
  if(any(!(eventsOfFocus %in% events))){
    stop("There's an event of focus for the log rank split finder that's not included in the events vector")
  }
  
  events <- .jarray(as.integer(events))
  eventsOfFocus <- .jarray(as.integer(eventsOfFocus))
  
  javaObject <- .jnew(java.class, eventsOfFocus, events)
  javaObject <- .jcast(javaObject, .class_SplitFinder)
  
  splitFinder <- list(javaObject=javaObject, call=call)
  class(splitFinder) <- "SplitFinder"
  
  return(splitFinder)
}