#' Check whether an income should be tapered
#'
#' @param income Income
#' @param lower_bound Level of the lower bound
#' @param rate Medicare Levy Rate
#' @param taper_rate Low income taper rate
#'
#' @return Logical. Whether the income is below the maximum taper threshold
check_upper_bound <- function(income, lower_bound, rate = .02, taper_rate = .1) {
tapered_levy <- (income - lower_bound) * taper_rate
standard_levy <- income * rate
if (tapered_levy > standard_levy) {
return(TRUE)
} else {
return(FALSE)
}
}
#' Calculate the amount of medicare levy owed
#'
#' @param income Income of the person for whom the levy is being calulated
#' @param rate Medicare levy rate
#' @param taper_rate How fast should the medicare levy low income reduction taper out
#' @param lower_bound_single The start of the taper out of the low income reduction (single)
#' @param lower_bound_couple The start of the taper out of the low income reduction (family)
#' @param spouse_income Income of the person's spouse
#' @param n_children Number of children
#' @param children_reduction How much should the lower_bound_couple increase by for each child
#' @param rel_status Relationship status, must either be 'single' or 'couple'
#'
#' @return Amount of medicare levy owed
#' @export
#'
#' @examples
#' medicare_levy(100000)
#' medicare_levy(44000, spouse_income = 0, rel_status = 'couple', lower_bound_single = 20896,
#' lower_bound,couple = 35261, children_reduction = 3238)
medicare_levy <- function(income, rate = .02, taper_rate = .1, lower_bound_single = 21335,
lower_bound_couple = 36001, spouse_income = 0, n_children = 0,
children_reduction = 3306, rel_status = 'single') {
# Error checking -----------------------------------------------------------------------------------
if (!is.numeric(income)) stop('income must be numeric')
if (income < 0) stop('income must be a non-negative number')
if (!(rel_status == 'single' | rel_status == 'couple')) {
stop('rel_status must either be single or couple')
}
if (rel_status == 'single' & (spouse_income > 0 | n_children > 0)) {
# If there is a spouse with income or children, then it must be a couple
rel_status <- 'couple'
}
# Singles ------------------------------------------------------------------------------------------
income_above_upper_bound <- check_upper_bound(income, lower_bound = lower_bound_single)
tapered_medicare_levy <- (income - lower_bound_single) * taper_rate
# Couples ------------------------------------------------------------------------------------------
if (rel_status == 'couple') {
hh_income <- income + spouse_income
lower_bound_couple <- lower_bound_couple + (children_reduction * n_children)
hh_above_upper_bound <- check_upper_bound(hh_income, lower_bound = lower_bound_couple)
reduction_amount <- (lower_bound_couple * .02) - ((hh_income - lower_bound_couple) * .08)
# If the household income is above the tapered family low income reduction then the standard
# medicare levy applies
if (hh_above_upper_bound == FALSE) {
spouse_above_upper_bound <- check_upper_bound(spouse_income, lower_bound = lower_bound_single)
income_share_red_amount <- (income / hh_income) * reduction_amount
if (income > lower_bound_single & spouse_income < lower_bound_single) {
# If the primary earns over the single taper threshold, but their spouse does not, the
# spouse pays no levy, the primary pays the levy otherwise payable reduced by a 'reduction
# amount'. This seems completely arbritrary.
tapered_medicare_levy <- (income * rate) - reduction_amount
} else if (income_above_upper_bound == TRUE & spouse_above_upper_bound == TRUE) {
# If both the primary and their spouse earn greater than the individual taper thresholds but
# are still under the household threshold, the amount payable is the share of the proportion
# of income over the threshold
income_share <- (income / hh_income) * (hh_income - lower_bound_couple)
tapered_medicare_levy <- income_share * taper_rate
} else if (income_above_upper_bound == TRUE &
(spouse_income > lower_bound_single & spouse_above_upper_bound == FALSE)) {
# These next two do the same thing, but for the situation where the primary is over the
# single income threshold, the other for the contrary.
#
# In this case the reduction amount is apportioned on the basis of each spouse's
# contribution to the family income. If the reduction amount as apportioned exceeds the levy
# otherwise payable by one spouse, the excess goes in reduction of the levy payable by the
# other.
spouse_share_red_amount <- (spouse_income / hh_income) * reduction_amount
spouse_surplus_red_amount <- (spouse_income - lower_bound_single) * taper_rate -
spouse_share_red_amount
tapered_medicare_levy <- (income * rate) - (income_share_red_amount - spouse_surplus_red_amount)
} else if (spouse_above_upper_bound == TRUE &
(income > lower_bound_single & income_above_upper_bound == FALSE)) {
tapered_medicare_levy <- (income - lower_bound_single) * taper_rate + income_share_red_amount
}
}
}
# Final calcs --------------------------------------------------------------------------------------
if (income < lower_bound_single) {
return(0)
} else if (tapered_medicare_levy < 0) {
return(0)
} else if (tapered_medicare_levy < (income * rate)) {
return(tapered_medicare_levy)
} else {
return(round(income * rate, 1))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.