Переписать для l oop в saply с учетом NA - PullRequest
0 голосов
/ 16 января 2020

Я бы хотел, чтобы R вычислил netincome на определенную сумму Income:

panelID = c(1:50)   
year= c(2001:2010)
country = "NLD"
n <- 2
library(data.table)
set.seed(123)
DT <- data.table(panelID = rep(sample(panelID), each = n),
                 country = rep(sample(country, length(panelID), replace = T), each = n),
                 year = c(replicate(length(panelID), sample(year, n))),
                 some_NA = sample(0:5, 6),                                             
                 some_NA_factor = sample(0:5, 6),         
                 norm = round(runif(100)/10,2),
                 Income = round(rnorm(10,10,10),2),
                 Happiness = sample(10,10),
                 Sex = round(rnorm(10,0.75,0.3),2),
                 Age = sample(100,100),
                 Educ = round(rnorm(10,0.75,0.3),2))        
DT [, uniqueID := .I]                                                         # Creates a unique ID     
DT[DT == 0] <- NA 
DT$Income[DT$Income < 0] <- NA 
DT <- as.data.frame(DT)

Теперь налог нужно рассчитать следующим образом:

Для Первые пять лет (2001-2005), Доход <20 = 25%, Доход> 20 == 50%

За вторые пять лет (2006-2010), Доход <15 = 20%, Доход> 20 == 45%

Я попытался написать это следующим образом:

for (i in DT$Income) {
    if (DT$Income[i] < 20 & DT$year[i] < 2006) {
        DT$netincome[i] <- DT$Income[i] - (DT$Income[i]*0.25)
    } else if (DT$Income[i] > 20 & DT$year[i] < 2006) {
        DT$netincome[i] <- DT$Income[i] - (20*0.25) - ((DT$Income[i]-20)*0.5)
    } else if (DT$Income[i] < 15 & DT$year[i] > 2005) {
        DT$netincome[i] <- DT$Income[i] - (DT$Income[i]*0.20)
    } else if (DT$Income[i] > 15 & DT$year[i] > 2005) {
        DT$netincome[i] <- DT$Income[i] - (15*0.20) - ((DT$Income[i]-15)*0.45)
    } 
    }

Но я получаю сообщение об ошибке:

Error in `$<-.data.frame`(`*tmp*`, "netincome", value = c(NA, NA, NA,  : 
  replacement has 15 rows, data has 100

Кроме того, мне бы очень хотелось переписать это более понятным способом с sapply, но я борюсь с тем, как.

Ответы [ 3 ]

2 голосов
/ 16 января 2020

Если вы хотите сделать это в базе R, вам не нужно использовать sapply; Вы можете просто вложить несколько ifelse операторов.

DT$netincome <- with(DT, ifelse(year < 2006 & Income < 20, Income - (Income * 0.25),
  ifelse(year < 2006 & Income > 20, Income - (20 * 0.25) - ((Income - 20)* 0.5),
  ifelse(Income < 15, Income - (Income * 0.20), Income - (15 * 0.20) - ((Income - 15) * 0.45) ))))

Сводка итогового столбца. Соответствует ли это ожидаемому результату?

> summary(DT$netincome)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  4.372   4.710  11.053  11.614  14.881  27.076      20 
2 голосов
/ 16 января 2020
library(dplyr)
DT[Income < 0,Income:= NA] # better use this construction
DT[,.(netincome = case_when(Income < 20 & year < 2006 ~ Income - 0.25 * Income,
                            Income > 20 & year < 2006 ~ Income - 20 * 0.25 - 0.5 * (Income - 20),
                            Income < 15 & year > 2005 ~ Income - 0.2 * Income,
                            Income > 15 & year > 2005 ~ Income - 15*0.2 - 0.45 * (Income - 15)))]

Это будет намного проще, если вы будете использовать непротиворечивое имя столбца (лучший метод tolower). И старайтесь не использовать такие имена, как DT. DT обозначает один из хорошо используемых пакетов в R, и это немного сбивает с толку. И в будущей версии data.table будет fcase, который будет быстрее, чем case_when

0 голосов
/ 16 января 2020
library(dplyr)
DT%>%
  mutate(netincome = case_when(Income < 20 & year < 2006 ~ Income - 0.25 * Income,
                               Income > 20 & year < 2006 ~ Income - 20*0.25 - 0.5*(Income-20),
                               Income < 15 & year > 2005 ~ Income -0.2*Income,
                               Income > 15 & year > 2005 ~ Income - 15*0.2 - 0.45*(Income-15))

Если вам нравится dplyr подход :), вы также можете использовать% <>% этот оператор. Или, если вам не нужен новый столбец, вы можете перейти к суммированию

...