Get default metrics for sample-based forecasts

For sample-based forecasts, the default scoring rules are:

• "crps" = crps_sample()

• "overprediction" = overprediction_sample()

• "underprediction" = underprediction_sample()

• "dispersion" = dispersion_sample()

• "log_score" = logs_sample()

• "dss" = dss_sample()

• "mad" = mad_sample()

• "bias" = bias_sample()

• "ae_median" = ae_median_sample()

• "se_mean" = se_mean_sample()

Usage

# S3 method for class 'forecast_sample'
get_metrics(x, select = NULL, exclude = NULL, ...)

Arguments

x

A forecast object (a validated data.table with predicted and observed values, see as_forecast_binary()).

select

A character vector of scoring rules to select from the list. If select is NULL (the default), all possible scoring rules are returned.

exclude

A character vector of scoring rules to exclude from the list. If select is not NULL, this argument is ignored.

...

unused

Input format

See also

Other get_metrics functions: get_metrics(), get_metrics.forecast_binary(), get_metrics.forecast_nominal(), get_metrics.forecast_point(), get_metrics.forecast_quantile(), get_metrics.scores()

Examples

get_metrics(example_sample_continuous, exclude = "mad")
#> $bias
#> function (observed, predicted) 
#> {
#>     assert_input_sample(observed, predicted)
#>     prediction_type <- get_type(predicted)
#>     n_pred <- ncol(predicted)
#>     p_x <- rowSums(predicted <= observed)/n_pred
#>     if (prediction_type == "continuous") {
#>         res <- 1 - 2 * p_x
#>         return(res)
#>     }
#>     else {
#>         p_xm1 <- rowSums(predicted <= (observed - 1))/n_pred
#>         res <- 1 - (p_x + p_xm1)
#>         return(res)
#>     }
#> }
#> <bytecode: 0x56416aca23f8>
#> <environment: namespace:scoringutils>
#> 
#> $dss
#> function (observed, predicted, ...) 
#> {
#>     assert_input_sample(observed, predicted)
#>     scoringRules::dss_sample(y = observed, dat = predicted, ...)
#> }
#> <bytecode: 0x564169a51a08>
#> <environment: namespace:scoringutils>
#> 
#> $crps
#> function (observed, predicted, separate_results = FALSE, ...) 
#> {
#>     assert_input_sample(observed, predicted)
#>     crps <- scoringRules::crps_sample(y = observed, dat = predicted, 
#>         ...)
#>     if (separate_results) {
#>         medians <- apply(predicted, 1, median)
#>         dispersion <- scoringRules::crps_sample(y = medians, 
#>             dat = predicted, ...)
#>         overprediction <- rep(0, length(observed))
#>         underprediction <- rep(0, length(observed))
#>         overprediction[observed < medians] <- scoringRules::crps_sample(y = observed[observed < 
#>             medians], dat = predicted[observed < medians, , drop = FALSE], 
#>             ...)
#>         underprediction[observed > medians] <- scoringRules::crps_sample(y = observed[observed > 
#>             medians], dat = predicted[observed > medians, , drop = FALSE], 
#>             ...)
#>         overprediction[overprediction > 0] <- overprediction[overprediction > 
#>             0] - dispersion[overprediction > 0]
#>         underprediction[underprediction > 0] <- underprediction[underprediction > 
#>             0] - dispersion[underprediction > 0]
#>         return(list(crps = crps, dispersion = dispersion, underprediction = underprediction, 
#>             overprediction = overprediction))
#>     }
#>     else {
#>         return(crps)
#>     }
#> }
#> <bytecode: 0x56416c6a3be0>
#> <environment: namespace:scoringutils>
#> 
#> $overprediction
#> function (observed, predicted, ...) 
#> {
#>     crps <- crps_sample(observed, predicted, separate_results = TRUE, 
#>         ...)
#>     return(crps$overprediction)
#> }
#> <bytecode: 0x56416a6d7610>
#> <environment: namespace:scoringutils>
#> 
#> $underprediction
#> function (observed, predicted, ...) 
#> {
#>     crps <- crps_sample(observed, predicted, separate_results = TRUE, 
#>         ...)
#>     return(crps$underprediction)
#> }
#> <bytecode: 0x56416a6d04c8>
#> <environment: namespace:scoringutils>
#> 
#> $dispersion
#> function (observed, predicted, ...) 
#> {
#>     crps <- crps_sample(observed, predicted, separate_results = TRUE, 
#>         ...)
#>     return(crps$dispersion)
#> }
#> <bytecode: 0x56416a6d0ff0>
#> <environment: namespace:scoringutils>
#> 
#> $log_score
#> function (observed, predicted, ...) 
#> {
#>     assert_input_sample(observed, predicted)
#>     scoringRules::logs_sample(y = observed, dat = predicted, 
#>         ...)
#> }
#> <bytecode: 0x56416a6d1b88>
#> <environment: namespace:scoringutils>
#> 
#> $ae_median
#> function (observed, predicted) 
#> {
#>     assert_input_sample(observed, predicted)
#>     median_predictions <- apply(as.matrix(predicted), MARGIN = 1, 
#>         FUN = median)
#>     ae_median <- abs(observed - median_predictions)
#>     return(ae_median)
#> }
#> <bytecode: 0x56416b5a3978>
#> <environment: namespace:scoringutils>
#> 
#> $se_mean
#> function (observed, predicted) 
#> {
#>     assert_input_sample(observed, predicted)
#>     mean_predictions <- rowMeans(as.matrix(predicted))
#>     se_mean <- (observed - mean_predictions)^2
#>     return(se_mean)
#> }
#> <bytecode: 0x56416a6cf728>
#> <environment: namespace:scoringutils>
#>