mlr-org · bblodfon · Feb 6, 2025 · Feb 6, 2025 · Feb 7, 2025 · Feb 7, 2025
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -73,8 +73,10 @@ NeedsCompilation: no
 Roxygen: list(markdown = TRUE, r6 = TRUE)
 RoxygenNote: 7.3.2
 Collate:
-    'LearnerDens.R'
+    'LearnerCompRisks.R'
     'aaa.R'
+    'LearnerCompRisksAalenJohansen.R'
+    'LearnerDens.R'
     'LearnerDensHistogram.R'
     'LearnerDensKDE.R'
     'LearnerSurv.R'
@@ -120,20 +122,24 @@ Collate:
     'PipeOpSurvAvg.R'
     'PipeOpTaskSurvClassifDiscTime.R'
     'PipeOpTaskSurvClassifIPCW.R'
+    'PredictionCompRisks.R'
+    'PredictionDataCompRisks.R'
     'PredictionDataDens.R'
     'PredictionDataSurv.R'
     'PredictionDens.R'
     'PredictionSurv.R'
     'RcppExports.R'
+    'TaskCompRisks.R'
     'TaskDens.R'
-    'TaskDens_zzz.R'
     'TaskGeneratorCoxed.R'
     'TaskGeneratorSimdens.R'
     'TaskGeneratorSimsurv.R'
     'TaskSurv.R'
-    'TaskSurv_zzz.R'
+    'Task_zzz.R'
+    'as_prediction_cmprsk.R'
     'as_prediction_dens.R'
     'as_prediction_surv.R'
+    'as_task_cmprisk.R'
     'as_task_dens.R'
     'as_task_surv.R'
     'assertions.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,28 +1,38 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.data.table,PredictionCompRisks)
 S3method(as.data.table,PredictionDens)
 S3method(as.data.table,PredictionSurv)
+S3method(as_prediction,PredictionDataCompRisks)
 S3method(as_prediction,PredictionDataDens)
 S3method(as_prediction,PredictionDataSurv)
+S3method(as_prediction_cmprsk,PredictionCompRisks)
+S3method(as_prediction_cmprsk,data.frame)
 S3method(as_prediction_dens,PredictionDens)
 S3method(as_prediction_dens,data.frame)
 S3method(as_prediction_surv,PredictionSurv)
 S3method(as_prediction_surv,data.frame)
+S3method(as_task_cmprsk,DataBackend)
+S3method(as_task_cmprsk,TaskCompRisks)
+S3method(as_task_cmprsk,data.frame)
 S3method(as_task_dens,DataBackend)
 S3method(as_task_dens,TaskDens)
 S3method(as_task_dens,data.frame)
 S3method(as_task_surv,DataBackend)
 S3method(as_task_surv,TaskSurv)
 S3method(as_task_surv,data.frame)
-S3method(as_task_surv,formula)
 S3method(autoplot,PredictionSurv)
 S3method(autoplot,TaskDens)
 S3method(autoplot,TaskSurv)
+S3method(c,PredictionDataCompRisks)
 S3method(c,PredictionDataDens)
 S3method(c,PredictionDataSurv)
+S3method(check_prediction_data,PredictionDataCompRisks)
 S3method(check_prediction_data,PredictionDataDens)
 S3method(check_prediction_data,PredictionDataSurv)
+S3method(filter_prediction_data,PredictionDataCompRisks)
 S3method(filter_prediction_data,PredictionDataSurv)
+S3method(is_missing_prediction_data,PredictionDataCompRisks)
 S3method(is_missing_prediction_data,PredictionDataDens)
 S3method(is_missing_prediction_data,PredictionDataSurv)
 S3method(pecs,PredictionSurv)
@@ -31,6 +41,8 @@ S3method(plot,TaskDens)
 S3method(plot,TaskSurv)
 export(.c_weight_survival_score)
 export(.surv_return)
+export(LearnerCompRisks)
+export(LearnerCompRisksAalenJohansen)
 export(LearnerDens)
 export(LearnerDensHistogram)
 export(LearnerDensKDE)
@@ -77,17 +89,22 @@ export(PipeOpResponseCompositor)
 export(PipeOpSurvAvg)
 export(PipeOpTaskSurvClassifDiscTime)
 export(PipeOpTaskSurvClassifIPCW)
+export(PredictionCompRisks)
 export(PredictionDens)
 export(PredictionSurv)
+export(TaskCompRisks)
 export(TaskDens)
 export(TaskGeneratorCoxed)
 export(TaskGeneratorSimdens)
 export(TaskGeneratorSimsurv)
 export(TaskSurv)
+export(as_prediction_cmprsk)
 export(as_prediction_dens)
 export(as_prediction_surv)
