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