将 for() 循环转换为 R 中的 apply() 函数，用于自定义 XIRR function

Question

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

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

基本上，给定现金流量向量和相应日期向量，这个 function 返回投资的年化 XIRR。

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

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

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

编辑

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

一些存款，一些提款，然后完全提款以获得正回报。 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()错误。

Answer 1

好的，由于这个答案，我明白了。 事实证明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... 非常接近。 再次感谢大家的帮助！