Как использовать map2 с векторами неравной длины - PullRequest
0 голосов
/ 04 июня 2019

проблема

Я пытаюсь рассчитать подоходный налог, подлежащий уплате с доходов от 1 до 200 000 долларов США, с шагом 100 долларов США (значения 2000 года).

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

У меня есть функция, которая рассчитывает налог, подлежащий уплате на основе дохода и применимых ставок.

Используя эту функцию, я хочу получить вектор, показывающий подлежащий уплате налог:

  1. для каждого уровня дохода (значения 2000)
  2. для каждого набора (34 набора ставок)

Было бы здорово, если бы я мог вернуть этот вывод во фрейме данных / таблице.

Данные

#This scrapes the website of the tax administrator and returns a list of tidy data frames showing tax rates for income years between 2016 and 1983
url <- "https://www.ato.gov.au/Rates/Individual-income-tax-for-prior-years/"
pit_sch <- url %>%
  read_html() %>%
  html_table() %>%
  setNames(., url %>%
             read_html() %>%
             html_nodes("caption") %>%
             html_text()) %>% 
  map(.%>%
    mutate(`Tax on this income` = gsub(",", "", `Tax on this income`), 
            cumm_tax_amt = str_extract(`Tax on this income`, "(?<=^\\$)\\d+") %>% as.numeric(), 
            tax_rate = str_extract(`Tax on this income`, "\\d+.(\\d+)?(?=(\\s+)?c)") %>% as.numeric(), 
            threshold = str_extract(`Tax on this income`, "(?<=\\$)\\d+$") %>% as.numeric()
           )
    ) %>%
  map(~drop_na(.x, threshold)) %>% 
  map(function(x) { mutate_each(x, funs(replace(., is.na(.), 0))) })

#Defining income 
income <- seq(from = 1, to = 200000, by = 100)

#The function for calculating tax payable
tax_calc <- function(data, income) {
  i <-tail(which(income >= data[, 5]), 1)
  if (length(i) > 0) 
    return(((income - data[i,5]) * (data[i,4]/100)) + data[i,3])
  else
    return(0)
}

Моя попытка

> map2(pit_sch, income, tax_calc)
Error: Mapped vectors must have consistent lengths:
* `.x` has length 34
* `.y` has length 2000
    enter code here

1 Ответ

1 голос
/ 04 июня 2019

Чтобы правильно различать income и годы, для которых это рассчитывается. Я бы предложил функции tax_calc вернуть tibble с income и tax вычислением.

library(tidyverse)

tax_calc <- function(data, income) {
   i <-tail(which(income >= data[, 5]), 1)
  if (length(i) > 0) 
    return(tibble(income = income, 
          tax = (income - data[i,5]) * (data[i,4]/100) + data[i,3]))
  else
    return(tibble(income = income, tax = 0))
}

Поскольку вы хотите tax_calc для всех income для каждого pit_sch, вы можете использовать

map(pit_sch,~map_df(income, tax_calc, data = .)) %>%  bind_rows(., .id = "id")

Проверяя это для tail(income) мы получаем

map(pit_sch,~map_df(tail(income), tax_calc, data = .)) %>%  bind_rows(., .id = "id")

# A tibble: 204 x 3
#   id                             income    tax
#   <chr>                           <dbl>  <dbl>
# 1 Resident tax rates for 2016-17 199401 62962.
# 2 Resident tax rates for 2016-17 199501 63007.
# 3 Resident tax rates for 2016-17 199601 63052.
# 4 Resident tax rates for 2016-17 199701 63097.
# 5 Resident tax rates for 2016-17 199801 63142.
# 6 Resident tax rates for 2016-17 199901 63187.
# 7 Resident tax rates for 2015-16 199401 63277.
# 8 Resident tax rates for 2015-16 199501 63322.
# 9 Resident tax rates for 2015-16 199601 63367.
#10 Resident tax rates for 2015-16 199701 63412.
# … with 194 more rows
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...