在 R 中的贷款建模中应用 Reduce()答案

【问题标题】：Applying Reduce() in loan modeling in R在 R 中的贷款建模中应用 Reduce()
【发布时间】：2019-10-29 22:12:38
【问题描述】：

我正在为贷款余额建模并成功获得固定利率：

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

我被卡住了，有人可以帮我解决这个问题吗？

提前致谢。

【问题讨论】：

lag 应该是一列吗？它可能会选择 lag 函数，如果您尝试从数字中减去它，则会引发该错误。
他将每个payment 乘以int 的整个向量，生成长度为5 的列表列（对于大多数情况）。（现在正在修复......）

标签： r data.table reduce

【解决方案1】：

如果您在函数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

【讨论】：

这可能有点过分了，但是因为我以前（在这里和我的日常工作中）都看到过类似的需求，所以我编写了一个结合Reducereductionism 和Map 的函数的 k-ary 参数处理。它在这里：gist.github.com/r2evans/5503cc5df9be9179d4ae80e7ef91308e，并在示例部分中包含对此问题答案的改编。 </geekout>
我必须强调，我的 MapReduce 几乎是 Reduce 到 k-ary 参数的字面翻译。我不知道代码布局是否可以更好，我只是以最小的努力，k-ary逻辑的字面集成。
亲爱的@r2evans，感谢您的解决方案，我需要学习很多东西，您的逐步解释帮助我消化了所有这些信息。我还查看了 MapReduce()，它工作得很好。但我会坚持你提出的非常快速的解决方案，我会一遍又一遍地使用它，所以速度是我的目的的关键点。谢谢你。

【解决方案2】：

一个选项是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

数据

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))))

【讨论】：

谢谢 Akrun，我试过了，效果很好。问候，法比奥。