Annuity calculation/process.pl
From Organic Design wiki
#!/usr/bin/perl -w
use strict;
use CGI::Lite;
# 1) Setup
print "Content-type: text/html\n\n";
my $Lite = new CGI::Lite;
my %form_data = $Lite -> parse_form_data($ENV{'REQUEST_METHOD'});
if(exists $form_data{debug})
{
print "=============== DEBUG ==============<br />";
foreach( keys %form_data)
{
print "$_ => $form_data{$_}<br />";
}
print "====================================<br />";
}
my ($i, $ip, $n, $p, $C,$roundup)=(0.0685,12, 25, 52, 106000,0);
($form_data{"i"}) && ($i = $form_data{i});
($form_data{"ip"}) && ($i = &ip_to_i($form_data{"i"}, $form_data{"ip"}));
($form_data{"n"}) && ($n = $form_data{n});
($form_data{"p"}) && ($p = $form_data{p});
($form_data{"C"}) && ($C = $form_data{C});
($form_data{"roundup"}) && ($roundup = $form_data{"roundup"});
my %period_name =
(
12 => "month",
26 => "fortnight",
52 => "week",
);
my $period;
($period_name{$p}) ? ($period = $period_name{$p}) : ($period = "period");
my $table = &repayment_schedule(i=>$i, n=>$n, p=>$p, C=>$C, roundup => $roundup);
#print $table;
print qq(<html bgcolor="white">\n);
&print_table($table);
print qq(</html>);
sub print_table
{
my $table = shift;
my @seq = 0 .. $#{$table->[2]};
my $append=0;
my ($interest_sum, $capital_sum, $payments_sum) = (0,0,0);
# Calculate totals
foreach my $i (@seq)
{
$interest_sum += $table->[1]->[$i];
$capital_sum += $table->[2]->[$i];
$payments_sum += $table->[3];
}
$interest_sum = sprintf("%10.2f", $interest_sum);
$capital_sum = sprintf("%10.2f", $capital_sum);
$payments_sum = sprintf("%10.2f", $payments_sum);
if(scalar @seq >20)
{
my $end = $#seq;
@seq = (@seq[0..9], @seq[($end-9) ..$end]);
$append=1;
}
$i = sprintf("%1.5f", $i);
my $i_12 = sprintf("%1.5f",&i_to_ip(i=>$i,p=>12));
my $i_26 = sprintf("%1.5f",&i_to_ip(i=>$i,p=>26));
my $i_52 = sprintf("%1.5f",&i_to_ip(i=>$i,p=>52));
print qq(<table bgcolor="#EEEEEE" border=0 cellspacing=0 cellpadding=2><tr>
<td>i_52 (weekly)</td>
<td> </td>
<td>i_26 (fortnightly)</td>
<td> </td>
<td>i_12 (monthly)</td>
<td> </td>
<td>i (effective) </td>
</tr>
<tr>
<td>$i_52</td>
<td> < </td>
<td>$i_26</td>
<td> < </td>
<td>$i_12</td>
<td> < </td>
<td>$i</td>
</tr></table>);
# Printing details
print qq(term=$n \(yrs\)<br /> payments=$p \(${period}ly\) <br /> Capital=$C <br />);
print qq(<table border=0 cellspacing=0 cellpadding=2>\n);
print qq(<tr bgcolor="#EEEEEE"><td>nth payment</br>in arrears</td>
<td>Loan outstanding at </br> start of nth $period</td><td>
Interest due at </br> end of nth $period</td><td>
Capital repaid at </br> end of nth $period</td><td>
Repayment each </br>nth $period</td><tr>\n);
my $color="#FFFFFF";
foreach my $i (@seq)
{
format STDOUT =
<tr align="right" bgcolor="@||||||"><td> @########## </td><td> @#########.## </td><td> @#########.## </td><td>@#########.## </td><td> @#########.##</td></tr>
$color, $i+1, $table->[0]->[$i], $table->[1]->[$i], $table->[2]->[$i], $table->[3]
.
if($color eq "#FFFFFF")
{
write;
$color = "#EEEEEE";
}else
{
write;
$color="#FFFFFF";
};
if($append && $i==9)
{
print qq(<tr align="right" bgcolor="#FFFFFF"><td>... </td><td>... </td><td>... </td><td>... </td><td>... </td><tr>\n);
}
}
printf qq(<tr align="right" bgcolor="#FFFFFF"><td align="center" colspan=2>Totals</td><td>$interest_sum</td><td>$capital_sum</td><td>$payments_sum</td></tr>);
print qq(</table>\n);
# foreach(@{$table->[2]}){$a+=$_}
}
sub i_to_ip
{
my %params = (
i => 0.0685,
p => 52,
@_,
);
my $i = $params{"i"};
my $p = $params{"p"};
my $ip = (((1+$i)**(1/$p))-1)*$p;
return $ip;
}
sub Anp
{
my %params = (
i => 0.0685,
n => 25,
p => 52,
@_,
);
my $i = $params{"i"};
my $n = $params{"n"};
my $p = $params{"p"};
my $v = 1/(1+$i);
my $ip = &i_to_ip(i=>$i,p=>$p);
my $Anp = (1-$v**$n)/$ip;
return $Anp
}
sub repayment_schedule
{
my %params = (
i=>0.0685,
n=>25,
p=>52,
C=>106000,
roundup => 0,
@_,
);
my $i = $params{"i"};
my $n = $params{"n"};
my $p = $params{"p"};
my $C = $params{"C"};
my $roundup = $params{"roundup"};
my $ip = &i_to_ip(i=>$i, p=>$p);
my $Anp = &Anp(i=>$i, n=>$n, p=>$p);
my $np = $n * $p;
my $payment = $C/($Anp*$p);
if($roundup)
{
$payment = &roundup($payment);
}
my @loan = ($C);
my @interest;
my @capital;
my ($loan_sum, $interest_sum, $capital_sum) = (0,0,0);
foreach(1 .. $np)
{
push(@interest, $loan[-1] * $ip/$p);
push(@capital, $payment - $loan[-1] * $ip/$p);
push(@loan, $loan[-1] * (1+$ip/$p) - $payment);
}
return [\@loan, \@interest, \@capital, $payment];
}
sub roundup
{
my $value = shift;
$value =~ m/(\d+\.\d{2})(\d)/;
if($2)
{
$value = $1+0.01;
}
return $value;
}
sub ip_to_i
{
my $ip = shift;
my $p = shift;
my $i = (1 + $ip/$p)**$p -1;
return $i;
}
