File Coverage

blib/lib/Finance/Math/IRR.pm

Criterion	Covered	Total	%
statement	90	100	90.0
branch	31	38	81.5
condition	16	21	76.1
subroutine	11	12	91.6
pod	1	1	100.0
total	149	172	86.6

#################################################################
#
#   Finance::Math::IRR - Calculate the internal rate of return of a cash flow
#
#   $Id: IRR.pm,v 1.5 2007/07/12 12:35:46 erwan_lemonnier Exp $
#
#   061215 erwan Started implementation
#   061218 erwan Differentiate bugs from failures when calling secant() and brent()
#   061218 erwan Handle precision correctly
#   061218 erwan Support cashflows with only 0 amounts
#   070220 erwan Support when secant converges toward a non root value
#   070404 erwan Cleanup cashflow from transactions of amount 0
#   070404 erwan Error if last transaction is a positive amount. Added $DEBUG
#   070411 erwan Return undef when cashflow has only 1 non zero transaction
#   070418 erwan Update license
#   070711 erwan Removed the restriction requiring the last transaction to be negative
#

package Finance::Math::IRR;

use 5.006;
use strict;
use warnings;
use Carp qw(confess croak);
use Data::Dumper;
use Math::Polynom;
use Date::Calc qw(Delta_Days);
use Scalar::Util qw(looks_like_number);
use base qw(Exporter);

our @EXPORT = qw(xirr);
our $VERSION = '0.10';
our $DEBUG = 0;

#----------------------------------------------------------------
#
#   parameters for secant and brent methods
#

my %ARGS_SECANT = ( p0 => 0.5,
		    p1 => 1,
		    max_depth => 100,
		  );

my %ARGS_BRENT = ( max_depth => 50 );

# how many couple of points to search for positive and negative values
my $MAX_POS_NEG_POINTS = 1024;

#----------------------------------------------------------------
#
#   _crash - die with a usable error description
#

sub _crash {
    my($method,$poly,$args,$err) = @_;

    croak "BUG: something went wrong while calling Math::Polynom::$method with the arguments:\n".
	Dumper($args)."on the polynomial:\n".
	Dumper($poly)."the error was: [$err]\n".
	"Please email all this output to erwan\@cpan.org\n";
}

#----------------------------------------------------------------
#
#   _debug
#

sub _debug {
    my $msg = shift;
    print STDOUT "Finance::Math::IRR: $msg\n" if ($DEBUG);
}

#----------------------------------------------------------------
#
#   xirr - calculate the internal rate of return of a cash flow
#

