From c3611fc92b2d075b63cadce16aada51ffd31d50b Mon Sep 17 00:00:00 2001
From: nikosbosse <nikosbosse@gmail.com>
Date: Mon, 22 Apr 2024 10:11:37 +0200
Subject: [PATCH 1/4] add additional tests to `score()`

---
 tests/testthat/test-score.R | 43 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R
index a51ffc2a..908c2f54 100644
--- a/tests/testthat/test-score.R
+++ b/tests/testthat/test-score.R
@@ -241,8 +241,30 @@ test_that("score.forecast_quantile() errors with only NA values", {
   )
 })
 
+test_that("score.forecast_quantile() works as expected in edge cases", {
+  # only the median
+  onlymedian <- example_quantile[quantile_level == 0.5] %>%
+    as_forecast()
+  expect_no_condition(
+    s <- score(onlymedian, metrics = metrics_quantile(
+      exclude = c("interval_coverage_50", "interval_coverage_90")
+    ))
+  )
+  expect_equal(
+    s$wis, abs(onlymedian$observed - onlymedian$predicted)
+  )
 
-
+  # only one symmetric interval is present
+  oneinterval <- example_quantile[quantile_level %in% c(0.25,0.75)] %>%
+    as_forecast()
+  expect_message(
+    s <- score(
+      oneinterval,
+      metrics = metrics_quantile(exclude = c("interval_coverage_90", "ae_median"))
+    ),
+    "Median not available"
+  )
+})
 
 
 # test integer and continuous case ---------------------------------------------
@@ -271,6 +293,25 @@ test_that("function throws an error if data is missing", {
   expect_error(suppressMessages(score(forecast = NULL)))
 })
 
+test_that("score() works with only one sample", {
+
+  # with only one sample, dss returns NaN and log_score fails
+  onesample <- na.omit(example_sample_continuous)[sample_id == 20] %>%
+    as_forecast()
+  expect_warning(
+    expect_warning(
+      scoreonesample <- score(onesample),
+      "Function execution failed, returning NULL. Error: need at least 2 data points." #dss
+    ),
+    "Column 'log_score' does not exist to remove" #log_score
+  )
+
+  # verify that all goes well with two samples
+  twosample <- na.omit(example_sample_continuous)[sample_id %in% c(20, 21)] %>%
+    as_forecast()
+  expect_no_condition(score(twosample))
+})
+
 # =============================================================================
 # `apply_metrics()`
 # =============================================================================

From ed90dd903795c94f16d8286e1e4f607477e308df Mon Sep 17 00:00:00 2001
From: nikosbosse <nikosbosse@gmail.com>
Date: Sun, 5 May 2024 13:32:50 +0200
Subject: [PATCH 2/4] add more tests

---
 R/correlations.R                            |  2 +-
 tests/testthat/test-convenience-functions.R | 45 +++++++----
 tests/testthat/test-customise_metric.R      | 55 -------------
 tests/testthat/test-default-scoring-rules.R | 79 ++++++++++++++++++-
 tests/testthat/test-forecast.R              | 34 ++++-----
 tests/testthat/test-get_-functions.R        | 85 +++++++++++++++------
 tests/testthat/test-get_correlations.R      | 19 ++++-
 tests/testthat/test-pairwise_comparison.R   | 13 ++++
 tests/testthat/test-pit.R                   |  8 +-
 tests/testthat/test-score.R                 | 33 ++++++--
 tests/testthat/test-summarise_scores.R      | 18 ++++-
 11 files changed, 261 insertions(+), 130 deletions(-)

diff --git a/R/correlations.R b/R/correlations.R
index 387ffaa9..6f6cbed8 100644
--- a/R/correlations.R
+++ b/R/correlations.R
@@ -48,7 +48,7 @@ get_correlations <- function(scores,
   return(correlations[])
 }
 
