1package Math::Financial; 2 3# Copyright 1999 Eric Fixler <fix@fixler.com> 4# All rights reserved. This program is free software; 5# you can redistribute it and/or modify it under the same terms as Perl itself. 6 7# $Id: Financial.pm,v 1.5 1999/09/15 19:08:41 fix Exp $ 8# $Source: /www/cgi/lib/Math/RCS/Financial.pm,v $ 9 10=pod 11 12=head1 NAME 13 14Math::Financial - Calculates figures relating to loans and annuities. 15 16=head1 SYNOPSIS 17 18$calc = new Math::Financial(fv =E<gt> 100000, pv =E<gt> 1000); 19$calc-E<gt>set->(pmt => 500, ir => 8); 20 21$calc->compound_interest(find =E<gt> 'fv'); 22 23=head1 DESCRIPTION 24 25This package contains solves mathematical problems relating to loans and annuities. 26 27The attributes that are used in the equations may be set on a per-object basis, allowing 28you to run a set of different calculations using the same numbers, or they may be fed 29directly to the methods. 30 31The attribute types, accessed through the C<get> and C<set> methods are 32 33=over4 34 35=item pv =E<gt> Present Value 36 37=item fv =E<gt> Future Value 38 39=item ir =E<gt> Yearly Interest Rate (in percent) 40 41=item pmt =E<gt> Payment Amount 42 43=item np =E<gt> Number of Payments/Loan Term 44 45=item tpy =E<gt> Terms Per Year (defaults to 12) 46 47=item pd =E<gt> Payments made so far (used only for loan/annuity balances) 48 49=back 50 51Attributes are case-insensitive. The documentation for the individual methods 52indicates which attributes must be set for those methods. 53 54Calculations are based B<either> on the attributes set with the C<new> or C<set> 55methods, B<or> with arguments fed directly to the methods. This seemed like the 56least confusing way to make the interface flexible for people who are using the 57module in different ways. 58 59Also, performing a calculation 60does B<not> update the attribute of the solution. In other words, if 61you solve an equation that returns fv, the solution is returned but the 62internal fv field is unaffected. 63 64Any attempted calculation which cannot be completed -- due to either missing or 65invalid attributes -- will return C<undef>. 66 67I am interested to hear from people using this module -- let me know what 68you think about the interface and how it can be improved. 69 70=head1 METHODS 71 72=cut 73 74sub BEGIN { 75 *{__PACKAGE__.'::loan_payment'} = \&monthly_payment; 76 use strict; 77 use POSIX qw(:ctype_h); 78 use vars qw(@ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS 79 @ATTRIBUTES $DEFAULT_OBJECT $re_object); 80 $VERSION = 0.76; 81 use constant PV => 0; 82 use constant FV => 1; 83 use constant NP => 2; 84 use constant PMT => 3; 85 use constant IR => 4; 86 use constant TPY => 5; # TERMS PER YEAR 87 use constant PD => 6; 88 @ATTRIBUTES = qw(PV FV NP PMT IR TPY PD); 89 $re_object = '(?i)[a-z][\w]*?::[\w]'; 90 @ISA = qw(Exporter); 91 @EXPORT= (); 92 @EXPORT_OK = qw(loan_term loan_payment compound_interest funding_annuity 93 loan_balance loan_size simple_interest); 94 %EXPORT_TAGS = ( procedural => \@EXPORT_OK, 95 standard => \@EXPORT_OK); 96} 97 98 99sub new { 100=pod 101 102=head2 new 103 104C<$calc = new Math::Financial(); 105 106C<$calc = new Math::Financial(pv =E<gt> 10000, ir =E<gt> 5, np => 12)> 107 108Object constructor. See above for a description of the available attributes. 109You do not I<have> to set attributes here, you can also do so using C<set>, 110or feed attributes directly to the methods. 111 112There are no default values for any of the attributes except C<TPY> (Terms Per Year), 113which is 12 by default, and C<PD> which defaults to zero. 114 115If you don't want to use the object-oriented interface, see the L<EXPORTS> section 116below. 117 118=cut 119 my $class = ref($_[0]) || ($_[0] =~ /(.*?::.*)/)[0]; 120 my $parent = ref($class) ? $_[0] : [undef,undef,undef,undef,undef,12,0] ; 121 if ($class) { shift(@_); } else { $class = __PACKAGE__ ; }; 122 my $params = { pv => $parent->[PV], 123 fv => $parent->[FV], 124 ir => $parent->[IR], 125 np => $parent->[NP], 126 pmt => $parent->[PMT], 127 tpy => $parent->[TPY], 128 pd => $parent->[PD], 129 @_ }; 130 my $self = []; 131 bless($self,$class); 132 $self->set(%$params); 133 return $self; 134} 135 136 137sub _get_attribute_key { 138 # if fed a list, will return a list 139 my ($self,@args) = _get_self(@_); 140 return undef unless scalar(@args); 141 my @keys = (); 142 foreach (@args) { 143 if (isdigit($_)) { push(@keys,$_); next; }; 144 my $attrib = quotemeta($_); 145 for (my $j = 0; $j <= $#ATTRIBUTES; $j++) { 146 if ($ATTRIBUTES[$j] =~ /$attrib/i) { push(@keys,$j); next; }; 147 }; 148 push(@keys,undef); #unfound key 149 } 150 if (not($#args)) { 151 return $keys[0]; 152 } else { 153 return wantarray ? @keys : \@keys; 154 }; 155}; 156 157sub set { 158=pod 159 160=head2 set 161 162C<$calc-E<gt>set(fv =E<gt> 100000, pmt =E<gt> 500)> 163 164You can set any of the stored attributes using this method, which is is also 165called by <new>. Returns the number of attributes set. 166 167=cut 168 my ($self,@args) = _get_self(@_); 169 my $params = { @args }; 170 my ($field,$val,$key); my $count = 0; 171 while (($field, $val) = each(%$params)) { 172 $key = $self->_get_attribute_key($field); 173 if (defined($key)) { $self->[$key] = $val; $count++; } 174 } 175 return $count; 176} 177 178sub get { 179=pod 180 181=head2 get 182 183C<$calc-E<gt>get(field => 'ir')> 184 185C<$calc-E<gt>get('ir','pmt','pv')> 186 187C<$calc-E<gt>get([qw(ir pmt pv)])> 188 189You can get one or several attributes using this method. In the multiple 190attribute formats, it accepts either a list or a list reference as input. 191 192In single attribute context, returns a scalar. In multiple attribute context, 193it returns a list or a reference to a list, depending on the calling context. 194 195=cut 196 my ($self,@args) = _get_self(@_); 197 ($args[0] =~ /field/io) and shift(@args); 198 my @gets = (); 199 foreach my $field (@args) { 200 if (ref($field) eq 'ARRAY') { push(@gets,map({ $self->get($_) } @$field)) ; next; } 201 else { my $key = $self->_get_attribute_key($field); 202 push(@gets, defined($key) ? $self->[$key] : $key); next; } 203 } 204 if ($#gets) { 205 return wantarray ? @gets : \@gets; 206 } else { return $gets[0]; }; 207} 208 209 210sub compound_interest { 211=pod 212 213=head2 compound_interest 214 215C<$calc-E<gt>compound_interest> 216 217C<$calc-E<gt>compound_interest-E<gt>('fv')> 218 219C<$calc-E<gt>compound_interest-E<gt>(find =E<gt> 'fv')> 220 221Calculates compund interest for an annuity. With any 3 of pv, fv, np, and ir, 222you can always solve the fourth. 223 224Without arguments, the method will attempt to figure out what you'd like to solve 225based on what attributes of the object are defined. Usually, you'll probably want to 226explicitly request what attribute you'd like returned, which you can do using 227the second or third method. 228 229=cut 230 my ($self,@args) = _get_self(@_); 231 (scalar(@args) == 1) and unshift(@args,'find'); 232 if (scalar(@args) > 2) { 233 my $temp = __PACKAGE__->new(@args[2..$#args]); 234 return $temp->compound_interest(@args[0..1]); 235 }; 236 my $solve_for = $self->_get_attribute_key($args[1]); 237 my (@numbers,$result); 238 if (not(defined($solve_for))) { 239 if (@numbers = $self->_verify_fields(IR,PV,NP)) { $solve_for = FV; } 240 elsif (@numbers = $self->_verify_fields(IR,FV,NP)) { $solve_for = PV; } 241 elsif (@numbers = $self->_verify_fields(IR,PV,FV)) { $solve_for = NP; } 242 elsif (@numbers = $self->_verify_fields(PV,FV,NP)) { $solve_for = IR; } 243 else { return undef; }; 244 } else { 245 my @combos = (); 246 $combos[FV] = [IR,PV,NP]; $combos[PV] = [IR,FV,NP]; $combos[NP] = [IR,PV,FV]; 247 $combos[IR] = [PV,FV,NP]; 248 $set = $combos[$solve_for]; 249 @numbers = $self->_verify_fields(@$set) or return undef; 250 } 251 eval {if ($solve_for == FV) { 252 $ir = ($numbers[0]/100) / $self->[TPY]; 253 ($pv,$np) = @numbers[1,2]; 254 $result = abs($pv) * ( ($ir + 1) ** $np); 255 } elsif ($solve_for == PV) { 256 $ir = ($numbers[0]/100) / $self->[TPY]; 257 ($fv,$np) = @numbers[1,2]; 258 $result = abs($fv) * ( ($ir + 1) ** (0 - $np) ); 259 } elsif ($solve_for == NP) { 260 $ir = $numbers[0]/100/$self->[TPY]; 261 ($pv,$fv) = @numbers[1,2]; 262 my $num = log(abs($fv)/$pv); 263 my $den = log( 1 + $ir); 264 $result = $num / $den; 265 } elsif ($solve_for == IR) { 266 ($pv,$fv,$np) = @numbers; 267 $ir = (( abs($fv)/abs($pv) ) ** (1 / $np) ) - 1; 268 $result = $ir * 100 * $self->[TPY]; 269 };}; 270 271 return ($@) ? undef : $result; 272} 273 274sub funding_annuity { 275=pod 276 277=head2 funding_annuity 278 279C<$calc-E<gt>funding_annuity> 280 281C<$calc-E<gt>funding_annuity-E<gt>(pmt =E<gt> 2000, ir =E<gt> 6.50, np =E<gt> 40, tpy => 4)> 282 283C<funding_annuity> calculates how much money ( C<fv> ) you will have at the end of C<np> periods 284if you deposit C<pmt> into the account each period and the account earns C<ir> interest per year. 285 286You may want to set the C<tpy> attribute here to something other than 12, since, while loans 287usually compound monthly, annuities rarely do. 288 289=cut 290 291my ($self,@args) = _get_self(@_); 292 if (scalar(@args)) { 293 my $temp = __PACKAGE__->new(@args); 294 return $temp->funding_annuity(); 295 }; 296 my @numbers = $self->_verify_fields(IR,PMT,NP); 297 return undef unless scalar(@numbers); 298 my ($result); #solving for fv here 299 my ($pmt,$np) = @numbers[1,2]; 300 my $ir = $numbers[0]/100/$self->[TPY]; 301 eval { $result = ($pmt * ( ((1 + $ir) ** $np) - 1))/$ir; }; 302 return $@ ? undef : $result; 303 } 304 305 306sub loan_balance { 307=pod 308 309=head2 loan_balance 310 311C<$calc-E<gt>loan_balance> 312 313C<$calc-E<gt>loan_balance-E<gt>(pmt =E<gt> 2000, ir =E<gt> 6.50, np =E<gt> 360, pd =E<gt> 12)> 314 315C<loan_balance> calculates the balance on a loan that is being made in C<np> equal payments, 316given that C<pd> payments have already been made. You can also use this method to determine 317the amount of money left in an annuity that you are drawing down. 318 319=cut 320my ($self,@args) = _get_self(@_); 321if (scalar(@args)) { 322 my $temp = __PACKAGE__->new(@args); 323 return $temp->loan_balance(); 324 }; 325 my @numbers = $self->_verify_fields(IR,PMT,NP); 326 return undef unless scalar(@numbers); 327 my ($pmt,$np) = @numbers[1,2]; 328 my $ir = $numbers[0]/100/$self->[TPY]; my ($result); 329 eval { my $a = (1 + $ir) ** ($self->[PD] - $np); 330 $result = $pmt/$ir * (1 - $a) ; }; 331 return $@ ? undef : $result; 332} 333 334sub monthly_payment { 335=pod 336 337=head2 loan_payment 338 339C<$calc-E<gt>loan_payment> 340 341Return the payment amount, per period, of a loan. This is also known as amortizing. 342The ir, np, and pv fields must be set. 343 344=cut 345 my ($self,@args) = _get_self(@_); 346 if (scalar(@args)) { 347 my $temp = __PACKAGE__->new(@args); 348 return $temp->monthly_payment(); 349 }; 350 my @numbers = $self->_verify_fields(IR,PV,NP); 351 return undef unless scalar(@numbers); 352 my ($result,$ir); 353 my ($pv,$np) = @numbers[1,2]; 354 $ir = ($numbers[0]/100) / $self->[TPY]; 355 my $a = (1 + $ir) ** (0 - $np); 356 my $denominator = 1 - $a; 357 my $numerator = $pv * $ir; 358 $result = eval { $numerator / $denominator }; 359 return $@ ? undef : $result; 360} 361 362 363sub loan_size { 364=pod 365 366=head2 loan_size 367 368C<$calc-E<gt>loan_term> 369 370C<$calc-E<gt>loan_size-E<gt>(pmt =E<gt> 2000, ir =E<gt> 6.50, np =E<gt> 360)> 371 372C<loan_size> calculates the size of loan you can get based on the monthly payment 373you can afford. 374 375=cut 376 377my ($self,@args) = _get_self(@_); 378 if (scalar(@args)) { 379 my $temp = __PACKAGE__->new(@args); 380 return $temp->loan_size(); 381 }; 382 my @numbers = $self->_verify_fields(IR,PMT,NP); 383 return undef unless scalar(@numbers); 384 my ($result); 385 my ($pmt,$np) = @numbers[1,2]; 386 my $ir = $numbers[0]/100/$self->[TPY]; 387 eval { $result = ($pmt * (1 - ((1 + $ir) ** (0 - $np))))/$ir; }; 388 return $@ ? undef : $result; 389}; 390 391sub loan_term { 392=pod 393 394=head2 loan_term 395 396C<$calc-E<gt>loan_term> 397 398Return the number of payments (term) of a loan given the interest rate 399C<ir>, payment amount C<pmt> and loan amount C<pv>. The ir, pmt, and pv fields must be set. 400 401=cut 402 my ($self,@args) = _get_self(@_); 403 if (scalar(@args)) { 404 my $temp = __PACKAGE__->new(@args); 405 return $temp->loan_term(); 406 }; 407 my @numbers = $self->_verify_fields(IR,PMT,PV); 408 return undef unless scalar(@numbers); 409 my ($pmt, $pv) = @numbers[1,2]; 410 $pv = abs($pv); 411 my $ir = $numbers[0]/100/$self->[TPY]; 412 my ($result); 413 $result = eval { 414 my $numerator = log($pmt/($pmt - ($ir * $pv))); 415 my $denominator = log(1 + $ir); 416 return $numerator / $denominator; 417 }; 418 return $@ ? undef : $result; 419} 420 421 422sub simple_interest { 423=pod 424 425=head2 simple_interest 426 427C<$calc-E<gt>simple_interest> 428 429C<$calc-E<gt>simple_interest-E<gt>('ir')> 430 431C<$calc-E<gt>simple_interest-E<gt>(find =E<gt> 'ir')> 432 433This works just like compound interest, but there is no consideration of C<np>. 434With any 2 of pv, fv, and ir, you can always solve for the third. 435 436Without arguments, the method will attempt to figure out what you'd like to solve 437based on what attributes of the object have been defined. Usually, you'll probably want to 438explicitly request what attribute you'd like returned, which you can do using 439the second or third method. 440 441=cut 442 my ($self,@args) = _get_self(@_); 443 (scalar(@args) == 1) and unshift(@args,'find'); 444 if (scalar(@args) > 2) { 445 my $temp = __PACKAGE__->new(@args[2..$#args]); 446 return $temp->simple_interest(@args[0..1]); 447 }; 448 my $solve_for = $self->_get_attribute_key($args[1]); 449 my (@numbers,$ir,$pv,$pmt,$result); 450 if (not(defined($solve_for))) { 451 if (@numbers = $self->_verify_fields(IR,PV)) { $solve_for = PMT; } 452 elsif (@numbers = $self->_verify_fields(IR,PMT)) { $solve_for = PV; } 453 elsif (@numbers = $self->_verify_fields(PMT,PV)) { $solve_for = IR; } 454 else { return undef; }; 455 } else { 456 my @combos = (); 457 $combos[PV] = [IR,PMT]; $combos[IR] = [PMT,PV]; $combos[PMT] = [IR,PV]; 458 $set = $combos[$solve_for]; 459 @numbers = $self->_verify_fields(@$set) or return undef; 460 } 461 # equations go here 462 if ($solve_for == PMT) { 463 $result = $numbers[1] * ($numbers[0]/100); 464 } elsif ($solve_for == PV) { 465 eval { $result = $numbers[1]/($numbers[0]/100); }; 466 } elsif ($solve_for == IR) { 467 eval { $result = ($numbers[0]/$numbers[1]) * 100; }; 468 } 469 return ($@) ? undef : $result; 470} 471 472sub _get_self { 473 my $self = (ref($_[0]) !~ /$re_object/o) ? $DEFAULT_OBJECT ||= new __PACKAGE__ : shift(@_) ; 474 return($self,@_); 475} 476 477sub _verify_fields { 478 my ($self,@args) = _get_self(@_); 479 my @defined = grep(/[0-9]/, @$self[@args]); 480 return (scalar(@defined) == scalar(@args)) ? @defined : (); 481} 482 483 4841; 485 486__END__ 487 488=pod 489 490=head1 REQUIRES 491 492POSIX -- c_type functions 493 494(c_types might work under Windows. I really don't know. I'd appreciate it if someome 495would let me know. If they don't, in a future release, 496I'll provide a runtime replacement for the POSIX functions so it'll work on Win releases. ) 497 498=head1 EXPORTS 499 500By default, nothing. 501 502If you'd like to use a procedural interface, you can C<use Math::Financial qw(:standard)>. 503 504Then you can call the methods as function, without an object reference, like 505 506C<$term = loan_term(ir =E<gt> 6.5, pmt =E<gt> 1000, pv =E<gt> 200000);> 507 508All of the methods are exported in this fashion, except for C<set> and C<get>; this 509just seemed too confusing. 510 511You can still use the facility of C<set> and C<get> with the procedural interface (i.e., you 512can set the attributes and them use them for many different calculations), but you 513must call them as C<Math::Financial::set> and C<Math::Financial::get>. 514 515=head1 AUTHOR 516 517Eric Fixler <fix@fixler.com>, 1999 518 519=head1 TODO 520 521Add more equations! Send me equations and I'll put them in. 522 523 524=head1 ACKNOWLEDGEMENTS 525 526Larry Freeman, whose Financial Formulas Page 527C<http://ourworld.compuserve.com/homepages/Larry_Freeman/finance.htm> 528was essential for this project. 529 530=cut 531 532#$Log: Financial.pm,v $ 533#Revision 1.5 1999/09/15 19:08:41 fix 534#Added :standard EXPORT group. Added a few lines of documentation. 535# 536#Revision 1.4 1999/09/15 18:49:01 fix 537#Changed some syntax so it'll work with perl 5.004. 538#Fixed an error in the loan_term method 539# 540