将 for() 循环转换为 R 中的 apply() 函数以获得自定义 XIRR 函数答案

【问题标题】：Converting for() loops to apply() functions in R for a custom XIRR function将 for() 循环转换为 R 中的 apply() 函数以获得自定义 XIRR 函数
【发布时间】：2022-12-03 04:04:06
【问题描述】：

我目前一直在寻找函数来计算 R 中大型现金流量/余额数据库的 XIRR，我遇到了 this 函数，我一直在尝试修改它以适合我的代码：

library(tidyverse)

xirr2 <- function(exflow, date) {
    if(as.numeric(max(date) - min(date)) <= 2) {
        return(0)
    } else if(abs(sum(exflow, na.rm = TRUE)) < 1e-12) {
        return(0)
    } else {
        npv <- function(range, exflow, date){
            for(test.rate in range) {
                temp <- as.data.frame(cbind(exflow, date)) %>%
                    mutate(npv = exflow * ((1 + test.rate/100)^(as.numeric(max(date) - date)/365))) %>%
                    select(npv) %>%
                    .[1]
                if(sum(exflow, na.rm = TRUE) > 0) {
                    if(sum(temp, na.rm = TRUE) > 0) {
                        min.rate <- test.rate
                        next
                    } else {
                        max.rate <- test.rate
                        break
                    }
                } else {
                    if(sum(temp, na.rm = TRUE) < 0) {
                        min.rate <- test.rate
                        next
                    } else {
                        max.rate <- test.rate
                        break
                    }
                }
            }
            return(list(min.rate = min.rate, max.rate = max.rate))
        }
        max.rate <- c()
        min.rate <- c()
        if(sum(exflow, na.rm = TRUE) >= 1e-12) {
            range <- seq(from = 0, to = 1e8, by = 1e3)    
            hundreds <- npv(range, exflow, date)
            range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = 10)
            tens <- npv(range, exflow, date)
            range <- seq(from = tens$min.rate, to = tens$max.rate, by = 1)
            ones <- npv(range, exflow, date)
            range <- seq(from = ones$min.rate, to = ones$max.rate, by = 0.01)
            decimals <- npv(range, exflow, date)
            return(mean(unlist(decimals))/100)
        } else {
            range <- seq(from = 0, to = -1e8, by = -1e3)
            hundreds <- npv(range, exflow, date)
            range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = -10)
            tens <- npv(range, exflow, date)
            range <- seq(from = tens$min.rate, to = tens$max.rate, by = -1)
            ones <- npv(range, exflow, date)
            range <- seq(from = ones$min.rate, to = ones$max.rate, by = -0.01)
            decimals <- npv(range, exflow, date)
            return(mean(unlist(decimals))/100) 
        }
    }
}

基本上，给定现金流向量和相应日期向量，此函数返回投资的年化 IRR。

虽然它工作得很好并且在与 MS Excel 和 LibreOffice Calc 交叉引用时生成始终如一的正确答案，但它有点慢，我觉得可以通过将 for() 循环替换为 apply() 函数来改进它或者 data.table 包中的东西。速度问题在小例子上几乎不明显，但在像我这样有大量边缘案例的大型数据集上，速度下降可能相当大。

对于它的价值，我已经尝试了来自各种包的大量其他 XIRR 函数，包括tvm、FinancialMath 和FinCal。无论出于何种原因，这些功能往往会随着时间的推移而崩溃：解决方案最终会停止收敛并变得不准确，尤其是在现金流量大且正/负回报之间快速变化的情况下。这可能是由于普遍依赖 R 中的 uniroot() 或 polyroot() 函数来计算 XIRR，但我不确定。

无论如何，上面的函数实际上得到了我想要的数字——我只需要一些帮助来优化它以适应更大的数据集。先感谢您！

编辑

感谢您到目前为止的帮助。以下是一些最低限度的示例：

一些存款，一些提款，然后完全提款以获得正回报。 MS Excel 显示 XIRR = 15.32%：

> flow1 <- c(-1000,-100,100,1200)
> date1 <- as.Date(c("2018-01-01","2018-10-31","2019-03-31","2019-03-31"), format = "%Y-%m-%d")
> tvm::xirr(flow1,date1)
Error in uniroot(xnpv, interval = interval, cf = cf, d = d, tau = tau,  : 
  f.lower = f(lower) is NA
> xirr2(flow1,date1)
[1] 0.15315

一个接受定期捐款但回报不佳的账户。 MS Excel 显示 XIRR = -27.54%：

> flow2 <- c(-200,-200,-200,-200,-200,800)
> date2 <- as.Date(c("2018-01-01","2018-03-01","2018-06-01","2018-09-01","2019-01-01","2019-03-01"), format = "%Y-%m-%d")
> tvm::xirr(flow2,date2)
Error in uniroot(xnpv, interval = interval, cf = cf, d = d, tau = tau,  : 
  f.lower = f(lower) is NA
> xirr2(flow2,date2)
[1] -0.27535

也许我只是用错了tvm::xirr()？我不确定如何纠正 uniroot() 错误。

【问题讨论】：

“我觉得可以通过用 apply() 函数或 data.table 包中的某些东西替换 for() 循环来改进它。”你的感觉是错误的。您需要使用矢量化方法替换 for 循环，或者使用 Rcpp 将其实现为编译代码。（此外，不必要地使用 as.data.frame(cbind()) 和 dplyr 会花费一些时间。对 data.frames 的操作很慢。看起来 temp 应该是一个矩阵。）
Profiling R code with the RStudio IDE 非常方便。
注意到 Roland 的评论，as.data.frame(cbind(exflow, date)) 和 (as.numeric(max(date) - date)/365) 对于每个循环迭代都是相同的值，因此您可以在循环外计算它们。
请发布具有预期输出的示例数据集。这看起来基本上是 uniroot 的一个非常低效的实现。您是否尝试过 tvm 包中的 xirr 函数——它似乎使用了 uniroot。

标签： r for-loop apply lapply xirr

【解决方案1】：

好的，感谢this 的回答，我明白了。事实证明 tvm::xirr() 确实运行良好（并且比上述函数快得多），但我一直在错误地调用它。这是一个工作示例：

> flow2 <- c(-200,-200,-200,-200,-200,800)
> date2 <- as.Date(c("2018-01-01","2018-03-01","2018-06-01","2018-09-01","2019-01-01","2019-03-01"), format = "%Y-%m-%d")
> tvm::xirr(flow2, date2, comp_freq = 1, maxiter = 100, tol = 1e-8, lower = 0.999, upper = 100)
[1] -0.2753857

我之前用lower = -1试过这个，它给出了与上面相同的错误。所以我偏离了 0.001... 非常接近。再次感谢大家的帮助！

【讨论】：