add regr.logloss

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mlr3proba
 Title: Probabilistic Supervised Learning for 'mlr3'
-Version: 0.5.0
+Version: 0.5.1
 Authors@R:
     c(person(given = "Raphael",
              family = "Sonabend",

NAMESPACE

@@ -43,6 +43,7 @@ export(LearnerSurvKaplan)
 export(LearnerSurvRpart)
 export(MeasureDens)
 export(MeasureDensLogloss)
+export(MeasureRegrLogloss)
 export(MeasureSurv)
 export(MeasureSurvAUC)
 export(MeasureSurvCalibrationAlpha)

NEWS.md

@@ -1,3 +1,7 @@
+# mlr3proba 0.5.1
+
+* Add `regr.logloss`
+
 # mlr3proba 0.5.0
 
 * Possibly small breaking change, renamed `PipeOpProbregrCompositor` to `PipeOpProbregr` and default distribution now `"Uniform"`.

R/MeasureRegrLogloss.R

@@ -1,21 +1,56 @@
-#' MeasureRegrLogloss = R6::R6Class("MeasureRegrLogloss",
-#'   inherit = MeasureRegr,
-#'   public = list(
-#'     #' @description Creates a new instance of this [R6][R6::R6Class] class.
-#'     initialize = function() {
-#'     super$initialize(
-#'       id = "regr.logloss",
-#'       range = c(0, Inf),
-#'       minimize = TRUE,
-#'       predict_type = "distr"
-#'       #        task_properties = "twoclass",
-#'       #        packages = "Metrics"
-#'     )
-#'     },
+#' @template regr_measure
+#' @templateVar title Log loss
+#' @templateVar inherit [MeasureRegr]
+#' @templateVar fullname MeasureRegrLogloss
+#' @templateVar pars eps = 1e-15
+#' @templateVar eps_par TRUE
 #'
-#' .score = function(prediction, ...) {
-#'   return(mean(-log(as.numeric(do.call(prediction$prob$pdf,
-#'                                       as.list(prediction$truth))))))
-#' }
-#'   )
-#' )
+#' @template param_eps
+#'
+#' @description
+#' Calculates the cross-entropy, or logarithmic (log), loss.
+#'
+#' The logloss, in the context of probabilistic predictions, is defined as the negative log
+#' probability density function, \eqn{f}, evaluated at the observed value, \eqn{y},
+#' \deqn{L(f, y) = -\log(f(y))}{L(f, y) = -log(f(y))}
+#'
+#' @export
+MeasureRegrLogloss = R6::R6Class("MeasureRegrLogloss",
+  inherit = MeasureRegr,
+  public = list(
+    #' @description
+    #' Creates a new instance of this [R6][R6::R6Class] class.
+    initialize = function() {
+      ps = ps(
+        eps = p_dbl(0, 1, default = 1e-15)
+      )
+      ps$values$eps = 1e-15
+
+      super$initialize(
+        id = "regr.logloss",
+        range = c(0, Inf),
+        minimize = TRUE,
+        predict_type = "distr",
+        man = "mlr3proba::mlr_measures_regr.logloss",
+        label = "Log Loss",
+        param_set = ps
+      )
+    }
+  ),
+
+  private = list(
+    .score = function(prediction, ...) {
+      distr = prediction$distr
+      truth = prediction$truth
+
+      if (inherits(distr, "Matdist")) {
+        pdf = diag(distr$pdf(truth))
+      } else {
+        pdf = as.numeric(distr$pdf(data = matrix(truth, nrow = 1)))
+      }
+
+      pdf[pdf == 0] = self$param_set$values$eps
+      mean(-log(pdf))
+    }
+  )
+)

R/zzz.R

@@ -104,7 +104,7 @@ register_mlr3 = function() {
 
   x$add("dens.logloss", MeasureDensLogloss)
 
-  # x$add("regr.logloss", MeasureRegrLogloss)
+  x$add("regr.logloss", MeasureRegrLogloss)
 
   x$add("surv.graf", MeasureSurvGraf)
   x$add("surv.brier", MeasureSurvGraf)

man-roxygen/regr_measure.R

@@ -0,0 +1,15 @@
+#' <% meas = get(fullname)$new() %>
+#' <% shortname = meas$id %>
+#'
+#' @include MeasureRegr.R
+#' @title <%=title%> Regression Measure
+#' @name <%= paste("mlr_measures", shortname, sep = "_")%>
+#'
+#' @section Meta Information:
+#' * Type: `"regr"`
+#' * Range: <%= format_range(meas$range) %>
+#' * Minimize: `<%=meas$minimize%>`
+#' * Required prediction: `<%=meas$predict_type%>`
+#'
+#' @family regression measures
+#' @template seealso_measure

tests/testthat/test_mlr_measures_regr.R

@@ -0,0 +1,7 @@
+library(mlr3pipelines)
+l = as_learner(ppl("probregr", learner = lrn("regr.featureless")))
+task = tsk("mtcars")
+p = l$train(task)$predict(task)
+
+expect_measure(msr("regr.logloss"))
+expect_numeric(p$score(msr("regr.logloss")))