tests/testthat/test-estimate.R

In tune: Tidy Tuning Tools

rcv_results <- readRDS(test_path("data", "rcv_results.rds"))

opt <- getOption("dplyr.summarise.inform", default = "FALSE")
options(dplyr.summarise.inform = FALSE)

compl <-
  unnest(rcv_results, .metrics) |>
  group_by(
    deg_free,
    degree,
    `wt df`,
    `wt degree`,
    .config,
    .metric,
    .estimator
  ) |>
  summarize(
    mean = mean(.estimate, na.rm = TRUE),
    n = sum(!is.na(.estimator)),
    std_err = sd(.estimate, na.rm = TRUE) / sqrt(n)
  ) |>
  ungroup() |>
  arrange(.config)

options(dplyr.summarise.inform = opt)

test_that("estimate method", {
  expect_equal(
    collect_metrics(rcv_results)[, names(compl)] |> arrange(.config),
    compl
  )
})

test_that("estimate method (with apparent resample)", {
  skip_on_cran()
  skip_if_not_installed("kknn")

  library(parsnip)
  library(rsample)
  library(yardstick)

  m_set <- metric_set(rmse)

  res <-
    fit_resamples(
      nearest_neighbor("regression"),
      mpg ~ cyl + hp,
      bootstraps(mtcars, 5, apparent = TRUE),
      metrics = m_set,
      control = control_grid(save_pred = TRUE)
    )

  collected_sum <-
    collect_metrics(res) |>
    select(mean, n, std_err)

  collected_manual <-
    res |>
    dplyr::filter(id != "Apparent") |>
    tidyr::unnest(.metrics) |>
    summarize(
      mean = mean(.estimate),
      n = sum(!is.na(.estimator)),
      std_err = sd(.estimate) / sqrt(n)
    )

  expect_equal(collected_sum, collected_manual)
})