Merge pull request #394 from m-muecke/linting

refactor: use inherits, toString, explicit integer minor formatting

Author: bblodfon

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mlr3proba
 Title: Probabilistic Supervised Learning for 'mlr3'
-Version: 0.6.3
+Version: 0.6.4
 Authors@R:
     c(person(given = "Raphael",
              family = "Sonabend",
@@ -30,11 +30,16 @@ Authors@R:
              role = c("cre", "aut"),
              email = "bblodfon@gmail.com",
              comment = c(ORCID = "0000-0002-3609-8674")),
-      person(given = "Lukas", 
+      person(given = "Lukas",
              family = "Burk",
-             email = "github@quantenbrot.de", 
+             email = "github@quantenbrot.de",
              role = "ctb",
-             comment = c(ORCID = "0000-0001-7528-3795")))
+             comment = c(ORCID = "0000-0001-7528-3795")),
+      person(given = "Maximilian",
+             family = "Muecke",
+             email = "muecke.maximilian@gmail.com",
+             role = "ctb",
+             comment = c(ORCID = "0009-0000-9432-9795")))
 Description: Provides extensions for probabilistic supervised learning for
     'mlr3'.  This includes extending the regression task to probabilistic
     and interval regression, adding a survival task, and other specialized
@@ -86,7 +91,7 @@ Encoding: UTF-8
 LazyData: true
 NeedsCompilation: no
 Roxygen: list(markdown = TRUE, r6 = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate:
     'LearnerDens.R'
     'aaa.R'

NEWS.md

@@ -1,3 +1,8 @@
+# mlr3proba 0.6.4
+
+* Add useR! 2024 tutorial
+* Lots of refactoring, improve code quality (thanks to @m-muecke)
+
 # mlr3proba 0.6.3
 
 * Add new tasks from `survival` package: `veteran`, `pbc`, `mgus`, `gbsg`

R/LearnerDensHistogram.R

@@ -27,12 +27,12 @@ LearnerDensHistogram = R6::R6Class("LearnerDensHistogram",
   private = list(
     .train = function(task) {
       pars = self$param_set$get_values(tags = "train")
-      fit = invoke(.histogram, dat = task$data()[[1]], .args = pars)
+      fit = invoke(.histogram, dat = task$data()[[1L]], .args = pars)
       set_class(list(distr = fit$distr, hist = fit$hist), "dens.hist")
     },
 
     .predict = function(task) {
-      newdata = task$data()[[1]]
+      newdata = task$data()[[1L]]
       list(pdf = self$model$distr$pdf(newdata), cdf = self$model$distr$cdf(newdata),
            distr = self$model$distr)
     }

R/LearnerDensKDE.R

@@ -18,7 +18,7 @@ LearnerDensKDE = R6::R6Class("LearnerDensKDE",
     #' Creates a new instance of this [R6][R6::R6Class] class.
     initialize = function() {
       ps = ps(
-        kernel = p_fct(levels = subset(distr6::listKernels(), select = "ShortName")[[1]],
+        kernel = p_fct(levels = subset(distr6::listKernels(), select = "ShortName")[[1L]],
           default = "Epan", tags = "train"),
         bandwidth = p_dbl(lower = 0, tags = "train", special_vals = list("silver"))
       )
@@ -46,28 +46,30 @@ LearnerDensKDE = R6::R6Class("LearnerDensKDE",
         self$param_set$values$kernel == "Epan"
       }
 
-      data = task$data()[[1]]
+      data = task$data()[[1L]]
 
       kernel = get(as.character(subset(
         distr6::listKernels(),
         ShortName == self$param_set$values$kernel,
         ClassName)))$new()
 
 
-      bw = ifelse(self$param_set$values$bandwidth == "silver",
+      bw = if (isTRUE(self$param_set$values$bandwidth == "silver")) {
         0.9 * min(sd(data), stats::IQR(data, na.rm = TRUE) / 1.349, na.rm = TRUE) *
-          length(data)^-0.2,
-        self$param_set$values$bandwidth)
+          length(data)^-0.2
+      } else {
+        self$param_set$values$bandwidth
+      }
 
       pdf = function(x) {} # nolint
 
       body(pdf) = substitute({
-        if (length(x) == 1) {
+        if (length(x) == 1L) {
           return(1 / (rows * bw) * sum(kernel$pdf((x - train) / bw)))
         } else {
           x = matrix(x, nrow = length(x), ncol = rows)
           train_mat = matrix(train, nrow = nrow(x), ncol = rows, byrow = TRUE)
-          return(1 / (rows * bw) * colSums(apply((x - train_mat) / bw, 1, kernel$pdf)))
+          return(1 / (rows * bw) * colSums(apply((x - train_mat) / bw, 1L, kernel$pdf)))
         }
       }, list(
         rows = task$nrow,
@@ -83,7 +85,7 @@ LearnerDensKDE = R6::R6Class("LearnerDensKDE",
     },
 
     .predict = function(task) {
-      list(pdf = self$model$pdf(task$data()[[1]]),
+      list(pdf = self$model$pdf(task$data()[[1L]]),
         distr = self$model)
     }
   )

R/LearnerSurvCoxPH.R

@@ -55,13 +55,13 @@ LearnerSurvCoxPH = R6Class("LearnerSurvCoxPH",
         stop(sprintf(
           "Learner %s on task %s failed to predict: Missing values in new data (line(s) %s)\n",
           self$id, task$id,
-          paste0(which(!complete.cases(newdata)), collapse = ", ")))
+          toString(which(!complete.cases(newdata)))))
       }
 
       pv = self$param_set$get_values(tags = "predict")
 
       # Get predicted values
-      fit = mlr3misc::invoke(survival::survfit, formula = self$model, newdata = newdata,
+      fit = invoke(survival::survfit, formula = self$model, newdata = newdata,
         se.fit = FALSE, .args = pv)
 
       lp = predict(self$model, type = "lp", newdata = newdata)

R/MeasureRegrLogloss.R

@@ -45,7 +45,7 @@ MeasureRegrLogloss = R6::R6Class("MeasureRegrLogloss",
       if (inherits(distr, c("Matdist", "Arrdist"))) {
         pdf = diag(distr$pdf(truth))
       } else {
-        pdf = as.numeric(distr$pdf(data = matrix(truth, nrow = 1)))
+        pdf = as.numeric(distr$pdf(data = matrix(truth, nrow = 1L)))
       }
 
       pdf[pdf == 0] = self$param_set$values$eps

R/MeasureSurvAUC.R

@@ -16,7 +16,7 @@ MeasureSurvAUC = R6Class("MeasureSurvAUC",
     #' Creates a new instance of this [R6][R6::R6Class] class.
     initialize = function(id, properties = character(), label = NA_character_,
       man = NA_character_, param_set = ps()) {
-      if (class(self)[[1]] == "MeasureSurvAUC") {
+      if (class(self)[[1L]] == "MeasureSurvAUC") {
         stop("This is an abstract class that should not be constructed directly.")
       }
 
@@ -48,15 +48,15 @@ MeasureSurvAUC = R6Class("MeasureSurvAUC",
       }
 
       args$times = ps$times
-      if (length(args$times) == 0) {
-        args$times = sort(unique(prediction$truth[, 1]))
+      if (length(args$times) == 0L) {
+        args$times = sort(unique(prediction$truth[, 1L]))
       }
 
       if ("Surv.rsp.new" %in% names(formals(FUN))) {
         args$Surv.rsp.new = prediction$truth # nolint
       }
 
-      auc = mlr3misc::invoke(FUN, lpnew = prediction$lp, .args = args)
+      auc = invoke(FUN, lpnew = prediction$lp, .args = args)
 
       if (is.null(ps$integrated) || !ps$integrated || grepl("tnr|tpr", self$id)) {
         auc

R/MeasureSurvCalibrationAlpha.R

@@ -56,7 +56,7 @@ MeasureSurvCalibrationAlpha = R6Class("MeasureSurvCalibrationAlpha",
       )
       ps$values = list(eps = 1e-3, se = FALSE, method = method, truncate = Inf)
       range = if (method == "ratio") c(-Inf, Inf) else c(0, Inf)
-      minimize = ifelse(method == "ratio", FALSE, TRUE)
+      minimize = method != "ratio"
 
       super$initialize(
         id = "surv.calib_alpha",
@@ -73,8 +73,8 @@ MeasureSurvCalibrationAlpha = R6Class("MeasureSurvCalibrationAlpha",
   private = list(
     .score = function(prediction, ...) {
       truth = prediction$truth
-      all_times = truth[, 1] # both event times and censoring times
-      status = truth[, 2]
+      all_times = truth[, 1L] # both event times and censoring times
+      status = truth[, 2L]
       deaths = sum(status)
 
       ps = self$param_set$values
@@ -86,7 +86,7 @@ MeasureSurvCalibrationAlpha = R6Class("MeasureSurvCalibrationAlpha",
         # Bypass distr6 construction if underlying distr represented by array
         if (inherits(distr, "array")) {
           surv = distr
-          if (length(dim(surv)) == 3) {
+          if (length(dim(surv)) == 3L) {
             # survival 3d array, extract median
             surv = .ext_surv_mat(arr = surv, which.curve = 0.5)
           }
@@ -103,7 +103,7 @@ MeasureSurvCalibrationAlpha = R6Class("MeasureSurvCalibrationAlpha",
         } else {
           if (inherits(distr, "VectorDistribution")) {
             cumhaz = as.numeric(
-              distr$cumHazard(data = matrix(all_times, nrow = 1))
+              distr$cumHazard(data = matrix(all_times, nrow = 1L))
             )
           } else {
             cumhaz = diag(as.matrix(distr$cumHazard(all_times)))

R/MeasureSurvCalibrationBeta.R

@@ -47,7 +47,7 @@ MeasureSurvCalibrationBeta = R6Class("MeasureSurvCalibrationBeta",
       )
       ps$values = list(se = FALSE, method = method)
       range = if (method == "ratio") c(-Inf, Inf) else c(0, Inf)
-      minimize = ifelse(method == "ratio", FALSE, TRUE)
+      minimize = method != "ratio"
 
       super$initialize(
         id = "surv.calib_beta",
@@ -66,15 +66,15 @@ MeasureSurvCalibrationBeta = R6Class("MeasureSurvCalibrationBeta",
       df = data.frame(truth = prediction$truth, lp = prediction$lp)
       fit = try(summary(survival::coxph(truth ~ lp, data = df)), silent = TRUE)
 
-      if (class(fit)[1] == "try-error") {
+      if (inherits(fit, "try-error")) {
         return(NA)
       } else {
         ps = self$param_set$values
 
         if (ps$se) {
-          return(fit$coefficients[,"se(coef)"])
+          return(fit$coefficients[, "se(coef)"])
         } else {
-          out = fit$coefficients[,"coef"]
+          out = fit$coefficients[, "coef"]
 
           if (ps$method == "diff") {
             out = abs(1 - out)

R/MeasureSurvChamblessAUC.R

@@ -46,9 +46,9 @@ MeasureSurvChamblessAUC = R6Class("MeasureSurvChamblessAUC",
       ps = self$param_set$values
       if (!ps$integrated) {
         msg = "If `integrated=FALSE` then `times` should be a scalar numeric."
-        assert_numeric(ps$times, len = 1, .var.name = msg)
+        assert_numeric(ps$times, len = 1L, .var.name = msg)
       } else {
-        if (!is.null(ps$times) && length(ps$times) == 1) {
+        if (!is.null(ps$times) && length(ps$times) == 1L) {
           ps$integrated = FALSE
         }
       }