我有一个大数据集(大约20万行),其中每一行都是贷款.我有贷款金额,付款数量和贷款支付.我正试图获得贷款利率.R没有计算它的函数(至少基数R没有它,我找不到它).编写npv和irr函数并不难
Npv <- function(i, cf, t=seq(from=0,by=1,along.with=cf)) sum(cf/(1+i)^t)
Irr <- function(cf) { uniroot(npv, c(0,100000), cf=cf)$root }
Run Code Online (Sandbox Code Playgroud)
你可以做到
rate = Irr(c(amt,rep(pmt,times=n)))
Run Code Online (Sandbox Code Playgroud)
问题是当您尝试计算大量付款的费率时.因为uniroot没有矢量化,并且因为rep需要花费大量时间,所以最终会导致计算速度变慢.如果你做一些数学计算并发现你正在寻找下面等式的根源,你可以加快速度
zerome <- function(r) amt/pmt-(1-1/(1+r)^n)/r
Run Code Online (Sandbox Code Playgroud)
然后将其用作uniroot的输入.在我的电脑上,这需要大约20秒来运行我的200k数据库.
问题是我正在尝试进行一些优化,这是优化的一个步骤,所以我试图加快它的速度.
我已经尝试了矢量化,但由于uniroot没有矢量化,我不能再这样了.有没有矢量化的根发现方法?
谢谢
您可以使用线性插值器,而不是使用根查找器.您必须为每个值n(剩余付款的数量)创建一个插补器.每个插值器都将映射(1-1/(1+r)^n)/r到r.当然,您必须构建一个足够精细的网格,以便返回r到可接受的精度级别.这种方法的好处是线性插值器快速且向量化:您可以n在一次调用相应的插值器中找到具有相同剩余支付数量的所有贷款的费率.
现在一些代码证明它是一个可行的解决方案:
首先,我们创建插值器,每个可能的值为n:
n.max <- 360L # 30 years
one.interpolator <- function(n) {
r <- seq(from = 0.0001, to = 0.1500, by = 0.0001)
y <- (1-1/(1+r)^n)/r
approxfun(y, r)
}
interpolators <- lapply(seq_len(n.max), one.interpolator)
Run Code Online (Sandbox Code Playgroud)
请注意,我使用了1/100百分比(1bp)的精度.
然后我们创建一些假数据:
n.loans <- 200000L
n <- sample(n.max, n.loans, replace = TRUE)
amt <- 1000 * sample(100:500, n.loans, replace = TRUE)
pmt <- amt / (n * (1 - runif(n.loans)))
loans <- data.frame(n, amt, pmt)
Run Code Online (Sandbox Code Playgroud)
最后,我们解决r:
library(plyr)
system.time(ddply(loans, "n", transform, r = interpolators[[n[1]]](amt / pmt)))
# user system elapsed
# 2.684 0.423 3.084
Run Code Online (Sandbox Code Playgroud)
它很快.请注意,某些输出速率NA是因为我的随机输入没有意义,并且会返回我选择的[0~15%]网格之外的速率.您的真实数据不会有这个问题.
| 归档时间: |
|
| 查看次数: |
640 次 |
| 最近记录: |