Update Super for LISTO; income tax now includes LMITO

NAMESPACE

@@ -106,4 +106,5 @@ importFrom(magrittr,and)
 importFrom(magrittr,or)
 importFrom(stats,complete.cases)
 importFrom(stats,setNames)
+importFrom(utils,hasName)
 useDynLib(grattan, .registration = TRUE)

R/ModellingSuperannuationChanges.R

@@ -6,14 +6,19 @@
 
 
 #' @param .sample.file A \code{data.table} whose variables include those in \code{taxstats::sample_file_1314}.
-#' @param fy.year The financial year tax scales.
+#' @param fy.year The financial year tax scales. N.B. Has no bearing on the 
+#' default values of caps, is only used if a marginal tax rate forms part of the
+#' calculation of a superannuation tax.
 #' @param new_cap The \strong{proposed} cap on concessional contributions for all taxpayers if \code{age_based_cap} is FALSE, or for those below the age threshold otherwise.
 #' @param new_cap2 The \strong{proposed} cap on concessional contributions for those above the age threshold. No effect if \code{age_based_cap} is FALSE.
 #' @param new_age_based_cap Is the \strong{proposed} cap on concessional contributions age-based? 
 #' @param new_cap2_age The age above which \code{new_cap2} applies.
 #' @param new_ecc (logical) Should an excess concessional contributions charge be calculated? (Not implemented.)
 #' @param new_contr_tax A string to determine the contributions tax.
 #' @param new_div293_threshold The \strong{proposed} Division 293 threshold. 
+#' @param new_listo_rate The low-income superannaution tax offset (LISTO): what rate will apply
+#' to adjusted taxable income below \code{new_listo_threshold}.
+#' @param new_listo_threshold The threshold of adjusted taxable income below which LISTO applies.
 #' @param use_other_contr Should \code{MCS_Othr_Contr} be used to calculate Division 293 liabilities?
 #' @param scale_contr_match_ato (logical) Should concessional contributions be inflated to match aggregates in 2013-14? That is, should the concessional contributions by multiplied by the internal constant \code{grattan:::super_contribution_inflator_1314}, which was defined to be: \deqn{\frac{\textrm{Total assessable contributions in SMSF and funds}}{\textrm{Total contributions in 2013-14 sample file}}}{Total assessable contributions in SMSF and funds / Total contributions in 2013-14 sample file.}. 
 #' @param .lambda Scalar weight applied to \code{concessional contributions}. \eqn{\lambda = 0} means no (extra) weight. \eqn{\lambda = 1} means contributions are inflated by the ratio of aggregates to the sample file's total. For \eqn{R = \textrm{actual} / \textrm{apparent}} then the contributions are scaled by \eqn{1 + \lambda(R - 1)}.
@@ -28,6 +33,9 @@
 #' @param prv_cap2_age The age above which \code{new_cap2} applies.
 #' @param prv_ecc (logical) Should an excess concessional contributions charge be calculated? (Not implemented.)
 #' @param prv_div293_threshold The \strong{comparator} Division 293 threshold. 
+#' @param prv_listo_rate The low-income superannaution tax offset (LISTO): what rate applied
+#' to adjusted taxable income below \code{prv_listo_threshold}?
+#' @param prv_listo_threshold The threshold of adjusted taxable income below which LISTO applied.
 #' @param ... Passed to \code{model_new_caps_and_div293}.
 #' @param adverse_only Count only individuals who are adversely affected by the change.
 #' @return For \code{model_new_caps_and_div293}, a \code{data.frame}, comprising 
