Рассчитайте предельные налоговые ставки, используя R

Я пишу функцию для расчета налога, причитающегося с учетом уровня дохода в соответствии с предельными налоговыми ставками в Австралии.

Я написал простую версию функции, которая приводит к правильной сумме налога, использующего следующее:

income_tax <- function(income) {
# Calculate income tax liability based on income
#
# Returns the amount of income tax owed

    if (income > 0 & income <= 18200) {
        tax <- 0
        } else if (income > 18200 & income <= 37000) {
        tax <- (income - 18200) * .19
        } else if (income > 37000 & income <= 80000) {
        tax <- 3572 + (income - 37000) * .325
        } else if (income > 80000 & income <= 180000) {
        tax <- 17547 + (income - 80000) * .37
        } else if (income > 180000) {
        tax <- 54547 + (income - 180000) * .45
        }
    return(tax)
}

Проблема с этим подходом заключается в том, что я жестко закодировал ставки и сумму, уплаченную в каждой скобке, в логику. Это делает функцию хрупкой и означает, что я не могу проверять разные скорости или скобки (что является моей конечной целью).

То, что я хотел бы сделать, - это создать логику из таблицы ставок налогов.

Здесь версия того, что я хотел бы сделать с alorithm, написанным в псевдокоде, в качестве комментария.

income_tax <- function(income) {
# Calculate income tax liability based on income
#
# Returns the amount of income tax owed
brackets <- c(18200,37001,80000,180000,180000)
rates <- c(0,.19,.325,.37,.45)
tax_rates <- data.frame(brackets, rates)

for (i in 1:nrow(tax_rates)) {
    # if income is in bracket_X then:
    # tax <- (income - bracket_X[i-1]) * rate_X + minimum_tax_from_bracket_X[-1]
    }

return(tax)
}

Моя проблема заключается в том, что я не могу концептуализировать или кодировать, как генерировать сумму налогов и предельных ставок, в то время как данные кодируются таким образом.

Ответ 1

Здесь однострочный, который выполняет трюк:

income_tax <- 
function(income,
         brackets = c(18200, 37000, 80000, 180000, Inf),
         rates = c(0, .19, .325, .37, .45)) {        
    sum(diff(c(0, pmin(income, brackets))) * rates)
}

Возможно, самый простой способ увидеть, как/почему он работает, - это играть с основным битом логики с помощью более простых параметров, например:

brackets <- c(1:5, Inf)

diff(c(0, pmin(.35, brackets)))
## [1] 0.35 0.00 0.00 0.00 0.00 0.00
diff(c(0, pmin(3.9, brackets)))
## [1] 1.0 1.0 1.0 0.9 0.0 0.0
diff(c(0, pmin(99, brackets)))
## [1]  1  1  1  1  1 94

Ответ 2

Я думаю, что вы ищете findInterval:

income_tax <- function(income, 
                       brackets = c(0, 18200, 37000, 80000, 180000, 180000),
                       rates = c(0, .19, .325, .37, .45)) {
  bracketInd <- findInterval(income, brackets, all.inside = TRUE)
  plus <- if (bracketInd <= 2) 0 else 
    sum(sapply(bracketInd:3, function(ind) {
      (brackets[ind] - brackets[ind - 1]) * rates[ind - 1] 
    }))
  if (length(plus) == 0) plus <- 0
  tax <- plus + (income - brackets[bracketInd]) * rates[bracketInd]
  return(tax)
}

Вы можете найти между всеми элементами вашего income и использовать его как индекс для brackets и rates. Я также добавил значения в качестве параметров со значениями по умолчанию.

Ответ 3

Я немного изменил параметры brackets и rates. Вы можете решить эту проблему, используя цикл while.

income_tax <- function(income,
    brackets = c(18200,37001,80000,180000),
    rates = c(.19,.325,.37,.45))
{
  nbrackets <- length(brackets)  
  if(income<=brackets[1]) 
    return(0)

  i <- 2
  cumtax <- 0
  while(i <= nbrackets) {
    if(income > brackets[i-1] && income < brackets[i]) 
      return(cumtax + rates[i-1]*(income-brackets[i-1]))
    else 
      cumtax <- cumtax + rates[i-1]*(brackets[i]-brackets[i-1])
      i <- i + 1
  }
  # income > brackets[nbrackets]
  cumtax + rates[nbrackets] * (income - brackets[nbrackets]) 
}

incomes <- seq(0,200000,25000)
round(sapply(incomes,income_tax),0)
# [1]     0  1292  7797 15922 24947 34197 43447 52697 63547