From 9e7e62507b5ce301989fe7fa3a6044481846bc09 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sat, 18 Nov 2023 18:13:00 +0100 Subject: [PATCH 1/3] Add documentation and tests for apply_metrics --- R/score.R | 10 +++++++++ man/apply_metrics.Rd | 29 ++++++++++++++++++++++++++ tests/testthat/test-score.R | 41 +++++++++++++++++++++++++------------ 3 files changed, 67 insertions(+), 13 deletions(-) create mode 100644 man/apply_metrics.Rd diff --git a/R/score.R b/R/score.R index 6c1298d90..de09e7912 100644 --- a/R/score.R +++ b/R/score.R @@ -193,6 +193,16 @@ score.forecast_quantile <- function(data, metrics = metrics_quantile, ...) { return(data[]) } + +#' Helper Function To Apply a List Of Functions To a Data Table of Forecasts +#' @description The function applies a list of functions to a data table of +#' forecasts. The function is used within `score()` to apply all +#' scoring rules to the data. +#' Function calls are wrapped in `run_safely()` to catch errors and to make +#' sure that only arguments are passed to the function that are actually +#' accepted by the function. +#' @inheritParams score +#' @return A data table with the forecasts and the calculated metrics apply_metrics <- function(data, metrics, ...) { expr <- expression( data[, (metric_name) := do.call(run_safely, list(..., fun = fun))] diff --git a/man/apply_metrics.Rd b/man/apply_metrics.Rd new file mode 100644 index 000000000..affaaab99 --- /dev/null +++ b/man/apply_metrics.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/score.R +\name{apply_metrics} +\alias{apply_metrics} +\title{Helper Function To Apply a List Of Functions To a Data Table of Forecasts} +\usage{ +apply_metrics(data, metrics, ...) +} +\arguments{ +\item{data}{A data.frame or data.table with predicted and observed values.} + +\item{metrics}{A named list of scoring functions. Names will be used as +column names in the output. See \code{\link[=metrics_point]{metrics_point()}}, \code{\link[=metrics_binary]{metrics_binary()}}, +\code{metrics_quantile()}, and \code{\link[=metrics_sample]{metrics_sample()}} for more information on the +default metrics used.} + +\item{...}{additional arguments} +} +\value{ +A data table with the forecasts and the calculated metrics +} +\description{ +The function applies a list of functions to a data table of +forecasts. The function is used within \code{score()} to apply all +scoring rules to the data. +Function calls are wrapped in \code{run_safely()} to catch errors and to make +sure that only arguments are passed to the function that are actually +accepted by the function. +} diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R index 29132de21..91a62be0b 100644 --- a/tests/testthat/test-score.R +++ b/tests/testthat/test-score.R @@ -277,16 +277,31 @@ test_that("function throws an error if data is missing", { expect_error(suppressMessages(score(data = NULL))) }) -# test_that( -# "score() can support a sample column when a quantile forecast is used", { -# ex <- example_quantile[!is.na(quantile)][1:200, ] -# ex <- rbind( -# data.table::copy(ex)[, sample_id := 1], -# ex[, sample_id := 2] -# ) -# scores <- suppressWarnings(score(ex)) -# expect_snapshot(summarise_scores( -# summarise_scores(scores, by = "model"), by = "model", -# fun = signif, digits = 2 -# )) -# }) +# ============================================================================= +# `apply_metrics()` +# ============================================================================= + +test_that("apply_metrics() works", { + + dt <- data.table::data.table(x = 1:10) + scoringutils:::apply_metrics( + data = dt, metrics = list("test" = function(x) x + 1), + dt$x + ) + expect_equal(dt$test, 2:11) + + # additional named argument works + expect_no_condition( + scoringutils:::apply_metrics( + data = dt, metrics = list("test" = function(x) x + 1), + dt$x, y = dt$test) + ) + + # additional unnamed argument does not work + + expect_warning( + scoringutils:::apply_metrics( + data = dt, metrics = list("test" = function(x) x + 1), + dt$x, dt$test) + ) +}) From 29cbbfb07c051187f92d5bb041298966662271f2 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 20 Nov 2023 13:48:09 +0100 Subject: [PATCH 2/3] Make documentation for `apply_metrics` more consistent --- R/score.R | 14 +++++++------- man/apply_metrics.Rd | 14 +++++++------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/score.R b/R/score.R index de09e7912..d1e28b411 100644 --- a/R/score.R +++ b/R/score.R @@ -194,13 +194,13 @@ score.forecast_quantile <- function(data, metrics = metrics_quantile, ...) { } -#' Helper Function To Apply a List Of Functions To a Data Table of Forecasts -#' @description The function applies a list of functions to a data table of -#' forecasts. The function is used within `score()` to apply all -#' scoring rules to the data. -#' Function calls are wrapped in `run_safely()` to catch errors and to make -#' sure that only arguments are passed to the function that are actually -#' accepted by the function. +#' @title Apply A List Of Functions To A Data Table Of Forecasts +#' @description This helper function applies scoring rules (stored as a list of +#' functions) to a data table of. `apply_metrics` is used within `score()` to +#' apply all scoring rules to the data. +#' Scoring rules are wrapped in [run_safely()] to catch errors and to make +#' sure that only arguments are passed to the scoring rule that are actually +#' accepted by it. #' @inheritParams score #' @return A data table with the forecasts and the calculated metrics apply_metrics <- function(data, metrics, ...) { diff --git a/man/apply_metrics.Rd b/man/apply_metrics.Rd index affaaab99..4586b40b9 100644 --- a/man/apply_metrics.Rd +++ b/man/apply_metrics.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/score.R \name{apply_metrics} \alias{apply_metrics} -\title{Helper Function To Apply a List Of Functions To a Data Table of Forecasts} +\title{Apply A List Of Functions To A Data Table Of Forecasts} \usage{ apply_metrics(data, metrics, ...) } @@ -20,10 +20,10 @@ default metrics used.} A data table with the forecasts and the calculated metrics } \description{ -The function applies a list of functions to a data table of -forecasts. The function is used within \code{score()} to apply all -scoring rules to the data. -Function calls are wrapped in \code{run_safely()} to catch errors and to make -sure that only arguments are passed to the function that are actually -accepted by the function. +This helper function applies scoring rules (stored as a list of +functions) to a data table of. \code{apply_metrics} is used within \code{score()} to +apply all scoring rules to the data. +Scoring rules are wrapped in \code{\link[=run_safely]{run_safely()}} to catch errors and to make +sure that only arguments are passed to the scoring rule that are actually +accepted by it. } From f01c73e64c6b418f976f3d113361e8cea5748b15 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Tue, 19 Dec 2023 18:37:40 +0100 Subject: [PATCH 3/3] Rename `apply_metrics()` to `apply_rules()` --- R/score.R | 15 ++++++++------- man/{apply_metrics.Rd => apply_rules.Rd} | 11 ++++++----- tests/testthat/test-score.R | 10 +++++----- 3 files changed, 19 insertions(+), 17 deletions(-) rename man/{apply_metrics.Rd => apply_rules.Rd} (81%) diff --git a/R/score.R b/R/score.R index d1e28b411..5ca049fa7 100644 --- a/R/score.R +++ b/R/score.R @@ -81,7 +81,7 @@ score.forecast_binary <- function(data, metrics = metrics_binary, ...) { data <- remove_na_observed_predicted(data) metrics <- validate_metrics(metrics) - data <- apply_metrics( + data <- apply_rules( data, metrics, data$observed, data$predicted, ... ) @@ -101,7 +101,7 @@ score.forecast_point <- function(data, metrics = metrics_point, ...) { data <- remove_na_observed_predicted(data) metrics <- validate_metrics(metrics) - data <- apply_metrics( + data <- apply_rules( data, metrics, data$observed, data$predicted, ... ) @@ -135,7 +135,7 @@ score.forecast_sample <- function(data, metrics = metrics_sample, ...) { predicted <- do.call(rbind, data$predicted) data[, c("observed", "predicted", "scoringutils_N") := NULL] - data <- apply_metrics( + data <- apply_rules( data, metrics, observed, predicted, ... ) @@ -180,7 +180,7 @@ score.forecast_quantile <- function(data, metrics = metrics_quantile, ...) { "observed", "predicted", "quantile", "scoringutils_quantile" ) := NULL] - data <- apply_metrics( + data <- apply_rules( data, metrics, observed, predicted, quantile, ... ) @@ -196,14 +196,15 @@ score.forecast_quantile <- function(data, metrics = metrics_quantile, ...) { #' @title Apply A List Of Functions To A Data Table Of Forecasts #' @description This helper function applies scoring rules (stored as a list of -#' functions) to a data table of. `apply_metrics` is used within `score()` to -#' apply all scoring rules to the data. +#' functions) to a data table of forecasts. `apply_rules` is used within +#' `score()` to apply all scoring rules to the data. #' Scoring rules are wrapped in [run_safely()] to catch errors and to make #' sure that only arguments are passed to the scoring rule that are actually #' accepted by it. #' @inheritParams score #' @return A data table with the forecasts and the calculated metrics -apply_metrics <- function(data, metrics, ...) { +#' @keywords internal +apply_rules <- function(data, metrics, ...) { expr <- expression( data[, (metric_name) := do.call(run_safely, list(..., fun = fun))] ) diff --git a/man/apply_metrics.Rd b/man/apply_rules.Rd similarity index 81% rename from man/apply_metrics.Rd rename to man/apply_rules.Rd index 4586b40b9..f64ba562f 100644 --- a/man/apply_metrics.Rd +++ b/man/apply_rules.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/score.R -\name{apply_metrics} -\alias{apply_metrics} +\name{apply_rules} +\alias{apply_rules} \title{Apply A List Of Functions To A Data Table Of Forecasts} \usage{ -apply_metrics(data, metrics, ...) +apply_rules(data, metrics, ...) } \arguments{ \item{data}{A data.frame or data.table with predicted and observed values.} @@ -21,9 +21,10 @@ A data table with the forecasts and the calculated metrics } \description{ This helper function applies scoring rules (stored as a list of -functions) to a data table of. \code{apply_metrics} is used within \code{score()} to -apply all scoring rules to the data. +functions) to a data table of forecasts. \code{apply_rules} is used within +\code{score()} to apply all scoring rules to the data. Scoring rules are wrapped in \code{\link[=run_safely]{run_safely()}} to catch errors and to make sure that only arguments are passed to the scoring rule that are actually accepted by it. } +\keyword{internal} diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R index 91a62be0b..ac6249528 100644 --- a/tests/testthat/test-score.R +++ b/tests/testthat/test-score.R @@ -278,13 +278,13 @@ test_that("function throws an error if data is missing", { }) # ============================================================================= -# `apply_metrics()` +# `apply_rules()` # ============================================================================= -test_that("apply_metrics() works", { +test_that("apply_rules() works", { dt <- data.table::data.table(x = 1:10) - scoringutils:::apply_metrics( + scoringutils:::apply_rules( data = dt, metrics = list("test" = function(x) x + 1), dt$x ) @@ -292,7 +292,7 @@ test_that("apply_metrics() works", { # additional named argument works expect_no_condition( - scoringutils:::apply_metrics( + scoringutils:::apply_rules( data = dt, metrics = list("test" = function(x) x + 1), dt$x, y = dt$test) ) @@ -300,7 +300,7 @@ test_that("apply_metrics() works", { # additional unnamed argument does not work expect_warning( - scoringutils:::apply_metrics( + scoringutils:::apply_rules( data = dt, metrics = list("test" = function(x) x + 1), dt$x, dt$test) )