tests/testthat/test_super_vars.R

In HughParsonage/grattan: Australian Tax Policy Analysis

context("Superannuation variables")

test_that("Error handling", {
  expect_error(apply_super_caps_and_div293(ecc = TRUE), 
               regexp = "ECC not implemented.")
})

test_that("Div293 tax is bounded by cap @ 25k", {
  cap1 <- 25e3
  new_sample_file <- apply_super_caps_and_div293(.sample_file_1314(),
                                                 cap = cap1,
                                                 age_based_cap = FALSE)
  expect_true(all(new_sample_file$div293_tax <= cap1 * 0.15 + .Machine$double.eps ^ 0.5))
})
test_that("Div293 tax is bounded by cap @ 20k", {
  cap1 <- 20e3
  new_sample_file <-
    apply_super_caps_and_div293(.sample_file_1314(), cap = cap1, age_based_cap = FALSE)
  expect_true(all(new_sample_file$div293_tax <= cap1 * 0.15 + .Machine$double.eps ^ 0.5))
})
test_that("Div293 tax is bounded by cap @ 30k", {
  cap1 <- 30e3
  new_sample_file <-
    apply_super_caps_and_div293(.sample_file_1314(),
                                cap = cap1,
                                age_based_cap = FALSE)
  expect_true(all(new_sample_file$div293_tax <= cap1 * 0.15 + .Machine$double.eps ^ 0.5),
              info = as.character(paste0("cap1 = ", cap1)))
})

test_that("Div293 tax is bounded by an arbitrary cap", {
  skip_on_cran()
  caps <- sort(abs(rcauchy(2, location = 30e3, scale = 20e3)))
  cap1 <- caps[1]
  cap2 <- caps[2]
  
  age_based_cap <- sample(c(TRUE, FALSE), size = 1)
  div293_threshold <- abs(rcauchy(1, 300e3, 100e3))
  cap2_age <- sample(25:65, size = 1)
  
  new_sample_file <- apply_super_caps_and_div293(.sample_file_1314(), 
                                                 cap = cap1,
                                                 cap2 = cap2,
                                                 age_based_cap = age_based_cap, 
                                                 div293_threshold = div293_threshold,
                                                 cap2_age = cap2_age)
  expect_true(all(new_sample_file$div293_tax <= new_sample_file$concessional_cap * 0.15 + .Machine$double.eps ^ 0.5), info = as.character(paste0("cap1 = ", cap1)))
})

# Adjusted Taxable Income (for surcharge purposes < 300e3)
test_that("Surchargeable income and low tax contributions less than 300,000 implies no Div293 tax", {
  skip_on_cran()
  caps <- sort(abs(rcauchy(2, location = 30e3, scale = 20e3)))
  cap1 <- caps[1]
  cap2 <- caps[2]
  
  age_based_cap <- sample(c(TRUE, FALSE), size = 1)
  div293_threshold <- abs(rcauchy(1, 300e3, 100e3))
  cap2_age <- sample(25:65, size = 1)
  
  new_sample_file <- apply_super_caps_and_div293(.sample_file_1314(), 
                                                 cap = cap1, cap2 = cap2, age_based_cap = age_based_cap, 
                                                 div293_threshold = div293_threshold, cap2_age = cap2_age)
  
  # cap1 = 82481.0762025714
  # cap2 = 12349.9120592203
  # age_based_cap = TRUE
  # div293_threshold = 177262.550400898
  # cap2_age = 65
  
  expect_true(all(new_sample_file[surchargeable_income_div293 + low_tax_contributions_div293 <= div293_threshold][["div293_tax"]] <= .Machine$double.eps ^ 0.5), 
              info = as.character(paste0("cap1 = ", cap1, "\n", 
                                         "cap2 = ", cap2, "\n",
                                         "age_based_cap = ", age_based_cap, "\n", 
                                         "div293_threshold = ", div293_threshold, "\n", 
                                         "cap2_age = ", cap2_age)))
})

