Применение Reduce () в моделировании кредита в R - PullRequest
Новая
       8

Применение Reduce () в моделировании кредита в R

3 голосов
/ 15 июня 2019

Я моделирую ссудный баланс и добился успеха при постоянной процентной ставке: 

library(data.table)
nT <- 5
int <- 1.1

loan <- data.table(loan.age = seq(0:(nT-1)), payment = c(5000, -rep(1000,(nT-1))))

f <- function(balance, payment) payment + int * balance

loan[, c("interest", "balance") := 0
     ][,balance := Reduce(f, payment, accumulate = TRUE) 
     ][,interest := c(0, diff(balance) - payment[-1]) 
     ]

Результат (правильный): 

loan.age payment interest balance
1   5000    0.0 5000.0
2   -1000   500.0   4500.0
3   -1000   450.0   3950.0
4   -1000   395.0   3345.0
5   -1000   334.5   2679.5

Однако мне нужно применить другой процентза каждый период, например: 

int <- rnorm(nT, mean = 0.1, sd = 0.02) + 1

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

Error in r[i1] - r[-length(r):-(length(r) - lag + 1L)] : 
non-numeric argument to binary operator

Я застрял, кто-нибудь поможет мне это исправить?

Спасибозаранее.

Ответы [ 2 ]

3 голосов
/ 15 июня 2019

Если вы введете отладчик в свою функцию f, вы увидите, что происходит: 

f <- function(balance, payment) { browser(); payment + int * balance; }
loan[, c("interest", "balance") := 0
     ][,balance := Reduce(f, payment, accumulate = TRUE) 
     ]
# Browse[2]> 
balance
# [1] 5000
# Browse[2]> 
payment
# [1] -1000
# Browse[2]> 
int
# [1] 1.127515 1.131305 1.149106 1.118575 1.087982
# Browse[2]> 
payment + int * balance
# [1] 4637.577 4656.526 4745.531 4592.875 4439.911

### continue out, let it do its thing
loan
#    loan.age payment interest                                      balance
# 1:        1    5000        0                                         5000
# 2:        2   -1000        0 4637.577,4656.526,4745.531,4592.875,4439.911
# 3:        3   -1000        0 4228.940,4267.952,4453.119,4137.476,3830.544
# 4:        4   -1000        0 3768.195,3828.356,4117.106,3628.077,3167.563
# 5:        5   -1000        0 3248.698,3331.039,3730.992,3058.277,2446.252
loan$balance[2]
# [[1]]
# [1] 4637.577 4656.526 4745.531 4592.875 4439.911

То, что я имею в виду, это использовать каждый int для каждой строки таблицы. К сожалению, с Reduce это ненормально, поэтому нам придется немного его подстроить. Я заархивирую векторы payment и int вместе с Map(list, payment, int), что потребует небольшой очистки. 

set.seed(2)
int <- rnorm(nT, mean = 0.1, sd = 0.02) + 1
int
# [1] 1.082062 1.103697 1.131757 1.077392 1.098395

# start fresh
loan <- data.table(loan.age = seq(0:(nT-1)), payment = c(5000, -rep(1000,(nT-1))))

f2 <- function(balance, payment) { browser(); payment[[1]] + payment[[2]] * balance[[1]]; }
loan[, c("interest", "balance") := 0
     ][,balance := Reduce(f2, Map(list, payment, int), accumulate = TRUE) 
       ]
# Called from: f(init, x[[i]])
# Browse[1]> 
debug at #1: payment[[1]] + payment[[2]] * balance[[1]]
# Browse[2]> 
payment
# [[1]]
# [1] -1000
# [[2]]
# [1] 1.103697
# Browse[2]> 
balance
# [[1]]
# [1] 5000
# [[2]]
# [1] 1.082062
# Browse[2]> 
payment[[1]] + payment[[2]] * balance[[1]]
# [1] 4518.485
# Browse[2]> 


### continue out until done
loan
#    loan.age payment interest  balance
# 1:        1    5000        0   <list>
# 2:        2   -1000        0 4518.485
# 3:        3   -1000        0 4113.827
# 4:        4   -1000        0 3432.206
# 5:        5   -1000        0 2769.918

loan$balance[[1]]
# [[1]]
# [1] 5000
# [[2]]
# [1] 1.082062

Очевидно, что у нас не может быть balance в качестве столбца списка ... поэтому мы можем просто извлечь и unlist его с помощью другого конвейера: 

f3 <- function(balance, payment) { payment[[1]] + payment[[2]] * balance[[1]]; }
# start fresh
loan <- data.table(loan.age = seq(0:(nT-1)), payment = c(5000, -rep(1000,(nT-1))))
loan[, c("interest", "balance") := 0
     ][,balance := Reduce(f3, Map(list, payment, int), accumulate = TRUE) 
       ][,balance := unlist(c(balance[[1]][[1]], balance[-1]))
         ]
loan
#    loan.age payment interest  balance
# 1:        1    5000        0     5000
# 2:        2   -1000        0 4518.485
# 3:        3   -1000        0 4113.827
# 4:        4   -1000        0 3432.206
# 5:        5   -1000        0 2769.918

Итак, наконец: 

# start fresh
loan <- data.table(loan.age = seq(0:(nT-1)), payment = c(5000, -rep(1000,(nT-1))))
loan[, c("interest", "balance") := 0
     ][,balance := Reduce(f3, Map(list, payment, int), accumulate = TRUE) 
       ][,balance := unlist(c(balance[[1]][[1]], balance[-1]))
         ][,interest := c(0, diff(balance) - payment[-1]) 
           ]
loan
#    loan.age payment interest  balance
# 1:        1    5000   0.0000 5000.000
# 2:        2   -1000 518.4849 4518.485
# 3:        3   -1000 595.3416 4113.827
# 4:        4   -1000 318.3793 3432.206
# 5:        5   -1000 337.7118 2769.918
1 голос
/ 16 июня 2019

Опция будет accumulate2 из purrr

library(purrr)
library(dplyr)
loan %>%
   mutate(balance = flatten_dbl(accumulate2(payment, int,  ~ 
             ..2 + ..3 * ..1  , .init = 0)[-1]),        
          interest = c(0, diff(balance) - payment[-1]))
#   loan.age payment  balance interest
#1        1    5000 5000.000   0.0000
#2        2   -1000 4518.485 518.4849
#3        3   -1000 4113.827 595.3416
#4        4   -1000 3432.206 318.3793
#5        5   -1000 2769.918 337.7118

data 

nT <- 5
set.seed(2)
int <- rnorm(nT, mean = 0.1, sd = 0.02) + 1
loan <- data.table(loan.age = seq(0:(nT-1)), payment = c(5000, -rep(1000,(nT-1))))
...