File Coverage

blib/lib/Finance/Performance/Calc.pm

Criterion	Covered	Total	%
statement	60	72	83.3
branch	16	22	72.7
condition			n/a
subroutine	11	11	100.0
pod	4	5	80.0
total	91	110	82.7

package Finance::Performance::Calc;

use 5.006001;
use strict;
use warnings;

require Exporter;

our @ISA = qw (Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw (ROR
				    link_ROR
				    ized_ROR
				    return_percentages
				    trace
				   ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw ();
our $VERSION = '1.01';

use Carp;

my %CFG = (
	   return_percentages => 0,
	   trace => 0
	  );

sub return_percentages {
    my $retval = $CFG{'return_percentages'};
    $CFG{'return_percentages'} = $_[0] if scalar(@_);
    return $retval;
}

sub trace {
    my $retval = $CFG{'trace'};
    $CFG{'trace'} = $_[0] if scalar(@_);
    return $retval;
}

sub ROR {
    if(scalar(@_) == 2) {
	## ($bmv, $emv) = ($_[0],$_[1]);
	if($CFG{'trace'}) {
	    print "ROR Trace: Perf calc #1 of 1:\n";
	    print "BMV = $_[0]\n";
	    print "EMV = $_[1]\n";
	    print "ROR = " . _decimal_to_pct(($_[1]-$_[0])/$_[0]) . " ( (EMV - BMV)/BMV, ($_[1]-$_[0])/$_[0] )\n";
	}
	return _decimal_to_pct(($_[1]-$_[0])/$_[0]);
    }

    ## Validate args
    my %args = @_;
    if (!defined($args{'bmv'})) {
	push @{$args{'errs'}}, "Required argument 'bmv' not specified";
    }
    if (!defined($args{'emv'})) {
	push @{$args{'errs'}}, "Required argument 'emv' not specified";
    }
    if ($args{'errs'}) {
	croak join("\n",@{$args{'errs'}});
    }

    my @rors = ();

    ## Treat bmv and emv as cash flow zero events at the boundry points.
    unshift @{$args{'flows'}},{mvpcf=>$args{'bmv'},cf=>0.0};
    push    @{$args{'flows'}},{mvpcf=>$args{'emv'},cf=>0.0};

    my $idx = undef;
    for (my $i = 0;$i

	## If you are looking for optimizations, don't bother trying
	## to replace the 'my' vars. I tried it, it wasn't faster.
	my $bmv = $args{'flows'}->[$i]->{mvpcf} + $args{'flows'}->[$i]->{cf};
	my $emv = $args{'flows'}->[$i+1]->{mvpcf};
	push @rors, ($emv - $bmv)/$bmv;
	if($CFG{'trace'}) {
	    print "ROR Trace: Perf calc #" . ($i+1) . " of " . (scalar(@{$args{'flows'}})-1) . ":\n";
	    print "BMV = $bmv (mvpcf $args{'flows'}->[$i]->{mvpcf} + cf $args{'flows'}->[$i]->{cf})\n";
	    print "EMV = $emv (mvpcf $args{'flows'}->[$i+1]->{mvpcf})\n";
	    print "ROR = $rors[-1] ( (EMV - BMV)/BMV, ($emv - $bmv)/$bmv )\n";
	}
    }
    return link_ROR(@rors);
}

sub link_ROR {
    ## Use @_ and save the memcopys.
    ## my @returns = @_;
    my $ror = (map{$_+1.00} map{_pct_to_decimal($_)} shift )[0];
    my $idx = 1;
    for(map{$_+1.00} map{_pct_to_decimal($_)} @_) {
	print "Link @{[$idx++]} of @{[scalar(@_)]}: $ror * $_ = " if ($CFG{'trace'});
	$ror *= $_;
	print "$ror\n" if ($CFG{'trace'});
    }
    return _decimal_to_pct($ror - 1.0);
}

sub ized_ROR {
    ## Save the memory copy by using @_
    ## my ($ror,$periods) = ($_[0],$_[1])
    return _decimal_to_pct(((_pct_to_decimal($_[0])+1.0) ** (1.0/$_[1]))-1);
}

sub _pct_to_decimal {
    my $decimal = $_[0];
    $decimal =~ s|(.*)%|$1/100.|e;
    return $decimal;
}

sub _decimal_to_pct {
    return ($CFG{'return_percentages'}
	    ? ($_[0] * 100) . '%'
	    : $_[0]);
}

1;
__END__