test_that("Counts for Div 293 at 250e3 not at odds with PBO", {
  skip_on_cran()
  skip_on_appveyor()
  sample_file_1718 <- 
    .sample_file_1314() %>%
    project_to(to_fy = "2017-18", fy.year.of.sample.file = "2013-14")
  
  n_adversely_affected_201718 <- 
    n_affected_from_new_cap_and_div293(.sample.file = sample_file_1718, 
                                       # PBO issued estimate in 2015-16
                                       fy.year = "2015-16", 
                                       new_cap = 30e3, new_cap2 = 35e3, new_age_based_cap = TRUE, 
                                       new_cap2_age = 49,
                                       new_ecc = FALSE, 
                                       new_div293_threshold = 250e3, 
                                       
                                       use_other_contr = FALSE,
                                       prv_cap = 30000, prv_cap2 = 35000, prv_age_based_cap = TRUE,
                                       prv_cap2_age = 49, 
                                       prv_ecc = FALSE, 
                                       prv_div293_threshold = 300e3)
  # https://www.facebook.com/LDP.australia/photos/pcb.10152975190247672/10152975189552672/?type=3&theater
  # PBO has number affected by a change to 250e3 as
  # 2017-18   2018-19   2019-20
  # 110,000   130,000   150,000
  expect_true(between(n_adversely_affected_201718, 70e3, 130e3))
  
  n_affected_201718 <- 
    n_affected_from_new_cap_and_div293(.sample.file = sample_file_1718, 
                                       # PBO issued estimate in 2015-16
                                       fy.year = "2015-16", 
                                       new_cap = 30e3, new_cap2 = 35e3, new_age_based_cap = TRUE, 
                                       new_cap2_age = 49,
                                       new_ecc = FALSE, 
                                       new_div293_threshold = 250e3, 
                                       
                                       use_other_contr = FALSE,
                                       prv_cap = 30000, prv_cap2 = 35000, prv_age_based_cap = TRUE,
                                       prv_cap2_age = 49, 
                                       prv_ecc = FALSE, 
                                       prv_div293_threshold = 300e3,
                                       adverse_only = FALSE)
  expect_true(between(n_affected_201718, 70e3, 130e3))
  
})

context("Reweighting and imputation successfully reconcile aggregates")

test_that("Imputed, reweighted sample file agrees with aggregates by no less than 1%", {
  library(magrittr)
  
  funds <- 
    .funds_table1_201314() %>%
    .[Selected_items == "Assessable contributions"] %>%
    .[, .(fy_year, Assessable_contributions_funds = Sum)] %>%
    setkey(fy_year)
  
  smsfs <- 
    .funds_table2_smsf_201314() %>%
    .[Selected_items == "Assessable contributions"] %>%
    .[, .(fy_year, Assessable_contributions_smsfs = Sum)] %>%
    setkey(fy_year)
  
  ato_aggregate_contributions <- 
    smsfs[funds] %>%
    .[, total_contributions := Assessable_contributions_smsfs + Assessable_contributions_funds]
    
  s1314 <- as.data.table(.sample_file_1314())
  
  # Now test imputation using defaults.
  imputed_concessional_contributions <- 
    s1314 %>%
    .[, WEIGHT := 50L] %>%
    apply_super_caps_and_div293(reweight_late_lodgers = TRUE,
                                impute_zero_concess_contr = TRUE) %$%
    sum(concessional_contributions * WEIGHT)
  
  percentage_difference <- 
    100 * abs(imputed_concessional_contributions / ato_aggregate_contributions[fy_year == "2013-14"][["total_contributions"]] - 1)
  
  expect_lt(percentage_difference, 1)
  
  expect_lte(apply_super_caps_and_div293(s1314, scale_contr_match_ato = FALSE)[, sum(MCS_Emplr_Contr)] * 1.11,
             apply_super_caps_and_div293(s1314, scale_contr_match_ato = TRUE, .lambda = 1)[, sum(MCS_Emplr_Contr)])
  # expect_gte(apply_super_caps_and_div293(s1314, scale_contr_match_ato = FALSE)[, sum(MCS_Emplr_Contr)] * 1.12,
  #            apply_super_caps_and_div293(s1314, scale_contr_match_ato = TRUE, .lambda = 1)[, sum(MCS_Emplr_Contr)])
  
  
})