+export(as_task_cmprsk)
 export(as_task_dens)
 export(as_task_surv)
+export(assert_cif_list)
 export(assert_surv)
 export(assert_surv_matrix)
 export(breslow)
@@ -119,6 +136,7 @@ importFrom(stats,model.matrix)
 importFrom(stats,predict)
 importFrom(stats,quantile)
 importFrom(stats,sd)
+importFrom(stats,setNames)
 importFrom(survival,Surv)
 importFrom(utils,data)
 importFrom(utils,getFromNamespace)

diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,9 @@
 # mlr3proba dev
 
-* fix: allow cloning of measures objects
+* fix: allow cloning of measure objects
+* refactor: `TaskSurv` uses only right, left or interval censoring, simplified code a lot in the methods
+* feat: add `TaskCompRisks` class and `as_task_cmprk()` S3 methods (support for right-censored data only)
+* fix: as.data.table() for `PredictionSurv` objects holds now a survival curve per observation as it should
 
 # mlr3proba 0.7.4
 

diff --git a/R/LearnerCompRisks.R b/R/LearnerCompRisks.R
@@ -0,0 +1,47 @@
+#' @title Competing Risks Learner
+#'
+#' @description
+#' This Learner specializes [Learner] for competing risks problems:
+#'
+#' - `task_type` is set to `"cmprsk"`
+#' - Creates [Prediction]s of class [PredictionCompRisks].
+#' - The only currently available option for `predict_types` is `"cif"`, which
+#' represents the predicted **cumulative incidence function** for each observation
+#' in the test set.
+#'
+#' @template param_id
+#' @template param_param_set
+#' @template param_predict_types
+#' @template param_feature_types
+#' @template param_learner_properties
+#' @template param_packages
+#' @template param_label
+#' @template param_man
+#'
+#' @family Learner
+#' @export
+#' @examples
+#' library(mlr3)
+#' # get all survival learners from mlr_learners:
+#' lrns = mlr_learners$mget(mlr_learners$keys("^cmprsk"))
+#' names(lrns)
+#'
+#' # get a specific learner from mlr_learners:
+#' mlr_learners$get("cmprsk.aalen")
+#' lrn("cmprsk.aalen")
+LearnerCompRisks = R6Class("LearnerCompRisks",
+  inherit = Learner,
+  public = list(
+    #' @description Creates a new instance of this [R6][R6::R6Class] class.
+    initialize = function(id, param_set = ps(), predict_types = "cif",
+      feature_types = character(), properties = character(),
+      packages = character(), label = NA_character_, man = NA_character_) {
+
+      super$initialize(
+        id = id, task_type = "cmprsk", param_set = param_set, predict_types = predict_types,
+        feature_types = feature_types, properties = properties,
+        packages = c("mlr3proba", packages), label = label, man = man
+      )
+    }
+  )
+)
diff --git a/R/LearnerCompRisksAalenJohansen.R b/R/LearnerCompRisksAalenJohansen.R
@@ -0,0 +1,78 @@
+#' @title Aalen Johansen Competing Risks Learner
+#' @templateVar fullname LearnerCompRisksAalenJohansen
+#' @templateVar id cmprsk.aalen
+#' @template cmprsk_learner
+#'
+#' @description
+#'
+#' This learner estimates the Cumulative Incidence Function (CIF) for competing
+#' risks using the empirical Aalen-Johansen (AJ) estimator.
+#' The probability of transitioning to each competing event is computed via the
+#' [survfit][survival::survfit.formula()] function.
+#'
+#' @references
+#' `r format_bib("aalen_1978")`
+#'
+#' @export
+LearnerCompRisksAalenJohansen = R6Class("LearnerCompRisksAalenJohansen",
+  inherit = LearnerCompRisks,
+  public = list(
+    #' @description
+    #' Creates a new instance of this [R6][R6::R6Class] class.
+    initialize = function() {
+      param_set = ps(
+        model = p_lgl(default = FALSE, tags = "train")
+      )
+
+      super$initialize(
+        id = "cmprsk.aalen",
+        param_set = param_set,
+        predict_types = "cif",
+        feature_types = c("logical", "integer", "numeric", "factor"),
+        properties = "weights",
+        packages = "survival",
+        label = "Aalen Johansen Estimator",
+        man = "mlr3proba::mlr_learners_cmprsk.aalen"
+      )
+    }
+  ),
+
+  private = list(
+    .train = function(task) {
+      pv = self$param_set$get_values(tags = "train")
+
+      if ("weights" %in% task$properties) {
+        pv$weights = task$weights$weight
+      }
+
+      invoke(survival::survfit,
+             formula = task$formula(1),
+             data = task$data(cols = task$target_names),
+             .args = pv
+      )
+    },
+
+    .predict = function(task) {
+      trans_mat = self$model$pstate
+      trans_mat = trans_mat[, -1] # remove (s0) => prob of staying censored (state 0)
+
+      times = self$model$time # unique train set time points
+      n_obs = task$nrow # number of test observations
+      CIF = stats::setNames(vector("list", ncol(trans_mat)), colnames(trans_mat))
+
+      for (i in seq_along(CIF)) {
+        CIF[[i]] = matrix(
+          data = rep(trans_mat[, i], times = n_obs),
+          nrow = n_obs,
+          byrow = TRUE,
+          dimnames = list(NULL, times)
+        )
+      }
+
+      list(cif = CIF)
+    }
+  )
+)
+
+#' @include aaa.R
+register_learner("cmprsk.aalen", LearnerCompRisksAalenJohansen)
diff --git a/R/LearnerSurv.R b/R/LearnerSurv.R
@@ -39,10 +39,12 @@ LearnerSurv = R6Class("LearnerSurv",
     initialize = function(id, param_set = ps(), predict_types = "distr",
       feature_types = character(), properties = character(),
       packages = character(), label = NA_character_, man = NA_character_) {
+
       super$initialize(
         id = id, task_type = "surv", param_set = param_set, predict_types = predict_types,
         feature_types = feature_types, properties = properties,
-        packages = c("mlr3proba", packages), label = label, man = man)
+        packages = c("mlr3proba", packages), label = label, man = man
+      )
     }
   )
 )