sub xirr {
    my $precision = 0.001; # default precision seeked on irr, ie 0.1%
    my $guess = 0.1;
    my %cashflow;
    my $root;

    #
    # Parse input arguments and build the cashflow's polynomial
    #

    croak("ERROR: xirr() got an odd number of arguments. this can not be correct") if (!scalar(@_) || scalar(@_) % 2);

    %cashflow = @_;

    _debug("xirr() called with arguments:\n".Dumper(\%cashflow));

    # parse arguments
    if (exists $cashflow{precision}) {
	$precision = $cashflow{precision};
	delete $cashflow{precision};
    }

    if (!defined $precision || !looks_like_number($precision)) {
	croak "ERROR: precision is not a valid number";
    }

    # remove intermediary transactions with 0 amount from cashflow
    my @sorted_dates = sort keys %cashflow;
    croak "ERROR: you provided an empty cash flow" if (scalar @sorted_dates == 0);

    my $date_end = $sorted_dates[-1];

    foreach my $date (@sorted_dates) {
	my $amount = $cashflow{$date};
	croak "ERROR: the provided cashflow contains undefined values"           if (!defined $date || !defined $amount);
	croak "ERROR: invalid date in the provided cashflow [$date]"             if ($date !~ /^\d\d\d\d-\d\d-\d\d$/);
	croak "ERROR: invalid amount in the provided cashflow at date [$date]"   if (!looks_like_number($amount));

	# remove transaction from cashflow if it has a 0 amount
	if ($amount == 0 && $date ne $date_end) {
	    delete $cashflow{$date};
	}
    }

    if ($cashflow{$date_end} == 0) {
	# the last value is 0: we may be able to handle it
	# was the whole cashflow made of transactions with amount 0?
	if (scalar keys %cashflow == 1) {
	    _debug("all transactions in the cashflow have 0 in amount. IRR=0.");
	    return 0;
	}
    }

    if (scalar keys %cashflow < 2) {
	# we got a cashflow with only 1 entry and can't calculate an irr on it
	return undef;
    }

    # TODO: what if all transactions have the same sign?

    # we want $precision on the irr, but can only steer the precision of 1/(1+irr), hence this ratio, that
    # should insure us the given precision even on the irr for irrs up to 1000%
    $precision = $precision / 1000;

    # build the polynomial whose solution is x=1/(1+IRR)
    @sorted_dates = sort keys %cashflow;
    my @date_start = split(/-/,$sorted_dates[0]);
    croak "BUG: expected 3 arguments after splitting [".$sorted_dates[0]."]" if (scalar @date_start != 3);

    my %coeffs;

    while (my($date,$amount) = each %cashflow) {
	my $ddays = Delta_Days(@date_start, split(/-/,$date));
	$coeffs{$ddays/365} = $amount;
    }

    my $poly = Math::Polynom->new(%coeffs);

    #
    # Find a real root of the polynomial
    #

    $ARGS_SECANT{precision} = $precision;

    _debug("trying secant method on interval [".$ARGS_SECANT{p0}."-".$ARGS_SECANT{p1}."] with precision ".
	   $ARGS_SECANT{precision}." and max ".$ARGS_SECANT{max_depth}." iterations");

    # try finding the IRR with the secant metho
    eval {
	$root = $poly->secant(%ARGS_SECANT);
    };

    if ($@) {
	# secant failed. let's make sure it was not a bug
	my $error = $poly->error;
	if ( grep( /^$error$/,
		   Math::Polynom::ERROR_NAN,
		   Math::Polynom::ERROR_DIVIDE_BY_ZERO,
		   Math::Polynom::ERROR_MAX_DEPTH,
		   Math::Polynom::ERROR_NOT_A_ROOT ) ) {
	    _debug("secant failed on with error code $error");
	} else {
	    # ok, the method did not fail, something else did
	    _crash("secant", $poly, \%ARGS_SECANT, $@);
	}

	# let's find two points where the polynomial is positive respectively negative
	my $i = 1;
	while ( (!defined $poly->xneg || !defined $poly->xpos) && $i <= $MAX_POS_NEG_POINTS ) {
	    $poly->eval( $i );
	    $poly->eval( -1+10/($i+9) );
	    $i++;
	}

	# if we did not find 2 points where the polynomial is >0 and <0, we can't use Brent's method (nor the bisection)
	if ( !defined $poly->xneg || !defined $poly->xpos ) {
	    _debug("failed to find an interval on which polynomial is >0 and <0 at the boundaries");
	    return undef;
	}

	# try finding the IRR with Brent's method
	$ARGS_BRENT{precision} = $precision;
	$ARGS_BRENT{a} = $poly->xneg;
	$ARGS_BRENT{b} = $poly->xpos;

	_debug("trying Brent's method on interval [".$ARGS_BRENT{a}."-".$ARGS_BRENT{b}."] with precision ".
	   $ARGS_BRENT{precision}." and max ".$ARGS_BRENT{max_depth}." iterations");

	eval {
	    $root = $poly->brent(%ARGS_BRENT);
	};

	if ($@) {
	    # Brent's method failed
	    $error = $poly->error;
	    if ( grep( /^$error$/,
		       Math::Polynom::ERROR_NAN,
		       Math::Polynom::ERROR_MAX_DEPTH,
		       Math::Polynom::ERROR_NOT_A_ROOT )) {
		# Brent's method was unable to approximate the root
		_debug("brent failed with error code: $error");
		return undef;
	    } else {
		# looks like a bug, either in Math::Polynom's implementation of Brent of in the arguments we sent to it
		_crash("brent", $poly, \%ARGS_BRENT, $@);
	    }
	}
    }

    if ($root == 0) {
	# that would mean IRR = infinity, which is kind of not plausible
	_debug("got 0 as the root, meaning infinite IRR. impossible.");
	return undef;
    }

    # TODO: verify IRR against cashflow
    # TODO: is the IRR impossibly large?
    # TODO: try secant with other intervals
    # TODO: calculate the number of real roots of the polynomial, find them all and choose the most relevant? or die if more than 1?

    return -1 + 1/$root;
}

1;

__END__