From bfd190711473381771c46759e81b9d4e611deac8 Mon Sep 17 00:00:00 2001 From: HughParsonage Date: Wed, 27 Mar 2024 14:12:32 +1100 Subject: [PATCH] New arguments --- DESCRIPTION | 1 - R/project.R | 101 +++++++++++++++++++---------- R/utils.R | 45 +++++++++++++ man/apply_super_caps_and_div293.Rd | 2 +- man/inverse_average_rate.Rd | 2 +- man/model_new_caps_and_div293.Rd | 4 +- man/project.Rd | 6 +- tests/testthat/test_zbenchmark.R | 2 +- 8 files changed, 122 insertions(+), 41 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e63aaadcb..4236ebb17 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,7 +43,6 @@ Suggests: knitr, rlang, rmarkdown, - scales, survey, testthat, tibble, diff --git a/R/project.R b/R/project.R index 69cab9802..f49edda00 100644 --- a/R/project.R +++ b/R/project.R @@ -45,6 +45,10 @@ #' fund members over the previous 5 years and 7.9\% growth over the #' previous ten years. #' +#' @param r_generic (Present from version 2024.1.0) The factor to inflate other +#' columns. Subject to change in future versions. If \code{NULL}, the default, +#' an internal factor is used. +#' #' #' @return A sample file with the same number of rows as \code{sample_file} but #' with inflated values as a forecast for the sample file in \code{to_fy}. @@ -86,7 +90,7 @@ project <- function(sample_file, check_fy_sample_file = TRUE, differentially_uprate_Sw = NA, r_super_balance = 1.05, - r_generic = 1) { + r_generic = NULL) { if (length(h) != 1L) { stop("`h` had length-", length(h), ", ", "but must be a length-1 positive integer.") @@ -134,6 +138,8 @@ project <- function(sample_file, } + + if (check_fy_sample_file) { # It's been a common error of mine to switch sample files # without updating the fy.year.of.sample.file @@ -212,16 +218,32 @@ project <- function(sample_file, H <- h current.fy <- fy.year.of.sample.file - to.fy <- yr2fy(fy2yr(current.fy) + h) + to.fy <- yr2fy(to.yr <- (fy2yr(current.fy) + h)) + + + if (is.null(wage.series)){ - wage.inflator <- wage_inflator(from = current.fy, to = to.fy) + wage.inflator <- wage_inflator(from = current.fy, to = to.fy, + series = grattanInflators::wpi_original(FORECAST = TRUE)) } else { - wage.inflator <- wage_inflator(from = current.fy, to = to.fy) + wage.inflator <- wage_inflator(from = current.fy, to = to.fy, + series = wage.series) } - + dont_inflate_WEIGHT <- FALSE if (is.null(lf.series)) { - lf.inflator <- lf_inflator(from = current.fy, to = to.fy) + n_taxpayers_2022_2034 <- + c(16216182, 16543257, 16826686, 17076658, 17326098, 17573757, + 18006023, 18438289, 18870556, 19144750, 19409635, 19669543, 19917470) + if (to.yr %in% 2022:2034) { + dont_inflate_WEIGHT <- TRUE + WEIGHT <- NULL + sample_file[, WEIGHT := as.double(WEIGHT)] + set(sample_file, j = "WEIGHT", value = as.double(n_taxpayers_2022_2034[to.yr - 2021] / nrow(sample_file))) + } else { + lf.inflator <- lf_inflator(from = current.fy, to = to.fy, + series = grattanInflators::lfi_original(FORECAST = TRUE)) + } } else { if (is.data.table(lf.series)) { stop("lf.series should be a series as defined by lf_inflator.") @@ -231,7 +253,14 @@ project <- function(sample_file, series = lf.series) } - cpi.inflator <- cpi_inflator(from = current.fy, to = to.fy) + cpi.inflator <- cpi_inflator(from = current.fy, to = to.fy, + series = grattanInflators::cpi_seasonal(FORECAST = TRUE)) + + if (is.null(r_generic)) { + r_generic <- cpi.inflator + } else if (!is.numeric(r_generic) || length(r_generic) != 1 || !is.finite(r_generic)) { + stop("r_generic must be NULL or a length-one numeric.") # nocov + } if (!is.logical(.recalculate.inflators)) { stop("`.recalculate.inflators` was type ", typeof(.recalculate.inflators), ", ", @@ -355,24 +384,24 @@ project <- function(sample_file, derived.cols, Not.Inflated)] - if (.recalculate.inflators) { - generic.inflators <- - generic_inflator(vars = generic.cols, - h = h, - fy.year.of.sample.file = fy.year.of.sample.file, - estimator = forecast.dots$estimator, - pred_interval = forecast.dots$pred_interval) - } else { - generic.inflators <- - switch(current.fy, - "2012-13" = generic_inflators_1213, - "2013-14" = generic_inflators_1314, - "2014-15" = generic_inflators_1415, - "2015-16" = generic_inflators_1516, - "2016-17" = generic_inflators_1617, - stop("Precalculated inflators only available when projecting from ", - "2012-13, 2013-14, 2014-15, 2015-16, and 2016-17.")) - } + # if (.recalculate.inflators) { + # generic.inflators <- + # generic_inflator(vars = generic.cols, + # h = h, + # fy.year.of.sample.file = fy.year.of.sample.file, + # estimator = forecast.dots$estimator, + # pred_interval = forecast.dots$pred_interval) + # } else { + # generic.inflators <- + # switch(current.fy, + # "2012-13" = generic_inflators_1213, + # "2013-14" = generic_inflators_1314, + # "2014-15" = generic_inflators_1415, + # "2015-16" = generic_inflators_1516, + # "2016-17" = generic_inflators_1617, + # stop("Precalculated inflators only available when projecting from ", + # "2012-13, 2013-14, 2014-15, 2015-16, and 2016-17.")) + # } ## Inflate: @@ -430,6 +459,9 @@ project <- function(sample_file, if (j %chin% Not.Inflated) { next } + if (j == "WEIGHT" && dont_inflate_WEIGHT) { + next + } v <- .subset2(sample_file, j) v_new <- switch(inflator_switch(j), @@ -459,15 +491,16 @@ project <- function(sample_file, CG.inflator * v }, "generic" = { - if (.recalculate.inflators) { - if (nrow(generic.inflators)) { - generic.inflators[variable == j]$inflator * v - } else { - v - } - } else { - generic.inflators[.(H, j), inflator] * v - } + r_generic * v + # if (.recalculate.inflators) { + # if (nrow(generic.inflators)) { + # generic.inflators[variable == j]$inflator * v + # } else { + # v + # } + # } else { + # generic.inflators[.(H, j), inflator] * v + # } }, "super" = { {r_super_balance ^ h} * v diff --git a/R/utils.R b/R/utils.R index 5c24d94e1..3850e36b4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -215,3 +215,48 @@ is_testing <- function() { requireNamespace("testthat", quietly = TRUE) && testthat::is_testing() } +doubleExponentialSmoothing <- function(x, alpha, beta, h = 5) { + # x: Numeric vector representing the time series data + # alpha: Smoothing parameter for the level + # beta: Smoothing parameter for the trend + # h: Forecast horizon + if (!is.numeric(h) || length(h) != 1 || !is.finite(h) || h < 1) { + stop("h must be a positive integer.") + } + + # Validate inputs + if (alpha <= 0 || alpha >= 1) { + stop("alpha must be between 0 and 1") + } + if (beta <= 0 || beta >= 1) { + stop("beta must be between 0 and 1") + } + if (length(x) < 2) { + stop("Time series must have at least two observations") + } + + n <- length(x) + level <- numeric(n) + trend <- numeric(n) + forecast <- numeric(n + h) + + # Initialize components + level[1] <- x[1] + trend[1] <- x[2] - x[1] + + # Apply Double Exponential Smoothing + for(t in 2:n) { + level[t] <- alpha * x[t] + (1 - alpha) * (level[t-1] + trend[t-1]) + trend[t] <- beta * (level[t] - level[t-1]) + (1 - beta) * trend[t-1] + } + + # Generate forecasts + for (i in 1:h) { + forecast[n + i] <- level[n] + i * trend[n] + } + + # Return only the forecasts + return(forecast[(n+1):(n+h)]) +} + + diff --git a/man/apply_super_caps_and_div293.Rd b/man/apply_super_caps_and_div293.Rd index 836f698d9..7fefc8312 100644 --- a/man/apply_super_caps_and_div293.Rd +++ b/man/apply_super_caps_and_div293.Rd @@ -9,7 +9,7 @@ apply_super_caps_and_div293( colname_concessional = "concessional_contributions", colname_div293_tax = "div293_tax", colname_new_Taxable_Income = "Taxable_income_for_ECT", - div293_threshold = 300000, + div293_threshold = 3e+05, cap = 30000, cap2 = 35000, age_based_cap = TRUE, diff --git a/man/inverse_average_rate.Rd b/man/inverse_average_rate.Rd index 7470af998..478d34ec5 100644 --- a/man/inverse_average_rate.Rd +++ b/man/inverse_average_rate.Rd @@ -4,7 +4,7 @@ \alias{inverse_average_rate} \title{Inverse average tax rate} \usage{ -inverse_average_rate(average_rate, ..., .max = 100000000) +inverse_average_rate(average_rate, ..., .max = 1e+08) } \arguments{ \item{average_rate}{The average tax rate (\eqn{\frac{tax}{income}})} diff --git a/man/model_new_caps_and_div293.Rd b/man/model_new_caps_and_div293.Rd index 98c353e32..69a16fb1a 100644 --- a/man/model_new_caps_and_div293.Rd +++ b/man/model_new_caps_and_div293.Rd @@ -15,7 +15,7 @@ model_new_caps_and_div293( new_cap2_age = 49, new_ecc = FALSE, new_contr_tax = "15\%", - new_div293_threshold = 300000, + new_div293_threshold = 3e+05, use_other_contr = FALSE, scale_contr_match_ato = FALSE, .lambda = 0, @@ -29,7 +29,7 @@ model_new_caps_and_div293( prv_age_based_cap = TRUE, prv_cap2_age = 49, prv_ecc = FALSE, - prv_div293_threshold = 300000 + prv_div293_threshold = 3e+05 ) n_affected_from_new_cap_and_div293(..., adverse_only = TRUE) diff --git a/man/project.Rd b/man/project.Rd index 0a1e35559..dac7077e5 100644 --- a/man/project.Rd +++ b/man/project.Rd @@ -19,7 +19,7 @@ project( check_fy_sample_file = TRUE, differentially_uprate_Sw = NA, r_super_balance = 1.05, - r_generic = 1 + r_generic = NULL ) } \arguments{ @@ -78,6 +78,10 @@ Set to \code{1.05} for backwards compatibility. The annual superannuation bulletin of June 2019 from APRA reported 7.3\% growth of funds with more than fund members over the previous 5 years and 7.9\% growth over the previous ten years.} + +\item{r_generic}{(Present from version 2024.1.0) The factor to inflate other +columns. Subject to change in future versions. If \code{NULL}, the default, +an internal factor is used.} } \value{ A sample file with the same number of rows as \code{sample_file} but diff --git a/tests/testthat/test_zbenchmark.R b/tests/testthat/test_zbenchmark.R index c91005cae..65d15c0db 100644 --- a/tests/testthat/test_zbenchmark.R +++ b/tests/testthat/test_zbenchmark.R @@ -33,7 +33,7 @@ test_that("Performance regression: wage_inflator", { identical(Sys.getenv("TRAVIS_R_VERSION_STRING"), "devel")), Sys.getenv("TRAVIS_PULL_REQUEST") != "true"))) set.seed(19992014) - from_fys10K <- sample(yr2fy(1999:2014), size = 10e3, replace = TRUE) + from_fys10K <- sample(grattan::yr2fy(1999:2014), size = 10e3, replace = TRUE) from_fys100M <- rep(from_fys10K, times = 100e6/10e3) wage_infl_time10K <- system.time(wage_inflator(from = from_fys10K, to = "2015-16"))