diff --git a/NEWS.md b/NEWS.md index e1ee239eb..8e27298ac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # scoringutils (development version) +- Fixed `as_forecast_()` functions silently creating forecast objects with duplicate column names when asked to rename a column onto a name that already exists in the data (e.g. `predicted = "prob"` while a stale `predicted` column is present). This produced corrupted objects that passed validation and were scored on the wrong column. The constructors now error with a clear message, and `assert_forecast_generic()` rejects data with duplicate column names (#1199). - 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). diff --git a/R/class-forecast.R b/R/class-forecast.R index 6525193f1..a8186d5f9 100644 --- a/R/class-forecast.R +++ b/R/class-forecast.R @@ -7,6 +7,7 @@ #' @param ... Named arguments that are used to rename columns. The names of the #' arguments are the names of the columns that should be renamed. The values #' are the new names. +#' @importFrom cli cli_abort #' @keywords as_forecast as_forecast_generic <- function(data, forecast_unit = NULL, @@ -26,6 +27,24 @@ as_forecast_generic <- function(data, oldnames <- unlist(oldnames[provided]) newnames <- unlist(newnames[provided]) if (!is.null(oldnames) && length(oldnames) > 0) { + # renaming a column onto a name that already exists (and is not itself + # being renamed away) would create duplicate column names + remaining <- setdiff(colnames(data), oldnames) + collides <- newnames %in% remaining + if (any(collides)) { + # sources/targets are used inside the cli glue strings below + sources <- oldnames[collides] # nolint: object_usage_linter. + targets <- newnames[collides] # nolint: object_usage_linter. + cli_abort( + c( + `!` = "Cannot rename {cli::qty(sources)} column{?s} {.val {sources}} + to {.val {targets}}: {?a column/columns} with {?this name/these + names} already exist{?s/} in the data.", + i = "Rename or remove the existing {cli::qty(targets)} + column{?s} first." + ) + ) + } setnames(data, old = oldnames, new = newnames) } @@ -110,6 +129,16 @@ assert_forecast.default <- function( assert_forecast_generic <- function(data, verbose = TRUE) { # check that data is a data.table and that the columns look fine assert_data_table(data, min.rows = 1) + duplicated_cols <- unique(colnames(data)[duplicated(colnames(data))]) + if (length(duplicated_cols) > 0) { + cli_abort( + c( + `!` = "Found duplicate column{?s} in the data: + {.val {duplicated_cols}}.", + i = "Column names must be unique." + ) + ) + } assert_subset(c("observed", "predicted"), colnames(data)) problem <- test_subset(c("sample_id", "quantile_level"), colnames(data)) if (problem) { diff --git a/tests/testthat/test-class-forecast.R b/tests/testthat/test-class-forecast.R index dc6d550ea..c0ab399c1 100644 --- a/tests/testthat/test-class-forecast.R +++ b/tests/testthat/test-class-forecast.R @@ -4,6 +4,66 @@ # see tests for each forecast type for more specific tests. +test_that("as_forecast_generic() errors when renaming onto an existing column", { + # stale `predicted` column alongside the column that should be renamed + dt <- data.table::data.table( + model = "m", + id = 1:2, + observed = factor(c(0, 1)), + predicted = c(0.9, 0.9), + prob = c(0.3, 0.7) + ) + expect_error( + as_forecast_binary(dt, predicted = "prob"), + 'rename column "prob" to "predicted".*already exists' + ) + + # same for other renameable columns, e.g. `quantile_level` + quantile_dt <- data.table::data.table( + model = "m", + target = "t", + observed = 5, + predicted = c(1, 5, 9), + quantile_level = c(0.1, 0.5, 0.9), + q = c(0.1, 0.5, 0.9) + ) + expect_error( + as_forecast_quantile(quantile_dt, quantile_level = "q"), + 'rename column "q" to "quantile_level".*already exists' + ) + + # multiple collisions produce a correctly pluralised message naming all + # source and target columns + multi_dt <- data.table::data.table( + model = "m", + id = 1:2, + observed = 1, + obs = 2, + predicted = 3, + prob = 4 + ) + expect_error( + as_forecast_binary(multi_dt, observed = "obs", predicted = "prob"), + paste0( + 'rename\\s+columns\\s+"obs"\\s+and\\s+"prob"\\s+to\\s+"observed"', + '\\s+and\\s+"predicted".*already\\s+exist\\s+in\\s+the\\s+data' + ) + ) +}) + +test_that("as_forecast_generic() still allows identity renames", { + dt <- data.table::data.table( + model = "m", + id = 1:2, + observed = factor(c(0, 1)), + predicted = c(0.3, 0.7) + ) + expect_no_condition( + as_forecast_binary(dt, observed = "observed", predicted = "predicted") + ) +}) + + # ============================================================================== # is_forecast() # nolint: commented_code_linter # ============================================================================== @@ -39,6 +99,21 @@ test_that("assert_forecast_generic() works as expected with a data.frame", { ) }) +test_that("assert_forecast_generic() errors on duplicate column names", { + dt <- data.table::data.table( + model = "m", + id = 1:2, + observed = factor(c(0, 1)), + predicted = c(0.3, 0.7), + stale = c(0.9, 0.9) + ) + data.table::setnames(dt, "stale", "predicted") + expect_error( + assert_forecast_generic(dt), + "duplicate" + ) +}) + # ============================================================================== # new_forecast() # nolint: commented_code_linter