tests/testthat/test-num-smape.R

In yardstick: Tidy Characterizations of Model Performance

test_that("Symmetric Mean Absolute Percentage Error", {
  ex_dat <- generate_numeric_test_data()
  not_na <- !is.na(ex_dat$pred_na)

  expect_equal(
    smape(ex_dat, truth = "obs", estimate = "pred")[[".estimate"]],
    100 * mean(abs((ex_dat$obs - ex_dat$pred) / ((abs(ex_dat$obs) + abs(ex_dat$pred)) / 2)))
  )
  expect_equal(
    smape(ex_dat, obs, pred_na)[[".estimate"]],
    100 * mean(abs((ex_dat$obs[not_na] - ex_dat$pred[not_na]) / ((abs(ex_dat$obs[not_na]) + abs(ex_dat$pred[not_na])) / 2)))
  )
})

test_that("Weighted results are working", {
  truth <- c(1, 2, 3)
  estimate <- c(2, 4, 3)
  weights <- c(1, 2, 1)

  expect_identical(
    smape_vec(truth, estimate, case_weights = weights),
    50
  )
})