This function converts other error metrics such as MSE
into a skill score.
The reference or benchmark forecasting method is the Naive method for
non-seasonal data, and the seasonal naive method for seasonal data.
When used within accuracy.fbl_ts
, it is important that the data
contains both the training and test data, as the training data is used to
compute the benchmark forecasts.
skill_score(measure)
skill_score(MSE)
#> function (...)
#> {
#> score <- measure(...)
#> bench <- list(...)
#> lag <- bench$.period
#> n <- length(bench$.train)
#> y <- bench$.train
#> bench$.fc <- rep_len(y[c(rep(NA, max(0, lag - n)), seq_len(min(n,
#> lag)) + n - min(n, lag))], length(bench$.fc))
#> bench$.resid <- bench$.actual - bench$.fc
#> e <- y - c(rep(NA, min(lag, n)), y[seq_len(length(y) - lag)])
#> mse <- mean(e^2, na.rm = TRUE)
#> h <- length(bench$.actual)
#> fullperiods <- (h - 1)/lag + 1
#> steps <- rep(seq_len(fullperiods), rep(lag, fullperiods))[seq_len(h)]
#> bench$.dist <- distributional::dist_normal(bench$.fc, sqrt(mse *
#> steps))
#> ref_score <- do.call(measure, bench)
#> 1 - score/ref_score
#> }
#> <bytecode: 0x55d1e3fe0010>
#> <environment: 0x55d1e3fe45f8>
library(fable)
library(tsibble)
lung_deaths <- as_tsibble(cbind(mdeaths, fdeaths))
lung_deaths %>%
dplyr::filter(index < yearmonth("1979 Jan")) %>%
model(
ets = ETS(value ~ error("M") + trend("A") + season("A")),
lm = TSLM(value ~ trend() + season())
) %>%
forecast(h = "1 year") %>%
accuracy(lung_deaths, measures = list(skill = skill_score(MSE)))
#> # A tibble: 4 × 4
#> .model key .type skill
#> <chr> <chr> <chr> <dbl>
#> 1 ets fdeaths Test 0.223
#> 2 ets mdeaths Test 0.446
#> 3 lm fdeaths Test 0.303
#> 4 lm mdeaths Test 0.494