Issue #820 - Replace customise_metric with purrr::partial (#874)

* First draft

* Update Namespace and tests

* update News file

DESCRIPTION

@@ -58,6 +58,7 @@ Imports:
     ggplot2 (>= 3.4.0),
     methods,
     Metrics,
+    purrr,
     scoringRules,
     stats
 Suggests: 

NAMESPACE

@@ -24,8 +24,6 @@ export(bias_quantile)
 export(bias_sample)
 export(brier_score)
 export(crps_sample)
-export(customise_metric)
-export(customize_metric)
 export(dispersion_quantile)
 export(dispersion_sample)
 export(dss_sample)
@@ -167,6 +165,7 @@ importFrom(ggplot2,unit)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)
 importFrom(methods,hasArg)
+importFrom(purrr,partial)
 importFrom(scoringRules,crps_sample)
 importFrom(scoringRules,dss_sample)
 importFrom(scoringRules,logs_sample)

NEWS.md

@@ -18,7 +18,7 @@ of our [original](https://doi.org/10.48550/arXiv.2205.07090) `scoringutils` pape
   `score()` now returns objects of class `scores` with a stored attribute `metrics` that holds the names of the scoring rules that were used. Users can call `get_metrics()` to access the names of those scoring rules.
   - `score()` now returns one score per forecast, instead of one score per sample or quantile.
   - Users can now also use their own scoring rules (making use of the `metrics` argument, which takes in a named list of functions). Default scoring rules can be accessed using the functions `metrics_point()`, `metrics_sample()`, `metrics_quantile()` and `metrics_binary()`, which return a named list of scoring rules suitable for the respective forecast type. Column names of scores in the output of `score()` correspond to the names of the scoring rules (i.e. the names of the functions in the list of metrics).
-  - Instead of supplying arguments to `score()` to manipulate individual scoring rules users should now manipulate the metric list being supplied using `customise_metric()` and `select_metric()`.
+  - Instead of supplying arguments to `score()` to manipulate individual scoring rules users should now manipulate the metric list being supplied using `purrr::partial()` and `select_metric()`. See `?score()` for more information.
   - the CRPS is now reported as decomposition into dispersion, overprediction and underprediction.
 
 ### Creating a forecast object  

R/default-scoring-rules.R

@@ -40,65 +40,6 @@ select_metrics <- function(metrics, select = NULL, exclude = NULL) {
 
 }
 
-#' Customises a metric function with additional arguments.
-#'
-#' @description
-#' This function takes a metric function and additional arguments, and returns
-#' a new function that includes the additional arguments when calling the
-#' original metric function.
-#'
-#' This is the expected way to pass additional
-#' arguments to a metric when evaluating a forecast using [score()]:
-#' To evaluate a forecast using a metric with an additional argument, you need
-#' to create a custom version of the scoring function with the argument
-#' included. You then need to create an updated version of the list of scoring
-#' functions that includes your customised metric and pass this to [score()].
-#'
-#' @param metric The metric function to be customised.
-#' @param ... Additional arguments to be included when calling the metric
-#'   function.
-#'
-#' @return A customised metric function.
-#' @keywords metric
-#'
-#' @export
-#' @examples
-#' # Create a customised metric function
-#' custom_metric <- customise_metric(mean, na.rm = TRUE)
-#'
-#' # Use the customised metric function
-#' values <- c(1, 2, NA, 4, 5)
-#' custom_metric(values)
-#'
-#' # Updating metrics list to calculate 70% coverage in `score()`
-#' interval_coverage_70 <- customise_metric(
-#'   interval_coverage, interval_range = 70
-#' )
-#' updated_metrics <- c(
-#'   metrics_quantile(),
-#'   "interval_coverage_70" = interval_coverage_70
-#' )
-#'
-#' library(magrittr) # pipe operator
-#'
-#' example_quantile %>%
-#'   as_forecast_quantile() %>%
-#'   score(metrics = updated_metrics)
-customise_metric <- function(metric, ...) {
-  assert_function(metric)
-  dots <- list(...)
-  customised_metric <- function(...) {
-    do.call(metric, c(list(...), dots))
-  }
-  return(customised_metric)
-}
-
-
-#' @rdname customise_metric
-#' @keywords metric
-#' @export
-customize_metric <- customise_metric
-
 
 #' @title Default metrics and scoring rules for binary forecasts
 #' @description
@@ -209,14 +150,14 @@ metrics_sample <- function(select = NULL, exclude = NULL) {
 #' - "dispersion" = [dispersion_quantile()]
 #' - "bias" = [bias_quantile()]
 #' - "interval_coverage_50" = [interval_coverage()]
-#' - "interval_coverage_90" = customise_metric(
+#' - "interval_coverage_90" = purrr::partial(
 #'      interval_coverage, interval_range = 90
 #'    )
 #' - "interval_coverage_deviation" = [interval_coverage_deviation()],
 #' - "ae_median" = [ae_median_quantile()]
 #'
 #' Note: The `interval_coverage_90` scoring rule is created by modifying
-#' [interval_coverage()], making use of the function [customise_metric()].
+#' [interval_coverage()], making use of the function [purrr::partial()].
 #' This construct allows the function to deal with arbitrary arguments in `...`,
 #' while making sure that only those that [interval_coverage()] can
 #' accept get passed on to it. `interval_range = 90` is set in the function
@@ -226,6 +167,7 @@ metrics_sample <- function(select = NULL, exclude = NULL) {
 #' @inheritSection illustration-input-metric-quantile Input format
 #' @inherit select_metrics params return
 #' @export
+#' @importFrom purrr partial
 #' @keywords metric
 #' @examples
 #' metrics_quantile()
@@ -238,7 +180,7 @@ metrics_quantile <- function(select = NULL, exclude = NULL) {
     dispersion = dispersion_quantile,
     bias = bias_quantile,
     interval_coverage_50 = interval_coverage,
-    interval_coverage_90 = customise_metric(
+    interval_coverage_90 = purrr::partial(
       interval_coverage, interval_range = 90
     ),
     interval_coverage_deviation = interval_coverage_deviation,

R/score.R

@@ -4,8 +4,9 @@
 #' `score()` is a generic that dispatches to different methods depending on the
 #' class of the input data.
 #'
-#' See the details section for more information on forecast types and input
-#' formats. For additional help and examples, check out the [Getting Started
+#' See the *Forecast types and input formats* section for more information on
+#' forecast types and input formats.
+#' For additional help and examples, check out the [Getting Started
 #' Vignette](https://epiforecasts.io/scoringutils/articles/scoringutils.html) as
 #' well as the paper [Evaluating Forecasts with scoringutils in
 #' R](https://arxiv.org/abs/2205.07090).
@@ -16,13 +17,36 @@
 #' @param metrics A named list of scoring functions. Names will be used as
 #'   column names in the output. See [metrics_point()], [metrics_binary()],
 #'   [metrics_quantile()], and [metrics_sample()] for more information on the
-#'   default metrics used. Note that if you want to pass arguments to any
-#'   given metric, you should do that through the function [customise_metric()]
-#'   and pass an updated list of functions with your custom metric to
-#'   the `metrics` argument in `score()`.
-#' @param ... Additional arguments. Currently unused but allows for future
-#'  extensions. If you want to pass arguments to individual metrics, use
-#'  [customise_metric()].
+#'   default metrics used. See the *Customising metrics* section below for
+#'   information on how to pass custom arguments to scoring functions.
+#' @param ... Currently unused. You *cannot* pass additional arguments to scoring
+#'   functions via `...`. See the *Customising metrics* section below for
+#'   details on how to use [purrr::partial()] to pass arguments to individual
+#'   metrics.
+#' @details
+#' **Customising metrics**
+#'
+#' If you want to pass arguments to a scoring function, you need change the
+#' scoring function itself via e.g. [purrr::partial()] and pass an updated list
+#' of functions with your custom metric to the `metrics` argument in `score()`.
+#' For example, to use [interval_coverage()] with `interval_range = 90`, you
+#' would define a new function, e.g.
+#' `interval_coverage_90 <- purrr::partial(interval_coverage, interval_range = 90)`
+#' and pass this new function to `metrics` in `score()`.
+#'
+#' Note that if you want to pass a variable as an argument, you can
+#' unquote it with `!!` to make sure the value is evaluated only once when the
+#' function is created. Consider the following example:
+#' ```
+#' custom_arg <- "foo"
+#' print1 <- purrr::partial(print, x = custom_arg)
+#' print2 <- purrr::partial(print, x = !!custom_arg)
+#'
+#' custom_arg <- "bar"
+#' print1() # prints 'bar'
+#' print2() # prints 'foo'
+#' ```
+#'
 #' @return
 #' An object of class `scores`. This object is a data.table with
 #' unsummarised scores (one score per forecast) and has an additional attribute
@@ -211,7 +235,7 @@ score.forecast_quantile <- function(forecast, metrics = metrics_quantile(), ...)
 #' @param ... Additional arguments to be passed to the scoring rules. Note that
 #'   this is currently not used, as all calls to `apply_scores` currently
 #'   avoid passing arguments via `...` and instead expect that the metrics
-#'   directly be modified using [customise_metric()].
+#'   directly be modified using [purrr::partial()].
 #' @inheritParams score
 #' @return A data table with the forecasts and the calculated metrics.
 #' @keywords internal