-# define function to obtain upper triangle of matrix
+# helper function to obtain upper triangle of matrix
 get_lower_tri <- function(cormat) {
   cormat[lower.tri(cormat)] <- NA
   return(cormat)
diff --git a/tests/testthat/test-convenience-functions.R b/tests/testthat/test-convenience-functions.R
index 3060e09f..81317c1a 100644
--- a/tests/testthat/test-convenience-functions.R
+++ b/tests/testthat/test-convenience-functions.R
@@ -1,3 +1,7 @@
+# ============================================================================ #
+# `transform_forecasts()`
+# ============================================================================ #
+
 test_that("function transform_forecasts works", {
   predictions_original <- example_quantile$predicted
   predictions <- example_quantile %>%
@@ -59,6 +63,11 @@ test_that("transform_forecasts() outputs an object of class forecast_*", {
   expect_s3_class(transformed, "forecast_binary")
 })
 
+
+# ============================================================================ #
+# `log_shift()`
+# ============================================================================ #
+
 test_that("log_shift() works as expected", {
   expect_equal(log_shift(1:10, 1), log(1:10 + 1))
 
@@ -76,6 +85,15 @@ test_that("log_shift() works as expected", {
 
   # test that it does not accept a complex number
   expect_error(log_shift(1:10, offset = 1, base = 1i))
+
+  # test that it does not accept a negative base
+  expect_error(
+    log_shift(1:10, offset = 1, base = -1),
+    "Assertion on 'base' failed: Element 1 is not >= 0."
+  )
+
+  # test output class is numeric as expected
+  checkmate::expect_class(log_shift(1:10, 1), "numeric")
 })
 
 
@@ -109,11 +127,17 @@ test_that("set_forecast_unit() works on input that's not a data.table", {
     colnames(set_forecast_unit(df, c("a", "b"))),
     c("a", "b")
   )
-  # apparently it also works on a matrix... good to know :)
+
   expect_equal(
     names(set_forecast_unit(as.matrix(df), "a")),
     "a"
   )
+
+  expect_s3_class(
+    set_forecast_unit(df, c("a", "b")),
+    c("data.table", "data.frame"),
+    exact = TRUE
+  )
 })
 
 test_that("set_forecast_unit() revalidates a forecast object", {
@@ -145,20 +169,11 @@ test_that("function get_forecast_unit() and set_forecast_unit() work together",
   expect_equal(fu_set, fu_get)
 })
 
-
-test_that("set_forecast_unit() works on input that's not a data.table", {
-  df <- data.frame(
-    a = 1:2,
-    b = 2:3,
-    c = 3:4
-  )
-  expect_equal(
-    colnames(set_forecast_unit(df, c("a", "b"))),
-    c("a", "b")
-  )
-  # apparently it also works on a matrix... good to know :)
+test_that("output class of set_forecast_unit() is as expected", {
+  ex <- as_forecast(na.omit(example_binary))
   expect_equal(
-    names(set_forecast_unit(as.matrix(df), "a")),
-    "a"
+    class(ex),
+    class(set_forecast_unit(ex, c("location", "target_end_date", "target_type", "horizon", "model")))
   )
 })
+
diff --git a/tests/testthat/test-customise_metric.R b/tests/testthat/test-customise_metric.R
index 0b9efad9..e69de29b 100644
--- a/tests/testthat/test-customise_metric.R
+++ b/tests/testthat/test-customise_metric.R
@@ -1,55 +0,0 @@
-test_that("customise_metric works correctly", {
-  # 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)
-  expect_equal(custom_metric(values), 3)
-
-  # Test with a different metric function
-  custom_metric <- customise_metric(sum, na.rm = TRUE)
-  expect_equal(custom_metric(values), 12)
-
-  # Test with no additional arguments
-  custom_metric <- customise_metric(mean)
-  expect_true(is.na(custom_metric(values)))
-
-  # make sure that customise_metric fails immediately (instead of at runtime)
-  # when object doesn't exist
-  expect_error(
-    custom_metric <- customise_metric(print, x = doesnotexist),
-    "object 'doesnotexist' not found"
-  )
-
-  # make sure that customise_metric still works even if original object is
-  # deleted, meaning that the object is stored as part of the function
-  argument <- c("hi", "hello", "I'm here")
-  custom_metric <- customise_metric(print, x = argument)
-  expect_output(custom_metric(), "I'm here")
-
-  argument <- NULL
-  expect_output(custom_metric(), "I'm here")
-
-  # make sure that all of this still works even if argument is called "dots"
-  # which is used internally
-  dots <- "test"
-  expect_output(
-    # dots argument should be ignored and output should stay the same
-    expect_equal(custom_metric(dots = dots), c("hi", "hello", "I'm here")),
-    "I'm here"
-  )
-})
-
-
-
-test_that("customise_metric handles errors correctly", {
-  # Test with a non-function metric
-  expect_error(
-    customise_metric("not_a_function", na.rm = TRUE),
-    "Must be a function, not 'character'"
-  )
-})
-
-test_that("customise_metric is exported", {
-  expect_equal(customise_metric, customise_metric)
-})
diff --git a/tests/testthat/test-default-scoring-rules.R b/tests/testthat/test-default-scoring-rules.R
index 0ad5cc0d..3495731a 100644
--- a/tests/testthat/test-default-scoring-rules.R
+++ b/tests/testthat/test-default-scoring-rules.R
@@ -1,3 +1,7 @@
+# ==============================================================================
+# select_metrics()
+# ==============================================================================
+
 test_that("`select_metrics` works as expected", {
 
   expect_equal(
@@ -31,9 +35,83 @@ test_that("`select_metrics` works as expected", {
     scoringutils:::select_metrics(metrics_point, select = NULL),
     "Assertion on 'metrics' failed: Must be of type 'list', not 'closure'."
   )
+
+  expect_type(
+    scoringutils:::select_metrics(metrics_point(), select = NULL),
+    "list"
+  )
 })
 
 
+# ==============================================================================
+# customise_metric()
+# ==============================================================================
+
+test_that("customise_metric handles errors correctly", {
+  # Test with a non-function metric
+  expect_error(
+    customise_metric("not_a_function", na.rm = TRUE),
+    "Must be a function, not 'character'"
+  )
+})
+
+test_that("customize_metric is exported", {
+  expect_equal(customise_metric, customize_metric)
+})
+
+
+test_that("customise_metric works correctly", {
+  # 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)
+  expect_equal(custom_metric(values), 3)
+
+  # Test with a different metric function
+  custom_metric <- customise_metric(sum, na.rm = TRUE)
+  expect_equal(custom_metric(values), 12)
+
+  # Test with no additional arguments
+  custom_metric <- customise_metric(mean)
+  expect_true(is.na(custom_metric(values)))
+
+  # make sure that customise_metric fails immediately (instead of at runtime)
+  # when object doesn't exist
+  expect_error(
+    custom_metric <- customise_metric(print, x = doesnotexist),
+    "object 'doesnotexist' not found"
+  )
+
+  # make sure that customise_metric still works even if original object is
+  # deleted, meaning that the object is stored as part of the function
+  argument <- c("hi", "hello", "I'm here")
+  custom_metric <- customise_metric(print, x = argument)
+  expect_output(custom_metric(), "I'm here")
+
+  argument <- NULL
+  expect_output(custom_metric(), "I'm here")
+
+  # make sure that all of this still works even if argument is called "dots"
+  # which is used internally
+  dots <- "test"
+  expect_output(
+    # dots argument should be ignored and output should stay the same
+    expect_equal(custom_metric(dots = dots), c("hi", "hello", "I'm here")),
+    "I'm here"
+  )
+})
+
+test_that("customise_metric() has the expected output class", {
+  custom_metric <- customise_metric(mean, na.rm = TRUE)
+  checkmate::expect_class(custom_metric, "function")
+})
+
+
+# ==============================================================================
+# default scoring rules
+# ==============================================================================
+
 test_that("default rules work as expected", {
 
   expect_true(
@@ -73,4 +151,3 @@ test_that("default rules work as expected", {
     "Must be a subset of"
   )
 })
-
diff --git a/tests/testthat/test-forecast.R b/tests/testthat/test-forecast.R
index aa7207cf..c6128ebe 100644
--- a/tests/testthat/test-forecast.R
+++ b/tests/testthat/test-forecast.R
@@ -1,3 +1,7 @@
+# ==============================================================================
+# as_forecast()
+# ==============================================================================
+
 test_that("Running `as_forecast()` twice returns the same object", {
   ex <- na.omit(example_sample_continuous)
 
@@ -9,7 +13,11 @@ test_that("Running `as_forecast()` twice returns the same object", {
 
 test_that("as_forecast() works as expected", {
   test <- na.omit(data.table::copy(example_quantile))
-  expect_s3_class(as_forecast(test), "forecast_quantile")
+
+  expect_s3_class(
+    as_forecast(test),
+    c("forecast_quantile", "data.table", "data.frame"),
+    exact = TRUE)
 
   # expect error when arguments are not correct
   expect_error(as_forecast(test, observed = 3), "Must be of type 'character'")
@@ -108,25 +116,6 @@ test_that("check_duplicates() works", {
   )
 })
 
-# test_that("as_forecast() function returns a message with NA in the data", {
-#   expect_message(
-#     { check <- as_forecast(example_quantile) },
-#     "\\d+ values for `predicted` are NA"
-#   )
-#   expect_match(
-#     unlist(check$messages),
-#     "\\d+ values for `predicted` are NA"
-#   )
-# })
-
-# test_that("as_forecast() function returns messages with NA in the data", {
-#   example <- data.table::copy(example_quantile)
-#   example[horizon == 2, observed := NA]
-#   check <- suppressMessages(as_forecast(example))
-#
-#   expect_equal(length(check$messages), 2)
-# })
-
 test_that("as_forecast() function throws an error with duplicate forecasts", {
   example <- rbind(example_quantile,
                    example_quantile[1000:1010])
@@ -283,4 +272,9 @@ test_that("validate_forecast() works as expected", {
     out <- validate_forecast(as_forecast(na.omit(example_point)))
   )
   expect_true(!is.null(out))
+
+  expect_equal(
+    validate_forecast(as_forecast(na.omit(example_point))),
+    as_forecast(na.omit(example_point))
+  )
 })
diff --git a/tests/testthat/test-get_-functions.R b/tests/testthat/test-get_-functions.R
index 3eb62f6d..e9310b2a 100644
--- a/tests/testthat/test-get_-functions.R
+++ b/tests/testthat/test-get_-functions.R
@@ -1,3 +1,43 @@
+# ==============================================================================
+# `get_forecast_type`
+# ==============================================================================
+test_that("get_forecast_type() works as expected", {
+  expect_equal(get_forecast_type(as.data.frame(example_quantile)), "quantile")
+  expect_equal(get_forecast_type(example_sample_continuous), "sample")
+  expect_equal(get_forecast_type(example_sample_discrete), "sample")
+  expect_equal(get_forecast_type(example_binary), "binary")
+  expect_equal(get_forecast_type(example_point), "point")
+
+  expect_error(
+    get_forecast_type(data.frame(x = 1:10)),
+    "Assertion on 'data' failed: Columns 'observed', 'predicted' not found in data.",
+    fixed = TRUE
+  )
+
+  df <- data.frame(observed = 1:10, predicted = factor(1:10), model = "model")
+  expect_error(
+    get_forecast_type(df),
+    "input doesn't satisfy criteria for any forecast type",
+    fixed = TRUE
+  )
+})
+
+
+# ==============================================================================
+# get_metrics()
+# ==============================================================================
+test_that("get_metrics() works as expected", {
+  expect_equal(
+    get_metrics(scores_point),
+    c("ae_point", "se_point", "ape")
+  )
+
+  expect_null(
+    get_metrics(as.data.frame(as.matrix(scores_point)))
+  )
+})
+
+
 # ==============================================================================
 # `get_forecast_unit()`
 # ==============================================================================
@@ -30,9 +70,10 @@ test_that("removing NA rows from data works as expected", {
 
   # test that attributes and classes are retained
   ex <- as_forecast(na.omit(example_sample_discrete))
-  expect_equal(
-    class(na.omit(ex)),
-    c("forecast_sample", "data.table", "data.frame")
+  expect_s3_class(
+    na.omit(ex),
+    c("forecast_sample", "data.table", "data.frame"),
+    exact = TRUE
   )
 
   attributes <- attributes(ex)
@@ -120,7 +161,9 @@ test_that("get_type() handles `NA` values", {
 })
 
 
-# `get_duplicate_forecasts()` ==================================================
+# ==============================================================================
+# get_duplicate_forecasts()
+# ==============================================================================
 test_that("get_duplicate_forecasts() works as expected for quantile", {
   expect_equal(nrow(get_duplicate_forecasts(example_quantile)), 0)
   expect_equal(
@@ -158,28 +201,16 @@ test_that("get_duplicate_forecasts() works as expected for point", {
   )
 })
 
-
-# ==============================================================================
-# `get_forecast_type`
-# ==============================================================================
-test_that("get_forecast_type() works as expected", {
-  expect_equal(get_forecast_type(as.data.frame(example_quantile)), "quantile")
-  expect_equal(get_forecast_type(example_sample_continuous), "sample")
-  expect_equal(get_forecast_type(example_sample_discrete), "sample")
-  expect_equal(get_forecast_type(example_binary), "binary")
-  expect_equal(get_forecast_type(example_point), "point")
-
-  expect_error(
-    get_forecast_type(data.frame(x = 1:10)),
-    "Assertion on 'data' failed: Columns 'observed', 'predicted' not found in data.",
-    fixed = TRUE
+test_that("get_duplicate_forecasts() returns the expected class", {
+  expect_equal(
+    class(get_duplicate_forecasts(example_point)),
+    class(example_point)
   )
 
-  df <- data.frame(observed = 1:10, predicted = factor(1:10), model = "model")
-  expect_error(
-    get_forecast_type(df),
-    "input doesn't satisfy criteria for any forecast type",
-    fixed = TRUE
+  expect_s3_class(
+    get_duplicate_forecasts(as.data.frame(example_point)),
+    c("data.table", "data.frame"),
+    exact = TRUE
   )
 })
 
@@ -204,6 +235,12 @@ test_that("get_coverage() works as expected", {
   )
 
   expect_equal(nrow(cov), nrow(na.omit(example_quantile)))
+
+  expect_s3_class(
+    cov,
+    c("data.table", "data.frame"),
+    exact = TRUE
+  )
 })
 
 test_that("get_coverage() outputs an object of class c('data.table', 'data.frame'", {
diff --git a/tests/testthat/test-get_correlations.R b/tests/testthat/test-get_correlations.R
index 8e77664e..eebba6bd 100644
--- a/tests/testthat/test-get_correlations.R
+++ b/tests/testthat/test-get_correlations.R
@@ -10,11 +10,28 @@ test_that("get_correlations() works as expected", {
     colnames(correlations), c(get_metrics(scores_quantile), "metric")
   )
 
-  # expect no error even if scores are unsummarised
+  # expect no error if scores are unsummarised
   # (meaning that coverage will be a logical vector instead of a numeric)
   expect_no_condition(
     correlations2 <- scores_quantile %>%
       get_correlations(digits = 2)
   )
   expect_equal(correlations, correlations2)
+
+  expect_s3_class(
+    get_correlations(scores_quantile, digits = 2),
+    c("scores", "data.table", "data.frame"),
+    exact = TRUE
+  )
+
+  # passing a data.frame works as long as the metrics attribute is still there
+  expect_no_condition(
+    get_correlations(as.data.frame(scores_quantile), digits = 2)
+  )
+
+  # check we get an error if metrics attribute is missing.
+  expect_error(
+    get_correlations(as.data.frame(as.matrix(scores_quantile))),
+    "Assertion on 'metrics' failed: Must be a subset of"
+  )
 })
diff --git a/tests/testthat/test-pairwise_comparison.R b/tests/testthat/test-pairwise_comparison.R
index 2e806ed0..0058362d 100644
--- a/tests/testthat/test-pairwise_comparison.R
+++ b/tests/testthat/test-pairwise_comparison.R
@@ -253,6 +253,13 @@ test_that("get_pairwise_comparisons() works", {
   )
 
   expect_true(all(colnames %in% colnames(res)))
+
+  # output class is as expected
+  expect_s3_class(res, c("data.table", "data.frame"), exact = TRUE)
+  expect_s3_class(
+    get_pairwise_comparisons(scores_quantile),
+    c("data.table", "data.frame"), exact = TRUE
+  )
 })
 
 
@@ -471,6 +478,12 @@ test_that("add_relative_skill() can compute relative measures", {
   scores_with <- add_relative_skill(
     scores_quantile,
   )
+  expect_s3_class(
+    scores_with,
+    c("scores", "data.table", "data.frame"),
+    exact = TRUE
+  )
+
   scores_with <- summarise_scores(scores_with, by = "model")
 
   expect_equal(
diff --git a/tests/testthat/test-pit.R b/tests/testthat/test-pit.R
index ca5b318b..052a6de3 100644
--- a/tests/testthat/test-pit.R
+++ b/tests/testthat/test-pit.R
@@ -1,5 +1,5 @@
 # ============================================================================ #
-# Test `pit_sample()` function
+# pit_sample()
 # ============================================================================ #
 
 test_that("pit_sample() function throws an error when missing args", {
@@ -29,6 +29,8 @@ test_that("pit_sample() function works for integer observed and predicted", {
     length(output),
     560
   )
+
+  checkmate::expect_class(output, "numeric")
 })
 
 test_that("pit_sample() function works for continuous observed and predicted", {
@@ -62,7 +64,7 @@ test_that("pit_sample() works with a single observvation", {
 
 
 # ============================================================================ #
-# Test `get_pit()` function
+# get_pit()
 # ============================================================================ #
 
 test_that("pit function works for continuous integer and quantile data", {
@@ -77,6 +79,8 @@ test_that("pit function works for continuous integer and quantile data", {
   expect_equal(names(pit_continuous), c("model", "target_type", "pit_value"))
   expect_equal(names(pit_integer), c("model", "location", "pit_value"))
 
+  expect_s3_class(pit_quantile, c("data.table", "data.frame"), exact = TRUE)
+
   # check printing works
   testthat::expect_output(print(pit_quantile))
   testthat::expect_output(print(pit_continuous))
diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R
index 908c2f54..f40f35cc 100644
--- a/tests/testthat/test-score.R
+++ b/tests/testthat/test-score.R
@@ -1,11 +1,12 @@
 # =============================================================================
-# Check creation of objects of class `scores`
+# new_scores()
 # =============================================================================
 
 test_that("new_scores() works", {
-  expect_equal(
-    class(new_scores(data.frame(), metrics = "")),
-    c("scores", "data.table", "data.frame")
+  expect_s3_class(
+    new_scores(data.frame(), metrics = ""),
+    c("scores", "data.table", "data.frame"),
+    exact = TRUE
   )
 
   expect_error(
@@ -36,7 +37,7 @@ test_that("Output of `score()` has the class `scores()`", {
 })
 
 # =============================================================================
-# `score()`
+# score()
 # =============================================================================
 
 # common error handling --------------------------------------------------------
@@ -80,6 +81,8 @@ test_that("function produces output for a binary case", {
   )
 
   expect_true("brier_score" %in% names(eval))
+
+  expect_s3_class(eval, c("scores", "data.table", "data.frame"), exact = TRUE)
 })
 
 test_that("score.forecast_binary() errors with only NA values", {
@@ -132,6 +135,8 @@ test_that("function produces output for a point case", {
     colnames(eval),
     c("model", "target_type", names(metrics_point()))
   )
+
+  expect_s3_class(eval, c("scores", "data.table", "data.frame"), exact = TRUE)
 })
 
 test_that("Changing metrics names works", {
@@ -169,6 +174,8 @@ test_that("score_quantile correctly handles separate results = FALSE", {
     TRUE
   )
   expect_true(all(names(metrics_quantile()) %in% colnames(eval)))
+
+  expect_s3_class(eval, c("scores", "data.table", "data.frame"), exact = TRUE)
 })
 
 
@@ -287,6 +294,8 @@ test_that("function produces output for a continuous format case", {
     nrow(eval),
     887
   )
+
+  expect_s3_class(eval, c("scores", "data.table", "data.frame"), exact = TRUE)
 })
 
 test_that("function throws an error if data is missing", {
@@ -313,7 +322,7 @@ test_that("score() works with only one sample", {
 })
 
 # =============================================================================
-# `apply_metrics()`
+# apply_metrics()
 # =============================================================================
 
 test_that("apply_metrics() works", {
@@ -333,7 +342,6 @@ test_that("apply_metrics() works", {
   )
 
   # additional unnamed argument does not work
-
   expect_warning(
     scoringutils:::apply_metrics(
       forecast = dt, metrics = list("test" = function(x) x + 1),
@@ -348,3 +356,14 @@ test_that("`[` preserves attributes", {
   expect_true("metrics" %in% names(attributes(test)))
   expect_true("metrics" %in% names(attributes(test[1:10])))
 })
+
+
+# =============================================================================
+# validate_scores()
+# =============================================================================
+test_that("validate_scores() works", {
+  expect_no_condition(validate_scores(scores_binary))
+  expect_null(
+    validate_scores(scores_binary),
+  )
+})
diff --git a/tests/testthat/test-summarise_scores.R b/tests/testthat/test-summarise_scores.R
index 0ac0f58f..9d07e9d9 100644
--- a/tests/testthat/test-summarise_scores.R
+++ b/tests/testthat/test-summarise_scores.R
@@ -1,9 +1,20 @@
-test_that("summarise_scores() works without any arguments", {
+test_that("summarise_scores() works as expected with by = forecast unit", {
+  expect_no_condition(
+    summarised_scores <- summarise_scores(scores_quantile)
+  )
+  expect_s3_class(summarised_scores, c("scores", "data.table", "data.frame"), exact = TRUE)
+})
+
+test_that("summarise_scores() works as expected with by = forecast unit", {
+  # the only effect of running summarise_scores with by = forecast unit is
+  # that coverage is now a numeric instead of a boolean
   summarised_scores <- summarise_scores(
     scores_quantile,
     by = get_forecast_unit(scores_quantile)
   )
-  expect_false("quantile" %in% names(summarised_scores))
+
+  expect_equal(dim(summarised_scores), dim(scores_quantile))
+  expect_equal(summarised_scores$wis, scores_quantile$wis)
 
   s2 <- summarise_scores(scores_quantile,
     by = c(
@@ -12,8 +23,7 @@ test_that("summarise_scores() works without any arguments", {
       "horizon"
     )
   )
-
-  expect_equal(nrow(summarised_scores), nrow(s2))
+  expect_equal(dim(summarised_scores), dim(s2))
 })
 
 test_that("summarise_scores() handles wrong by argument well", {

From 12cd1aa8a2d68f099b4be8daf0dfa63ced699d9a Mon Sep 17 00:00:00 2001
From: nikosbosse <nikosbosse@gmail.com>
Date: Sat, 18 May 2024 21:07:46 +0200
Subject: [PATCH 3/4] fix merge

---
 tests/testthat/test-get_-functions.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tests/testthat/test-get_-functions.R b/tests/testthat/test-get_-functions.R
index b9511e35..13780d76 100644
--- a/tests/testthat/test-get_-functions.R
+++ b/tests/testthat/test-get_-functions.R
@@ -204,6 +204,8 @@ test_that("get_duplicate_forecasts() returns the expected class", {
   expect_equal(
     class(get_duplicate_forecasts(example_point)),
     class(example_point)
+  )
+})
 
 test_that("get_duplicate_forecasts() works as expected with a data.frame", {
   duplicates <- get_duplicate_forecasts(

From 2bec0b43f9b2f3ad7480b3a2eb61198ccf81d479 Mon Sep 17 00:00:00 2001
From: nikosbosse <nikosbosse@gmail.com>
Date: Sat, 18 May 2024 21:20:24 +0200
Subject: [PATCH 4/4] update test

---
 tests/testthat/test-score.R | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R
index f40f35cc..d5b81e7b 100644
--- a/tests/testthat/test-score.R
+++ b/tests/testthat/test-score.R
@@ -308,11 +308,8 @@ test_that("score() works with only one sample", {
   onesample <- na.omit(example_sample_continuous)[sample_id == 20] %>%
     as_forecast()
   expect_warning(
-    expect_warning(
-      scoreonesample <- score(onesample),
-      "Function execution failed, returning NULL. Error: need at least 2 data points." #dss
-    ),
-    "Column 'log_score' does not exist to remove" #log_score
+    scoreonesample <- score(onesample),
+    "Computation for `log_score` failed. Error: need at least 2 data points."
   )
 
   # verify that all goes well with two samples