diff --git a/NAMESPACE b/NAMESPACE index e24947703..e1c061d7d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,7 +30,6 @@ export(correlation) export(crps_sample) export(dispersion) export(dss_sample) -export(get_complete_forecasts) export(get_duplicate_forecasts) export(get_forecast_unit) export(interval_coverage_deviation_quantile) diff --git a/R/available_forecasts.R b/R/available_forecasts.R index b5ead907f..515d8666b 100644 --- a/R/available_forecasts.R +++ b/R/available_forecasts.R @@ -40,7 +40,7 @@ available_forecasts <- function(data, data <- validate(data) forecast_unit <- attr(data, "forecast_unit") - data <- get_complete_forecasts(data) + data <- na.omit(data) if (is.null(by)) { by <- forecast_unit diff --git a/R/get_-functions.R b/R/get_-functions.R index b47d5cbb7..459ee9818 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -269,25 +269,3 @@ get_scoringutils_attributes <- function(object) { } return(attr_list) } - - -#' Get Complete Forecasts -#' @description Helper function to remove rows from a data.frame where the -#' value in either one of the columns `predicted` or `observed` is `NA`. -#' @inheritParams score -#' @return A data.table with the same columns as the input, but -#' without rows where either `predicted` or `observed` is `NA`. -#' @export -#' @keywords check-forecasts -get_complete_forecasts <- function(data) { - data <- ensure_data.table(data) - assert(check_columns_present(data, c("observed", "predicted"))) - data <- data[!is.na(observed) & !is.na(predicted)] - if (nrow(data) == 0) { - stop( - "After removing NA values in `observed` and `predicted`, ", - "there were no observations left" - ) - } - return(data[]) -} diff --git a/R/pit.R b/R/pit.R index 959f54e76..8cfca355a 100644 --- a/R/pit.R +++ b/R/pit.R @@ -186,7 +186,7 @@ pit <- function(data, n_replicates = 100) { data <- validate(data) - data <- get_complete_forecasts(data) + data <- na.omit(data) forecast_type <- get_forecast_type(data) if (forecast_type == "quantile") { diff --git a/R/score.R b/R/score.R index 5894a29ca..3785e931b 100644 --- a/R/score.R +++ b/R/score.R @@ -149,7 +149,7 @@ score.default <- function(data, ...) { #' @export score.scoringutils_binary <- function(data, metrics = metrics_binary, ...) { data <- validate(data) - data <- get_complete_forecasts(data) + data <- na.omit(data) metrics <- validate_metrics(metrics) data <- apply_metrics( @@ -169,7 +169,7 @@ score.scoringutils_binary <- function(data, metrics = metrics_binary, ...) { #' @export score.scoringutils_point <- function(data, metrics = metrics_point, ...) { data <- validate(data) - data <- get_complete_forecasts(data) + data <- na.omit(data) metrics <- validate_metrics(metrics) data <- apply_metrics( @@ -186,7 +186,7 @@ score.scoringutils_point <- function(data, metrics = metrics_point, ...) { #' @export score.scoringutils_sample <- function(data, metrics = metrics_sample, ...) { data <- validate(data) - data <- get_complete_forecasts(data) + data <- na.omit(data) forecast_unit <- attr(data, "forecast_unit") metrics <- validate_metrics(metrics) @@ -223,7 +223,7 @@ score.scoringutils_sample <- function(data, metrics = metrics_sample, ...) { #' @export score.scoringutils_quantile <- function(data, metrics = metrics_quantile, ...) { data <- validate(data) - data <- get_complete_forecasts(data) + data <- na.omit(data) forecast_unit <- attr(data, "forecast_unit") metrics <- validate_metrics(metrics) diff --git a/R/validate.R b/R/validate.R index d283f7aa8..671eed16b 100644 --- a/R/validate.R +++ b/R/validate.R @@ -146,6 +146,12 @@ validate_general <- function(data) { setattr(data, "messages", messages) } + if (nrow(na.omit(data)) == 0) { + stop( + "After removing rows with NA values in the data, nothing is left." + ) + } + return(data[]) } diff --git a/man/get_complete_forecasts.Rd b/man/get_complete_forecasts.Rd deleted file mode 100644 index 26ea45cc2..000000000 --- a/man/get_complete_forecasts.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_-functions.R -\name{get_complete_forecasts} -\alias{get_complete_forecasts} -\title{Get Complete Forecasts} -\usage{ -get_complete_forecasts(data) -} -\arguments{ -\item{data}{A data.frame or data.table with predicted and observed values.} -} -\value{ -A data.table with the same columns as the input, but -without rows where either \code{predicted} or \code{observed} is \code{NA}. -} -\description{ -Helper function to remove rows from a data.frame where the -value in either one of the columns \code{predicted} or \code{observed} is \code{NA}. -} -\keyword{check-forecasts} diff --git a/tests/testthat/test-get_-functions.R b/tests/testthat/test-get_-functions.R index 3b704107d..532574a14 100644 --- a/tests/testthat/test-get_-functions.R +++ b/tests/testthat/test-get_-functions.R @@ -29,25 +29,21 @@ fixed = TRUE # ============================================================================== -# `get_complete_forecasts()` +# Test removing `NA` values from the data # ============================================================================== -test_that("get_complete_forecasts() works as expected", { - expect_equal(nrow(get_complete_forecasts(example_quantile)), 20401) +test_that("removing NA rows from data works as expected", { + expect_equal(nrow(na.omit(example_quantile)), 20401) ex <- data.frame(observed = c(NA, 1:3), predicted = 1:4) - expect_equal(nrow(get_complete_forecasts(ex)), 3) + expect_equal(nrow(na.omit(ex)), 3) ex$predicted <- c(1:3, NA) - expect_equal(nrow(get_complete_forecasts(ex)), 2) + expect_equal(nrow(na.omit(ex)), 2) + ex <- data.table::copy(example_quantile)[, "predicted" := NA_real_] expect_error( - get_complete_forecasts(data.frame(x = 1:2, y = 1:2)), - "Assertion on 'data' failed: Columns 'observed', 'predicted' not found in data." - ) - - expect_error( - get_complete_forecasts(data.frame(observed = c(NA, NA), predicted = 1:2)), - "After removing NA values in `observed` and `predicted`, there were no observations left" + validate(ex), + "After removing rows with NA values in the data, nothing is left." ) })