Changing a function that calculates XIRR to return NA instead of stopping in R-CodePudding

I am using an XIRR function to calculate the XIRR of several different data frames. All data frames have 2 columns, date and cash flows. For some data frames, the XIRR function returns a value, for others, the functions simply stops and throws an error. Here is a link to the function:

https://github.com/SunilVeeravalli/XIRR_in_R/blob/master/Xirr Code.R

The function is:

library(tidyverse)

xirr <- function(dataset) {
  
  # creating a function to calculate npv value
  npv <- function(range, dataset){
    for(test.rate in range) {
      
      max.date <- max(dataset$dates)
      
      temp <- dataset %>%
        mutate(npv = amount * ((1   test.rate/100)^(as.numeric(max.date - dates)/365))) %>%
        select(npv) %>%
        .[1]
      if(sum(dataset$amount) > 0) {
        if(sum(temp) > 0) {
          min.rate <- test.rate
          next
        } else {
          max.rate <- test.rate
          break
        }
      } else {
        if(sum(temp) < 0) {
          min.rate <- test.rate
          next
        } else {
          max.rate <- test.rate
          break
        }
      }
    }
    return(list(min.rate = min.rate, max.rate = max.rate))
  }
  
  
  names(dataset) <- c("dates", "amount")
  
  max.rate <- c()
  min.rate <- c()
  
  if(sum(dataset$amount) > 0) {
    
    range <- seq(from = 0, to = 10000, by = 100)    
    hundreds <- npv(range, dataset)
    
    range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = 10)
    tens <- npv(range, dataset)
    
    range <- seq(from = tens$min.rate, to = tens$max.rate, by = 1)
    ones <- npv(range, dataset)
    
    range <- seq(from = ones$min.rate, to = ones$max.rate, by = 0.01)
    decimals <- npv(range, dataset)
    
    return(paste("XIRR is ", mean(unlist(decimals)), "%", sep = ""))   
    
  } else {
    
    range <- seq(from = 0, to = -10000, by = -100)
    hundreds <- npv(range, dataset)
    
    range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = -10)
    tens <- npv(range, dataset)
    
    range <- seq(from = tens$min.rate, to = tens$max.rate, by = -1)
    ones <- npv(range, dataset)
    
    range <- seq(from = ones$min.rate, to = ones$max.rate, by = -0.01)
    decimals <- npv(range, dataset)
    
    return(paste("XIRR is ", mean(unlist(decimals)), "%", sep = "")) 
  }
}

The two test data frames are:

mydate <- seq.Date(from = as.Date("2015-01-01"), to = as.Date("2015-12-01"),
                   by = "month")
cashflow1 <- c(-50000, 0, 100, 200, 300, 400, 100, 200, 300, 400, 440, 0)
testdf1 <- cbind.data.frame(mydate, cashflow1)

cashflow2 <- c(451266, rep(0, times = 11))
testdf2 <- cbind.data.frame(mydate, cashflow2)

xirr(testdf1)
xirr(testdf2)

As you can see, running the xirr for testdf2 results in an error "Error in seq.default(from = hundreds$min.rate, to = hundreds$max.rate, : 'from' must be of length 1 "

Instead of this function throwing an error, I want to modify it in such a way that it returns NA instead of giving an error.

CodePudding user response：

I am not sure I understand what the function is supposed to do but in your example the issue is that tesdf2$cashflow2 == 0. To handle this, you could modify xirr by adding an extra if clause.

xirr <- function(dataset) {
  
  # creating a function to calculate npv value
  npv <- function(range, dataset){
    for(test.rate in range) {
      
      max.date <- max(dataset$dates)
      
      temp <- dataset %>%
        mutate(npv = amount * ((1   test.rate/100)^(as.numeric(max.date - dates)/365))) %>%
        select(npv) %>%
        .[1]
      if(sum(dataset$amount) > 0) {
        if(sum(temp) > 0) {
          min.rate <- test.rate
          next
        } else {
          max.rate <- test.rate
          break
        }
      } else {
        if(sum(temp) < 0) {
          min.rate <- test.rate
          next
        } else {
          max.rate <- test.rate
          break
        }
      }
    }
    return(list(min.rate = min.rate, max.rate = max.rate))
  }
  
  
  names(dataset) <- c("dates", "amount")
  
  max.rate <- c()
  min.rate <- c()
  
  if(sum(dataset$amount) > 0) {
    
    range <- seq(from = 0, to = 10000, by = 100)    
    hundreds <- npv(range, dataset)
    
    range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = 10)
    tens <- npv(range, dataset)
    
    range <- seq(from = tens$min.rate, to = tens$max.rate, by = 1)
    ones <- npv(range, dataset)
    
    range <- seq(from = ones$min.rate, to = ones$max.rate, by = 0.01)
    decimals <- npv(range, dataset)
    
    return(paste("XIRR is ", mean(unlist(decimals)), "%", sep = ""))   
    
  } 
  
## this is the new part

  else if (sum(dataset$amount) == 0) {
    return(paste("Cannot calculate XIRR. "))   
  }
    
## end of new part 

  else {
    
    range <- seq(from = 0, to = -10000, by = -100)
    hundreds <- npv(range, dataset)
    
    range <- seq(from = hundreds$min.rate, to = hundreds$max.rate, by = -10)
    tens <- npv(range, dataset)
    
    range <- seq(from = tens$min.rate, to = tens$max.rate, by = -1)
    ones <- npv(range, dataset)
    
    range <- seq(from = ones$min.rate, to = ones$max.rate, by = -0.01)
    decimals <- npv(range, dataset)
    
    return(paste("XIRR is ", mean(unlist(decimals)), "%", sep = "")) 
  }
}

CodePudding user response：

XIRR can only be calculated when at least 1 value is below zero and at least 1 value is above zero (according to Excel definitions: "XIRR expects at least one positive cash flow and one negative cash flow; otherwise, XIRR returns the #NUM! error value." https://support.microsoft.com/en-us/office/xirr-function-de1242ec-6477-445b-b11b-a303ad9adc9d

So what we can do is check your data first and then either return NA right away or do your calculations. Either youw own code or use the xirr function from the tvm package.

xirr <- function(dataset) {
  if(min(dataset$cashflow) < 0 & max(dataset$cashflow) > 0) {
    # do your stuff (your function OR tvm::xirr)
  } else {
    return(NA)
  }
}