test_that("Error handling", {
  sample_file <- 
    head(.sample_file_1314()) %>%
    as.data.frame(.)
  expect_error(apply_super_caps_and_div293(sample_file), 
               regexp = "data.table")
  
  sample_file_dt <-
    head(.sample_file_1314()) %>%
    .[, concessional_cap := 25e3]
  
  expect_warning(apply_super_caps_and_div293(sample_file_dt))
  
  expect_warning(apply_super_caps_and_div293(sample_file_dt,
                                             colname_new_Taxable_Income = "Taxable_Income"), 
                 regexp = "Dropping Taxable.Income")
  
  expect_error(apply_super_caps_and_div293(.sample_file_("1213")),
               regexp = "does not have the variables needed")
  
  expect_warning(apply_super_caps_and_div293(sample_file_dt,
                                             colname_div293_tax = "Sw_amt"))
  
  sample_file_old <-
    .sample_file_1314() %>%
    copy %>%
    hutils::drop_col("Rptbl_Empr_spr_cont_amt")
  
  expect_error(apply_super_caps_and_div293(sample_file_old,
                                           impute_zero_concess_contr = TRUE),
               regexp = "required to impute") 
  
  expect_warning(apply_super_caps_and_div293(sample_file_dt,
                                             reweight_late_lodgers = TRUE),
                 regexp = "WEIGHT")
  
})


test_that("Corner cases", {
  library(magrittr)
  n_low_age <- 
    .sample_file_1314() %>%
    apply_super_caps_and_div293(cap2_age = 19) %$%
    sum(concessional_cap == max(concessional_cap))
    
  n_high_age <- 
    .sample_file_1314() %>%
    apply_super_caps_and_div293(cap2_age = 68) %$%
    sum(concessional_cap == max(concessional_cap))
  
  expect_gte(n_low_age, n_high_age)
  
  expect_false("div293_income" %in% names(apply_super_caps_and_div293(.sample_file_1314(),
                                                                      drop_helpers = TRUE)))
  
  low_tax_contributions_no_Other_contr <- 
    .sample_file_1314() %>%
    apply_super_caps_and_div293 %$%
    sum(low_tax_contributions_div293)
  
  low_tax_contributions_with_Other_contr <- 
    .sample_file_1314() %>%
    apply_super_caps_and_div293(use_other_contr = TRUE) %$%
    sum(low_tax_contributions_div293)
  
  expect_gte(low_tax_contributions_with_Other_contr,
             low_tax_contributions_no_Other_contr)
})

test_that("Warning with no WEIGHT.", {
  expect_warning(revenue_from_new_cap_and_div293(.sample_file_1314(), fy.year = "2013-14"))
})

test_that("Marginals Rate", {
  library(data.table)
  library(hutilscpp)
  s1314 <- copy(.sample_file_1314())[, WEIGHT := 50L]
  expect_error(model_new_caps_and_div293(.sample.file = s1314, fy.year = "2013-14", new_contr_tax = "mr/"),
               regexp = "not of the form mr -",
               fixed = TRUE)
  s1314A <- model_new_caps_and_div293(s1314, fy.year = "2013-14", new_contr_tax = "mr + 15%")[, .(NewContributionsTax)]
  s1314B <- model_new_caps_and_div293(s1314, fy.year = "2013-14", new_contr_tax = "mr - 15%")[, .(NewContributionsTax)]
  
  NewContTaxA <- s1314A[[1]]
  NewContTaxB <- s1314B[[1]]
  
  wf1 <- which_first(NewContTaxA < NewContTaxB)
  expect_equal(wf1, 0)
})