tests/testthat/test-exp_stats.R

In actxps: Create Actuarial Experience Studies: Prepare Data, Summarize Results, and Create Reports

study_py <- expose_py(census_dat, "2019-12-31", target_status = "Surrender")

expected_table <- c(seq(0.005, 0.03, length.out = 10), 0.2, 0.15, rep(0.05, 3))

set.seed(123)
study_py <- study_py |>
  mutate(expected_1 = expected_table[pol_yr],
         expected_2 = ifelse(inc_guar, 0.015, 0.03),
         weights = rnorm(nrow(study_py), 100, 50) |> abs())

exp_res <- study_py |>
  group_by(pol_yr, inc_guar) |>
  exp_stats(expected = c("expected_1", "expected_2"),
            credibility = TRUE, conf_int = TRUE)

exp_res_weighted <- study_py |>
  group_by(pol_yr, inc_guar) |>
  exp_stats(expected = c("expected_1", "expected_2"),
            credibility = TRUE, wt = "weights", conf_int = TRUE)


test_that("Partial credibility is between 0 and 1", {
  expect_lte(max(exp_res$credibility, exp_res$q_obs), 1)
  expect_gte(min(exp_res$credibility, exp_res$q_obs), 0)
})


test_that("Experience study summary method checks", {
  expect_identical(exp_res, summary(exp_res, pol_yr, inc_guar))
  expect_equal(exp_stats(study_py, expected = c("expected_1", "expected_2"),
                         credibility = TRUE, conf_int = TRUE),
               summary(exp_res))
  expect_equal(exp_stats(study_py, expected = c("expected_1", "expected_2"),
                         credibility = TRUE, wt = "weights",
                         conf_int = TRUE),
               summary(exp_res_weighted))
})


test_that("Confidence intervals work", {
  expect_true(all(exp_res$q_obs_lower < exp_res$q_obs))
  expect_true(all(exp_res$q_obs_upper > exp_res$q_obs))
  expect_true(all(exp_res_weighted$q_obs_lower < exp_res_weighted$q_obs))
  expect_true(all(exp_res_weighted$q_obs_upper > exp_res_weighted$q_obs))

  expect_true(all(exp_res$ae_expected_1_lower < exp_res$ae_expected_1))
  expect_true(all(exp_res$ae_expected_2_upper > exp_res$ae_expected_2))
  expect_true(all(exp_res_weighted$ae_expected_1_lower <
                    exp_res_weighted$ae_expected_1))
  expect_true(all(exp_res_weighted$ae_expected_2_upper >
                    exp_res_weighted$ae_expected_2))

  # verify that confidence intervals are tighter using lower confidence
  less_confident <- study_py |>
    group_by(pol_yr, inc_guar) |>
    exp_stats(expected = c("expected_1", "expected_2"),
              credibility = TRUE, conf_int = TRUE, conf_level = 0.5)
  expect_true(all(exp_res$q_obs_upper - exp_res$q_obs_lower >
                    less_confident$q_obs_upper - less_confident$q_obs_lower))

})

test_that("Control variables work", {

  exp_ctrl1 <- study_py |>
    group_by(pol_yr, inc_guar) |>
    exp_stats(control_vars = c("pol_yr", "inc_guar"))

  # when control variables and grouping variables overlap, A/E's should be one
  expect_equal(exp_ctrl1$ae_control, rep(1, nrow(exp_ctrl1)))
  expect_equal(exp_stats(study_py, control_vars = ".none")$ae_control, 1)

  # manually reproduce control var results
  exp_prod_qual <- study_py |>
    group_by(product, qual) |>
    exp_stats(wt = 'premium') |>
    select(product, qual, q_prod_qual = q_obs)
  exp_ctrl2 <- study_py |>
    left_join(exp_prod_qual, by = c("product", "qual")) |>
    group_by(pol_yr, inc_guar) |>
    exp_stats(control_vars = c("product", "qual"),
              expected = "q_prod_qual", wt = 'premium')
  expect_equal(exp_ctrl2$ae_control, exp_ctrl2$ae_q_prod_qual)


})

test_that("Error messages work", {

  expect_error(study_py |> exp_stats(expected = 'banana'),
               regexp = 'expected values column was not found')
  expect_error(study_py |> exp_stats(control_vars = c('banana', 'apple')),
               regexp = 'control variables were not found')
  expect_error(study_py |> mutate(.none = 1) |>
                 exp_stats(control_vars = ".none"),
               regexp = 'Name conflict error')
  expect_error(study_py |> rename(ex = exposure) |> exp_stats(),
               regexp = "Can't rename columns")

})