@@ -58,6 +66,8 @@ model_new_caps_and_div293 <- function(.sample.file,
                                       new_ecc = FALSE,
                                       new_contr_tax = "15%",
                                       new_div293_threshold = 300e3,
+                                      new_listo_rate = 0.15,
+                                      new_listo_threshold = 37000,
                                       use_other_contr = FALSE, 
                                       scale_contr_match_ato = FALSE, 
                                       .lambda = 0, 
@@ -72,14 +82,20 @@ model_new_caps_and_div293 <- function(.sample.file,
                                       prv_age_based_cap = TRUE, 
                                       prv_cap2_age = 49, 
                                       prv_ecc = FALSE,
-                                      prv_div293_threshold = 300e3) {
-  prv_revenue <- new_revenue <- NULL
+                                      prv_div293_threshold = 300e3,
+                                      prv_listo_rate = 0.15,
+                                      prv_listo_threshold = 37000) {
+  prv_revenue <- new_revenue <- WEIGHT <- NULL
   if (!any("WEIGHT" == names(.sample.file))){
     warning("WEIGHT not specified. Using WEIGHT=50 (assuming a 2% sample file).")
-    WEIGHT <- 50
-    .sample.file[, WEIGHT := WEIGHT]
+    .sample.file[, WEIGHT := 50]
   } 
 
+  use_listo <- 
+    !identical(prv_listo_rate, new_listo_rate) ||
+    !identical(prv_listo_threshold, new_listo_threshold)
+
+
 
 
   sample_file <- apply_super_caps_and_div293(.sample.file, 
@@ -104,18 +120,23 @@ model_new_caps_and_div293 <- function(.sample.file,
                                              ecc = prv_ecc,
                                              warn_if_colnames_overwritten = FALSE, 
                                              drop_helpers = FALSE, 
+                                             incl_listo = use_listo,
+                                             listo_rate = prv_listo_rate,
+                                             listo_threshold = prv_listo_threshold,
+                                             colname_listo = "old_listo",
                                              copyDT = TRUE)
 
   new_Taxable_Income <- NULL
   old_Taxable_Income <- NULL
   old_div293_tax <- NULL
   new_div293_tax <- NULL
 
+
   sample_file <- 
-    sample_file[, c("Ind", "old_concessional_contributions", "old_div293_tax", 
-                    "div293_income", "old_Taxable_Income"),
-                with = FALSE]
-  sample_file %>%
+    hutils::selector(sample_file, 
+                     cols = c("Ind", "old_concessional_contributions", "old_div293_tax", 
+                              "div293_income", "old_Taxable_Income",
+                              if (use_listo) "old_listo")) %>%
     setnames("div293_income", "old_div293_income") %>%
     setkeyv("Ind")
 
@@ -142,6 +163,10 @@ model_new_caps_and_div293 <- function(.sample.file,
                                                  age_based_cap = new_age_based_cap, 
                                                  cap2_age = new_cap2_age, 
                                                  ecc = new_ecc,
+                                                 incl_listo = use_listo,
+                                                 listo_rate = new_listo_rate,
+                                                 listo_threshold = new_listo_threshold,
+                                                 colname_listo = "new_listo",
                                                  warn_if_colnames_overwritten = FALSE, 
                                                  drop_helpers = FALSE, 
                                                  copyDT = TRUE)
@@ -189,6 +214,13 @@ model_new_caps_and_div293 <- function(.sample.file,
   ans[, new_ordinary_tax := income_tax(new_Taxable_Income, fy.year, .dots.ATO = .SD)]
   new_ordinary_tax <- NULL
   ans[, new_revenue := income_tax(new_Taxable_Income, fy.year, .dots.ATO = .SD) + NewContributionsTax + new_div293_tax]
+
+  if (use_listo) {
+    new_listo <- old_listo <- NULL
+    ans[, prv_revenue := prv_revenue - old_listo]
+    ans[, new_revenue := new_revenue - new_listo]
+  }
+
   ans
 }
 

R/RcppExports.R

@@ -64,6 +64,10 @@ Offset <- function(x, y, a, m) {
     .Call(`_grattan_Offset`, x, y, a, m)
 }
 
+LMITO2 <- function(x) {
+    .Call(`_grattan_LMITO2`, x)
+}
+
 anyOutside <- function(x, a, b) {
     .Call(`_grattan_anyOutside`, x, a, b)
 }

R/grattan-package.R

@@ -46,6 +46,7 @@
 #' @importFrom Rcpp sourceCpp
 #' @importFrom stats complete.cases
 #' @importFrom stats setNames
+#' @importFrom utils hasName
 #' 
 #' 
 #' @import data.table

R/income_tax.R

@@ -261,6 +261,7 @@ rolling_income_tax <- function(income,
                   .checks = FALSE)
 
   lito. <- .lito(input)
+  lmito. <- (fy.year %in% yr2fy(2019:2022)) * (LMITO2(income))
 
   if (any(sapto.eligible)) {
     sapto. <- double(max.length)
@@ -320,7 +321,7 @@ rolling_income_tax <- function(income,
   }
 
   # http://classic.austlii.edu.au/au/legis/cth/consol_act/itaa1997240/s4.10.html
-  S4.10_basic_income_tax_liability <- pmaxIPnum0(base_tax. - lito. - sapto.)
+  S4.10_basic_income_tax_liability <- pmaxIPnum0(base_tax. - lito. - lmito. - sapto.)
 
   # SBTO can only be calculated off .dots.ATO
   if (is.null(.dots.ATO)) {
@@ -550,11 +551,16 @@ income_tax_cpp <- function(income,
     sapto. <- 0
   }
 
+  lmito. <- 0
+  if (Year.int >= 2019L && Year.int <= 2022L) {
+    lmito. <- LMITO2(income)
+  }
+
   # 2011-12 is never used
   flood_levy. <- 0
 
   # http://classic.austlii.edu.au/au/legis/cth/consol_act/itaa1997240/s4.10.html
-  S4.10_basic_income_tax_liability <- pmaxIPnum0(base_tax. - lito. - sapto.)
+  S4.10_basic_income_tax_liability <- pmaxIPnum0(base_tax. - lito. - lmito. - sapto.)
 
   # SBTO can only be calculated off .dots.ATO
   if (is.null(.dots.ATO)) {
@@ -580,6 +586,8 @@ income_tax_cpp <- function(income,
     out <- out + 0.02 * pmax0(income - 180e3)
   }
 
+
+
   if (any(income < 0)) {
     warning("Negative entries in income detected. These will have value NA.")
     out[income < 0] <- switch(storage.mode(out), 
@@ -592,6 +600,7 @@ income_tax_cpp <- function(income,
       copy(.dots.ATO) %>%
       .[, "base_tax" := base_tax.] %>%
       .[, "lito" := lito.] %>%
+      .[, "lmito" := lmito.] %>%
       .[, "sapto" := sapto.] %>%
       .[, "medicare_levy" := medicare_levy.] %>%
       .[, "income_tax" := out] %>%

R/mutate_super_vars.R

@@ -21,7 +21,16 @@
 #' @param .min.Sw.for.SG The minimum salary required for super guarantee to be imputed.
 #' @param .SG_rate The super guarantee rate for imputation.
 #' @param warn_if_colnames_overwritten (logical) Issue a warning if the construction of helper columns will overwrite existing column names in \code{.sample.file}.
-#' @param drop_helpers (logical) Should columns used in the calculation be dropped before the sample file is returned?
+#' @param drop_helpers (logical) Should columns used in the calculation be dropped
+#'  before the sample file is returned?
+#' @param incl_listo (logical, default: \code{FALSE}) Should the low-income 
+#' superannuation tax offset be included?
+#' @param listo_rate The low-income superannaution tax offset (LISTO): the rate to apply
+#' to adjusted taxable income below \code{new_listo_threshold}.
+#' @param listo_threshold The threshold of adjusted taxable income below which LISTO applies.
+#' @param listo_min,listo_max The minimum and maximum values of LISTO, for individuals 
+#' satisfying the elgiibility criteria.
+#' @param colname_listo A string, the column name of LISTO to be added to \code{.sample.file}.
 #' @param copyDT (logical) Should the data table be \code{copy()}d? If the action of this data table is being compared, possibly useful.
 #' @return A data table comprising the original sample file (\code{.sample.file}) with extra superannuation policy-relevant variables for the policy specified by the function.
 #' 
@@ -48,11 +57,18 @@ apply_super_caps_and_div293 <- function(.sample.file,
                                         .SG_rate = 0.0925,
                                         warn_if_colnames_overwritten = TRUE, 
                                         drop_helpers = FALSE, 
+                                        incl_listo = FALSE,
+                                        listo_rate = 0.15,
+                                        listo_threshold = 37000,
+                                        listo_min = 10,
+                                        listo_max = 500,
+                                        colname_listo = "listo",
                                         copyDT = TRUE) {
   # Todo/wontfix
   if (!identical(ecc, FALSE)) {
     stop("ECC not implemented.")
   }
+  check_TF(incl_listo)
 
   # CRAN NOTE avoidance
   age_range_description <- concessional_cap <- div293_income <- div293_tax <-
@@ -63,7 +79,9 @@ apply_super_caps_and_div293 <- function(.sample.file,
     salary_sacrifice_contributions <- personal_deductible_contributions <- 
     non_concessional_contributions <- Taxable_income_for_ECT <- NULL
 
-  if (copyDT){
+  WEIGHT <- NULL
+
+  if (copyDT) {
     .sample.file <- copy(.sample.file)
   }
 
@@ -105,6 +123,17 @@ apply_super_caps_and_div293 <- function(.sample.file,
     stop("The sample file you requested does not have the variables needed for this function.")
   }
 
+  if (incl_listo &&
+      !hasName(.sample.file, "Tot_inc_amt") &&
+      !hasName(.sample.file, "Tot_IncLoss_amt")) {
+    stop(".sample.file does not have a column 'Tot_inc_amt' or 'Tot_IncLoss_amt', ",
+         "yet `incl_listo = TRUE`.")
+  }
+  if (incl_listo && !hasName(.sample.file, "Tot_IncLoss_amt")) {
+    Tot_inc_amt <- NULL  # must be a column
+    .sample.file[, Tot_IncLoss_amt := Tot_inc_amt]
+  }
+
   if ("Rptbl_Empr_spr_cont_amt" %in% names(.sample.file)){
     .sample.file[, SG_contributions := pmax0(MCS_Emplr_Contr - Rptbl_Empr_spr_cont_amt)]
     .sample.file[, salary_sacrifice_contributions := Rptbl_Empr_spr_cont_amt]
@@ -137,7 +166,7 @@ apply_super_caps_and_div293 <- function(.sample.file,
   }
 
   if (reweight_late_lodgers){
-    WEIGHT <- NULL
+
     if (!any("WEIGHT" == names(.sample.file))){
       warning("No WEIGHT found; using WEIGHT=50 in reweighting.")
       .sample.file[ , WEIGHT := 50]
@@ -199,6 +228,22 @@ apply_super_caps_and_div293 <- function(.sample.file,
                                         0.15 * pminV(low_tax_contributions_div293, 
                                                      pmaxC(div293_income - div293_threshold, 0)), 
                                         0)]
+  if (incl_listo) {
+    adjusted_taxable_income <- NULL
+    .sample.file[, "adjusted_taxable_income" := Taxable_Income + Rep_frng_ben_amt * 0.53 + Asbl_forgn_source_incm_amt + Net_fincl_invstmt_lss_amt + Aust_govt_pnsn_allw_amt + Rptbl_Empr_spr_cont_amt]
+
+    Tot_IncLoss_amt <- Tot_inc_amt <- NULL
+
+    .sample.file[, (colname_listo) := if_else(and(adjusted_taxable_income <= listo_threshold,  # income test
+                                                  and(concessional_contributions > 0,  # super contributions test
+                                                      # 10% of income from salary or business
+                                                      Sw_amt + Total_PP_BI_amt + Total_NPP_BI_amt >= 0.1 * Tot_IncLoss_amt)), 
+                                              hutilscpp::squish(listo_rate * adjusted_taxable_income,
+                                                                listo_min, 
+                                                                listo_max),
+                                              0)]
+    .sample.file[, adjusted_taxable_income := NULL]
+  }
 
   # Modify taxable income to reflect exceeding cap:
   .sample.file[ , Taxable_income_for_ECT := Taxable_Income + excess_concessional_contributions]