tests/testthat/test-trx_stats.R

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

no_trx <- expose_py(census_dat, "2019-12-31", target_status = "Surrender")
expo <- expose_py(census_dat, "2019-12-31", target_status = "Surrender") |>
  add_transactions(withdrawals) |>
  left_join(account_vals, by = c("pol_num", "pol_date_yr"))

res <- expo |>
  group_by(pol_yr, inc_guar) |>
  trx_stats(percent_of = c("av_anniv", "premium"), conf_int = TRUE)

test_that("trx_stats error checks work", {
  expect_error(trx_stats(1), regexp = 'must be an `exposed_df')
  expect_error(trx_stats(no_trx), regexp = 'No transactions')
  expect_error(
    trx_stats(expo, trx_types = c("abc", "def")),
    regexp = 'The following transactions do not exist'
  )
  expect_no_error(trx_stats(expo))
})

test_that("Experience study summary method checks", {
  expect_identical(res, summary(res, pol_yr, inc_guar))
  expect_equal(
    trx_stats(expo, percent_of = c("av_anniv", "premium"), conf_int = TRUE),
    summary(res)
  )
})

expo2 <- head(expo) |> rename(ex = exposure)

test_that("Renaming works", {
  expect_error(trx_stats(expo2), regexp = "Can't rename columns")
  expect_no_error(trx_stats(expo2, col_exposure = "ex"))
})

test_that("trx_stats works", {
  expect_equal(
    ncol(
      expo |>
        trx_stats(
          trx_types = "Base",
          percent_of = c("av_anniv", "premium"),
          conf_int = TRUE
        )
    ),
    ncol(res) - 2
  )
  expect_s3_class(res, "trx_df")
  expect_true(all(res$exposure >= res$trx_flag, na.rm = TRUE))
  expect_true(all(res$avg_trx >= res$avg_all, na.rm = TRUE))
  expect_true(all(res$trx_freq >= res$trx_util, na.rm = TRUE))
  expect_true(all(
    res$pct_of_av_anniv_w_trx >= res$pct_of_av_anniv_all,
    na.rm = TRUE
  ))
  expect_true(all(
    trx_stats(expo)$exposure <=
      trx_stats(expo, full_exposures_only = FALSE)$exposure
  ))

  expect_equal(
    expo |>
      trx_stats(combine_trx = TRUE, trx_types = "Rider") |>
      select(-trx_type),
    expo |> trx_stats(trx_types = "Rider") |> select(-trx_type)
  )

  res2 <- expo |> trx_stats(combine_trx = TRUE) |> as.data.frame()
  attr(res2, "trx_types") <- NULL
  res3 <- no_trx |>
    add_transactions(
      withdrawals |> mutate(trx_type = "All")
    ) |>
    trx_stats() |>
    as.data.frame()
  attr(res3, "trx_types") <- NULL

  expect_equal(res2, res3)
})

test_that("Confidence intervals work", {
  res2 <- filter(res, trx_util > 0)
  expect_true(all(res2$trx_util < res2$trx_util_upper))
  expect_true(all(res2$trx_util > res2$trx_util_lower))
  expect_true(all(res2$pct_of_premium_w_trx < res2$pct_of_premium_w_trx_upper))
  expect_true(all(res2$pct_of_premium_w_trx > res2$pct_of_premium_w_trx_lower))
  expect_true(all(res2$pct_of_premium_all < res2$pct_of_premium_all_upper))
  expect_true(all(res2$pct_of_premium_all > res2$pct_of_premium_all_lower))

  # verify that confidence intervals are tighter using lower confidence
  less_confident <- expo |>
    group_by(pol_yr, inc_guar) |>
    trx_stats(
      percent_of = c("av_anniv", "premium"),
      conf_int = TRUE,
      conf_level = 0.5
    ) |>
    filter(trx_util > 0)
  expect_true(all(
    res2$trx_util_upper - res2$trx_util_lower >
      less_confident$trx_util_upper -
        less_confident$trx_util_lower
  ))
})