diff --git a/R/MeasureSurvGraf.R b/R/MeasureSurvGraf.R
@@ -49,7 +49,7 @@
 #' @template details_tmax
 #'
 #' @references
-#' `r format_bib("graf_1999", "sonabend2024", "kvamme2023")`
+#' `r format_bib("graf_1999", "sonabend_2024", "kvamme_2023")`
 #'
 #' @family Probabilistic survival measures
 #' @family distr survival measures

diff --git a/R/MeasureSurvICI.R b/R/MeasureSurvICI.R
@@ -49,7 +49,7 @@
 #' cases.
 #'
 #' @references
-#' `r format_bib("austin2020")`
+#' `r format_bib("austin_2020")`
 #'
 #' @family calibration survival measures
 #' @family distr survival measures

diff --git a/R/MeasureSurvIntLogloss.R b/R/MeasureSurvIntLogloss.R
@@ -47,7 +47,7 @@
 #' @template details_tmax
 #'
 #' @references
-#' `r format_bib("graf_1999", "sonabend2024", "kvamme2023")`
+#' `r format_bib("graf_1999", "sonabend_2024", "kvamme_2023")`
 #'
 #' @family Probabilistic survival measures
 #' @family distr survival measures

diff --git a/R/MeasureSurvLogloss.R b/R/MeasureSurvLogloss.R
@@ -34,7 +34,7 @@
 #' @template details_trainG
 #'
 #' @references
-#' `r format_bib("sonabend2024")`
+#' `r format_bib("sonabend_2024")`
 #'
 #' @family Probabilistic survival measures
 #' @family distr survival measures

diff --git a/R/MeasureSurvSchmid.R b/R/MeasureSurvSchmid.R
@@ -46,7 +46,7 @@
 #' @template details_tmax
 #'
 #' @references
-#' `r format_bib("schemper_2000", "schmid_2011", "sonabend2024", "kvamme2023")`
+#' `r format_bib("schemper_2000", "schmid_2011", "sonabend_2024", "kvamme_2023")`
 #'
 #' @family Probabilistic survival measures
 #' @family distr survival measures

diff --git a/R/PipeOpTaskSurvClassifDiscTime.R b/R/PipeOpTaskSurvClassifDiscTime.R
@@ -116,7 +116,7 @@ PipeOpTaskSurvClassifDiscTime = R6Class("PipeOpTaskSurvClassifDiscTime",
   private = list(
     .train = function(input) {
       task = input[[1L]]
-      assert_true(task$censtype == "right")
+      assert_true(task$cens_type == "right")
       data = task$data()
 
       if ("disc_status" %in% colnames(task$data())) {

diff --git a/R/PipeOpTaskSurvClassifIPCW.R b/R/PipeOpTaskSurvClassifIPCW.R
@@ -135,7 +135,7 @@ PipeOpTaskSurvClassifIPCW = R6Class("PipeOpTaskSurvClassifIPCW",
       task = input[[1]]
 
       # checks
-      assert_true(task$censtype == "right")
+      assert_true(task$cens_type == "right")
       tau = assert_numeric(self$param_set$values$tau, null.ok = FALSE)
       max_event_time = max(task$unique_event_times())
       stopifnot(tau <= max_event_time)