LJ Archive

Listing 1. irr.pl

#!/usr/bin/perl
require 5.003;
use strict;
die "Usage: irr_del <data file>\n" if $#ARGV < 0;
my $iters_max   = 20;   # maximum number of
         # iterations
my $epsilon     = 1.0e-6; # jump out of loop
         # if change < $epsilon
my $u           = 0.0;  # initial guess.
interest = exp(-$u) - 1
my(@pos_d, @pos_t, @neg_d, @neg_t, $dollars,
   $time, $pos, $d_pos, $neg,
   $d_neg, $iters, $delta, $i, $tmp);

while(<>) {
   chomp;
   ($dollars, $time) = split;
   write;
   switch:
   {
   push(@pos_d,  $dollars), push(<pos_t, $time),
      last if $dollars > 0.0;
   push(@neg_d, -$dollars), push(@neg_t, $time),
       last if $dollars < 0.0;
   die "Dollar amount cannot = \$0.00 !...\n";
   }
}
die "\nCan't calculate. Need income AND expenses!\n="
unless $#pos_d >= 0 and $#neg_d >= 0;

for($iters = $iters_max; $iters > 0; $iters--) {
   $pos = $d_pos = $neg = $d_neg = 0.0;
   for($i = 0; $i <= $#pos_d; $i++) {
   $pos   += ($tmp = $pos_d[$i] *
      exp($u * $pos_t[$i]));
   $d_pos += $tmp * $pos_t[$i];
   }
   for($i = 0; $i <= $#neg_d; $i++) {
   $neg   += ($tmp = $neg_d[$i] *
      exp($u * $neg_t[$i]));
   $d_neg += $tmp * $neg_t[$i];
   }
   $delta = log($neg / $pos) / ($d_neg /
       $neg - $d_pos / $pos);
   last if abs($delta) < $epsilon; # Newton
            # converged
   $u -= $delta;     # next guess
}
if($iters > 0) {
   printf "\nIRR = %.4f%% (discrete) = %.4f%% ",
   printf "(continuous) after %u "
   printf "iteration%s.\n",
   100.0 * (exp(-$u) - 1.0), -100 * $u,
   $iters_max - $iters + 1,
   $iters_max - $iters == 0 ? '' : 's';
} else {
   printf "irr doesn't converge in $iters_max",
   printf " iterations\n";
}

format STDOUT_TOP =
   Income($)     Time (yr)
   =========     =========
.

format STDOUT =
@######.##      @##.##
$dollars,       $time
.
LJ Archive