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)) })