1195: Fix assert_forecast() for nominal and ordinal forecasts

NEWS.md

@@ -1,5 +1,6 @@
 # scoringutils (development version)
 
+- Fixed `assert_forecast()` for nominal and ordinal forecasts: the error message for incomplete forecasts named the first *complete* forecast instead of the first incomplete one (and `NA` when all forecasts were incomplete), and the methods visibly returned the forecast object instead of `invisible(NULL)` as documented and as all other forecast types do (#1195).
 - Added `filter_scores()` and `impute_missing_scores()` for handling missing forecasts before summarisation. `filter_scores()` removes target combinations with insufficient model coverage, while `impute_missing_scores()` fills in missing scores using configurable strategies (worst, mean, NA, or reference model). Both use a strategy function pattern for extensibility. See `vignette("handling-missing-forecasts")` for details (#1122).
 - Added `plot_discrimination()` to visualise the discrimination ability of binary forecasts by plotting the distribution of predicted probabilities, stratified by the observed outcome. The function requires a `forecast_binary` object (created with `as_forecast_binary()`) (#942).
 - Fixed `summarise_scores()` producing a data.table with duplicate column names when the input `scores` object had no score columns (e.g. because every metric in `score()` warned and returned nothing). `summarise_scores()` now matches metric columns by exact name rather than regex partial match, and errors with a clear message when there is nothing to summarise (#1179).

R/class-forecast-nominal.R

@@ -98,7 +98,7 @@ assert_forecast.forecast_nominal <- function(
   ), by = forecast_unit]
 
   if (!all(complete$correct)) {
-    first_issue <- complete[(correct), ..forecast_unit][1]
+    first_issue <- complete[!(correct), ..forecast_unit][1]
     first_issue <- lapply(first_issue, FUN = as.character)
     #nolint start: object_usage_linter duplicate_argument_linter
     issue_location <- paste(names(first_issue), "==", first_issue)
@@ -111,7 +111,7 @@ assert_forecast.forecast_nominal <- function(
     )
     #nolint end
   }
-  return(forecast[])
+  return(invisible(NULL))
 }
 
 

R/class-forecast-ordinal.R

@@ -104,7 +104,7 @@ assert_forecast.forecast_ordinal <- function(
   ), by = forecast_unit]
 
   if (!all(complete$correct)) {
-    first_issue <- complete[(correct), ..forecast_unit][1]
+    first_issue <- complete[!(correct), ..forecast_unit][1]
     first_issue <- lapply(first_issue, FUN = as.character)
     #nolint start: object_usage_linter duplicate_argument_linter
     issue_location <- paste(names(first_issue), "==", first_issue)
@@ -117,7 +117,7 @@ assert_forecast.forecast_ordinal <- function(
     )
     #nolint end
   }
-  return(forecast[])
+  return(invisible(NULL))
 }
 
 

tests/testthat/test-class-forecast-nominal.R

@@ -30,6 +30,44 @@ test_that("as_forecast.forecast_nominal() breaks when rows with zero probability
   )
 })
 
+test_that("assert_forecast.forecast_nominal() names the incomplete forecast in its error message", {
+  # modA is complete, modB is missing the "high" outcome
+  dat <- data.table(
+    model = rep(c("modA", "modB"), times = c(3, 2)),
+    observed = factor("high", levels = c("low", "medium", "high")),
+    predicted_label = factor(
+      c("low", "medium", "high", "low", "medium"),
+      levels = c("low", "medium", "high")
+    ),
+    predicted = c(0.2, 0.3, 0.5, 0.4, 0.6)
+  )
+  expect_warning(
+    expect_error(
+      as_forecast_nominal(dat),
+      "modB"
+    ),
+    "Some forecasts have different numbers of rows"
+  )
+
+  # all forecasts incomplete - the first one should be named, not NA
+  dat_all_incomplete <- data.table(
+    model = c("modA", "modB"),
+    observed = factor("high", levels = c("low", "medium", "high")),
+    predicted_label = factor("low", levels = c("low", "medium", "high")),
+    predicted = c(1, 1)
+  )
+  expect_error(
+    as_forecast_nominal(dat_all_incomplete),
+    "modA"
+  )
+})
+
+test_that("assert_forecast.forecast_nominal() returns invisible(NULL)", {
+  fc <- as_forecast_nominal(na.omit(example_nominal))
+  expect_invisible(assert_forecast(fc))
+  expect_null(assert_forecast(fc))
+})
+
 
 # ==============================================================================
 # is_forecast_nominal() # nolint: commented_code_linter

tests/testthat/test-class-forecast-ordinal.R

@@ -30,6 +30,51 @@ test_that("as_forecast.forecast_ordinal() breaks when rows with zero probability
   )
 })
 
+test_that("assert_forecast.forecast_ordinal() names the incomplete forecast in its error message", {
+  # modA is complete, modB is missing the "high" outcome
+  dat <- data.table(
+    model = rep(c("modA", "modB"), times = c(3, 2)),
+    observed = factor(
+      "high", levels = c("low", "medium", "high"), ordered = TRUE
+    ),
+    predicted_label = factor(
+      c("low", "medium", "high", "low", "medium"),
+      levels = c("low", "medium", "high"),
+      ordered = TRUE
+    ),
+    predicted = c(0.2, 0.3, 0.5, 0.4, 0.6)
+  )
+  expect_warning(
+    expect_error(
+      as_forecast_ordinal(dat),
+      "modB"
+    ),
+    "Some forecasts have different numbers of rows"
+  )
+
+  # all forecasts incomplete - the first one should be named, not NA
+  dat_all_incomplete <- data.table(
+    model = c("modA", "modB"),
+    observed = factor(
+      "high", levels = c("low", "medium", "high"), ordered = TRUE
+    ),
+    predicted_label = factor(
+      "low", levels = c("low", "medium", "high"), ordered = TRUE
+    ),
+    predicted = c(1, 1)
+  )
+  expect_error(
+    as_forecast_ordinal(dat_all_incomplete),
+    "modA"
+  )
+})
+
+test_that("assert_forecast.forecast_ordinal() returns invisible(NULL)", {
+  fc <- as_forecast_ordinal(na.omit(example_ordinal))
+  expect_invisible(assert_forecast(fc))
+  expect_null(assert_forecast(fc))
+})
+
 test_that("assert_forecast.forecast_ordinal() fails if factors are not ordered", {
   ex_faulty <- na.omit(data.table::copy(example_nominal))
   expect_error(