File Coverage

blib/lib/Business/US_Amort.pm
Criterion Covered Total %
statement 72 124 58.0
branch 20 50 40.0
condition 2 9 22.2
subroutine 9 16 56.2
pod 7 8 87.5
total 110 207 53.1


line stmt bran cond sub pod time code
1              
2             # Time-stamp: "2004-12-29 19:56:54 AST" -*-perl-*-
3              
4             require 5;
5             package Business::US_Amort; # This is a class
6 2     2   14161 use strict;
  2         6  
  2         92  
7 2     2   11 use vars qw($VERSION $Debug %Proto);
  2         4  
  2         134  
8 2     2   18 use Carp;
  2         8  
  2         648  
9              
10             $Debug = 0 unless defined $Debug;
11             $VERSION = "0.09";
12              
13             ###########################################################################
14              
15             =head1 NAME
16              
17             Business::US_Amort - class encapsulating US-style amortization
18              
19             =head1 SYNOPSIS
20              
21             use Business::US_Amort;
22             my $loan = Business::US_Amort->new;
23             $loan->principal(123654);
24             $loan->interest_rate(9.25);
25             $loan->term(20);
26            
27             my $add_before_50_amt = 700;
28             sub add_before_50 {
29             my $this = $_[0];
30             if($this->{'_month_count'} == 50) {
31             $this->{'_monthly_payment'} += $add_before_50_amt;
32             }
33             }
34             $loan->callback_before_monthly_calc(\&add_before_50);
35             $loan->start_date_be_now;
36            
37             $loan->run;
38             $loan->dump_table;
39            
40             print "Total paid toward interest: ", $loan->total_paid_interest, "\n";
41              
42             =head1 DESCRIPTION
43              
44             This class encapsulates amortization calculations figured according to
45             what I've been led to believe is the usual algorithm for loans in the USA.
46              
47             I used to think amortization was simple, just the output of an algorithm
48             that'd take just principle, term, and interest rate, and return the
49             monthly payment and maybe something like total paid toward interest.
50             However, I discovered that there's a need for loan calculations where,
51             say, between the 49th and 50th month, your interest rate drops, or where
52             you decide to add $100 to your monthly payment in the 32nd month.
53              
54             So I wrote this class, so that I could amortize simply in simple cases
55             while still allowing any kind of strangeness in complex cases.
56              
57             =cut
58              
59             #===========================================================================
60              
61             =head1 FUNCTIONS
62              
63             This module provides one function, which is a simple amortizer.
64             This is just to save you the bother of method calls when you
65             really don't need any frills.
66              
67             =over
68              
69             =item Business::US_Amort::simple $principal, $interest_rate, $term
70              
71             Amortizes based on these parameters. In a scalar context,
72             returns the initial monthly payment.
73              
74             In an array context, returns a three-item list consisting of:
75             the initial monthly payment, the total paid toward interest,
76             and the loan object, in case you want to do things with it.
77              
78             =back
79              
80             Example usages:
81              
82             $monthly_payment = Business::US_Amort::simple(123654, 9.25, 20);
83            
84             ($monthly_payment, $total_toward_interest, $o)
85             = Business::US_Amort::simple(123654, 9.25, 20);
86              
87             Of course, if you find yourself doing much of anything with the
88             loan object, you probably should be using the OOP interface instead
89             of the functional one.
90              
91             =cut
92              
93             sub simple ($$$) {
94 1     1 1 129 my($p, $i, $t) = @_[0,1,2];
95 1         10 my $o = Business::US_Amort->new;
96 1         8 $o->principal($p);
97 1         5 $o->interest_rate($i);
98 1         5 $o->term($t);
99              
100 1 50       6 $o->run || croak("Error while amortizing: " . $o->error . "\n");
101            
102             return
103             wantarray ?
104 1 50       7 ($o->initial_monthly_payment, $o->total_paid_interest, $o)
105             : $o->initial_monthly_payment
106             ;
107             }
108              
109             #===========================================================================
110              
111             =head1 OBJECT ATTRIBUTES
112              
113             All attributes for this class are scalar attributes. They can be read via:
114              
115             $thing = $loan->principal OR $thing = $loan->{'principal'}
116              
117             or set via:
118              
119             $loan->principal(VALUE) OR $loan->{'principal'} = VALUE
120              
121              
122             =head2 MAIN ATTRIBUTES
123              
124             These attributes are used as parameters to the C method.
125              
126             =over
127              
128             =item principal
129              
130             The principal amount of the loan.
131              
132             =item interest_rate
133              
134             The annual rate, expressed like 8.3, not like .083.
135              
136             Note that if you're defining callbacks, you can change this attribute
137             at any time in your callbacks, to change the rate of interest from
138             then on.
139              
140             =item term
141              
142             The term of the loan, in years, not months.
143              
144             =item callback_before_monthly_calc
145              
146             If set, this should be a coderef to a routine to call at the B
147             of each month, B calculations are done.
148             The one parameter passed to this routine, in $_[0], is the object.
149             See the SYNOPSIS, above, for an example.
150              
151             =item callback_after_monthly_calc
152              
153             If set, this should be a coderef to a routine to call at the B
154             of each month, B monthly calculations are done.
155             The one parameter passed to this routine, in $_[0], is the object.
156              
157             =item block_table
158              
159             If set to true, this inhibits C from adding to C. (This
160             is false by default.) If you're not going to access C, set this
161             to true before calling C -- it'll speed things up and use less
162             memory.
163              
164             =item start_date
165              
166             If set to a date in the format "YYYY-MM", C<_date> will be defined
167             appropriately for each month. You can set C to the current
168             month by just saying $loan->start_date_be_now.
169              
170             =item cent_rounding
171              
172             If set to true, figures are rounded to the nearest cent at appropriate
173             moments, so as to avoid having to suppose that the debtor is to make a
174             monthly payment of $1025.229348723948 on a remaining principal of
175             $196239.12082309123408, or the like.
176              
177             =back
178              
179             These attributes are set by the C method:
180              
181             =over
182              
183             =item initial_monthly_payment
184              
185             The monthly payment that follows from the basic amortization parameters
186             given. Compare with C<_monthly_payment>.
187              
188             =item total_paid_interest
189              
190             The total amount paid toward interest during the term of this loan.
191              
192             =item total_month_count
193              
194             The total number of months the loan took to pay off.
195             E.g., "12" for a loan that took 12 months to pay off.
196              
197             =item table
198              
199             This will be a reference to a list of copies made of the object
200             ("snapshots") each month. You can then use this if you want to
201             generate a dump of particular values of the object's state in
202             each month.
203              
204             Note that snapshots have their C attribute set to true,
205             and have their C attribute set to undef. (Otherwise this'd be
206             a circular data structure, which would be a hassle for you and me.)
207              
208             =item error
209              
210             A string explaining any error that might have occurred, which would/should
211             accompany C returning 0. Use like:
212              
213             $loan->run or die("Run failed: " . $loan->error);
214              
215             =back
216              
217             Other attributes:
218              
219             =over
220              
221             =item am_snapshot
222              
223             This attribute is set to true in snapshots, as stored in C.
224              
225             =item _month_count_limit
226              
227             This is a variable such that if the month count ever exceeds this
228             amount, the main loop will abort. This is intended to keep the
229             iterator from entering any infinite loops, even in pathological cases.
230             Currently the C method sets this to twelve plus twice the number
231             of months that it's expected this loan will take.
232             Increase as necessary.
233              
234             =back
235              
236             =head2 ITERATION ATTRIBUTES
237              
238             These are attributes of little or no interest once C is done, but
239             may be of interest to callbacks while C is running, or may
240             be of interest in examining snapshots in C.
241              
242             =over
243              
244             =item _month_count
245              
246             This is how many months we are into the loan. The first month is 1.
247              
248             =item _abort
249              
250             If you want callbacks to be able to halt the iteration for some
251             reason, you can have them set C<_abort> to true. You may also choose
252             to set C to something helpful.
253              
254             =item _monthly_payment
255              
256             The amount to be paid to toward the principal each month. At the start
257             of the loan, this is set to whatever C is
258             figured to be, but you can manipulate C<_monthly_payment> with
259             callbacks to change how much actually gets paid when.
260              
261             =item _remainder
262              
263             The balance on the loan.
264              
265             =item _date
266              
267             The given month's date, if known, in the format "YYYY-MM". Unless you'd
268             set the C to something, this will be undef.
269              
270             =item _h
271              
272             The interest to be paid this month.
273              
274             =item _old_amount
275              
276             What the remainder was before we made this month's payment.
277              
278             =item _c
279              
280             The current monthly payment, minus the monthly interest, possibly
281             tweaked in the last month to avoid paying off more than is actually left
282             on the loan.
283              
284             =back
285              
286             =cut
287              
288             ###########################################################################
289              
290             %Proto = # public attributes and their values
291             (
292             principal => 0,
293             interest_rate => 8, # annual, percent
294             term => 30, # years (target term)
295             error => '',
296             cent_rounding => 1,
297             start_date => undef,
298              
299             initial_monthly_payment => undef,
300             total_paid_interest => undef,
301             total_month_count => undef,
302              
303             am_snapshot => 0, # flag for objects that are snapshots
304             block_table => 0, # set to 1 to block table generation
305              
306             table => undef,
307             callback_before_monthly_calc => undef,
308             callback_after_monthly_calc => undef,
309              
310             _month_count_limit => undef,
311             _abort => undef,
312             _remainder => undef,
313             _date => undef,
314             _h => undef,
315             _old_amount => undef,
316             _monthly_payment => undef,
317             );
318              
319             #===========================================================================
320             # make accessors -- just simple scalar accessors
321             foreach my $k (keys %Proto) { # attribute method maker
322 2     2   9 no strict 'refs';
  2         4  
  2         2966  
323             *{$k} = sub {
324 4     4   9 my $it = shift @_;
325 4 100       19 return ($it->{$k} = $_[0]) if @_;
326 1         97 return $it->{$k};
327             }
328             unless defined &{$k}
329             }
330              
331             #--------------------------------------------------------------------------
332             # the usual doofy service methods
333              
334             =head1 METHODS
335              
336             =over
337              
338             =item $loan = Business::US_Amort->new
339              
340             Creates a new loan object.
341              
342             =cut
343              
344             sub new { # constructor
345 1     1 1 4 my $class = shift @_;
346 1   33     12 $class = ref($class) || $class;
347 1         30 return bless { %Proto, @_ }, $class;
348             }
349              
350             =item $loan->copy
351              
352             Copies a loan object or snapshot object. Also performs a somewhat
353             deep copy of its table, if applicable.
354              
355             =cut
356              
357             sub copy { # duplicator
358 0     0 1 0 my $this = shift @_;
359 0 0       0 return $this->new unless ref($this);
360              
361 0         0 my $new = bless { %$this }, ref($this);
362            
363 0 0       0 if(ref($new->{'table'})) {
364 0         0 $new->{'table'} =
365             [ # copy listref
366             map( bless({ %$_ }, ref($_)), # copy hashref
367 0         0 @{ $new->{'table'} }
368             )
369             ]
370             ;
371             } # copy the list of hashrefs
372            
373 0         0 return $new;
374             }
375              
376             =item $loan->destroy
377              
378             Destroys a loan object. Probably never necessary, given Perl's garbage
379             collection techniques.
380              
381             =cut
382              
383             sub destroy { # destructor
384 0     0 1 0 my $this = @_;
385 0 0       0 return unless ref($this);
386 0         0 %$this = ();
387 0         0 bless $this, 'DEAD';
388 0         0 return;
389             }
390 0     0   0 sub DEAD::destroy { return }
391              
392              
393             #===========================================================================
394              
395             =item $loan->start_date_be_now
396              
397             This sets C to the current date, based on C<$^T>.
398              
399             =cut
400              
401             sub start_date_be_now {
402 0     0 1 0 my $this = $_[0];
403 0         0 $this->{'start_date'} = &__date_now;
404             }
405              
406             #===========================================================================
407              
408             sub maybe_round {
409 123     123 0 216 my $this = $_[0];
410 123 50       681 return $this->{'cent_rounding'} ? (0 + sprintf("%.02f", $_[1])) : $_[1];
411             }
412              
413             #===========================================================================
414              
415             =item $loan->run
416              
417             This performs the actual amortization calculations.
418             Returns 1 on success; otherwise returns 0, in which case you should
419             check the C attribute.
420              
421             =cut
422              
423             sub run {
424 1     1 1 2 my $this = $_[0];
425 1 50       5 croak "Can't call loan->run() on a snapshot" if $this->{'am_snapshot'};
426 1         3 $this->{'error'} = '';
427            
428             # not a whole lot of sanity checking here
429              
430 1 50       5 unless($this->{'principal'} > 0) {
431 0         0 $this->{'error'} = 'principal must be positive and nonzero';
432 0         0 return 0;
433             }
434              
435 1         6 $this->{'_remainder'} = $this->maybe_round( $this->{'principal'} ); # AKA "p"
436              
437 1 50       4 unless($this->{'interest_rate'} >= 0) {
438 0         0 $this->{'error'} = 'interest rate must be nonnegative';
439 0         0 return 0;
440             }
441              
442 1         4 $this->{'term'} = abs($this->{'term'} + 0);
443 1 50       3 unless($this->{'term'}) {
444 0         0 $this->{'error'} = 'term must be positive and nonzero';
445 0         0 return 0;
446             }
447              
448             # The only real voodoo is here:
449 1         3 my $j = # monthly interest rate in decimal -- in percent, not like .0875
450             $this->{'interest_rate'} / 1200;
451 1         4 my $n = # number of months the loan is amortized over
452             int($this->{'term'} * 12);
453              
454             #print "j: $j\n";
455 1 50       3 if($j) {
456             #print "Nonzero interest\n";
457 1         39 $this->{'initial_monthly_payment'} =
458             $this->maybe_round(
459             $this->{'_remainder'} * $j / ( 1 - (1 + $j) ** (-$n) )
460             );
461             } else {
462             # interest-free loan -- much simpler calculation
463 0         0 $this->{'initial_monthly_payment'} =
464             $this->maybe_round(
465             $this->{'_remainder'} / $n
466             );
467             }
468             # ...the rest is just iteration
469              
470             # init...
471 1         4 $this->{'table'} = []; # clear
472 1         2 $this->{'total_paid_interest'} = 0;
473 1         3 $this->{'_monthly_payment'} = $this->{'initial_monthly_payment'};
474             # this can vary if the user starts tweaking it
475 1         3 $this->{'_month_count'} = 0;
476 1   50     8 $this->{'_date'} = $this->{'start_date'} || undef;
477 1 50       6 $this->{'_month_count_limit'} = $n * 2 + 12
478             unless defined $this->{'_month_count_limit'};
479             # throw an error if our _month_count ever hits this
480              
481 1         2 my $last_month_date;
482 1         17 while($this->{'_remainder'} >= 0.01) { # while there's more than a cent left
483 61         58 ++$this->{'_month_count'};
484 61         91 $this->{'_old_amount'} = $this->{'_remainder'};
485              
486             # maybe call the 'before' callback
487 61 50       114 if($this->{'callback_before_monthly_calc'}) {
488 0         0 my @list = ($this);
489 0         0 &{$this->{'callback_before_monthly_calc'}}(@list);
  0         0  
490             }
491 61 50 0     101 if($this->{'_abort'}) { $this->{'error'} ||= "Abort flag set."; return 0 }
  0         0  
  0         0  
492              
493             # and now all the calcs for this month
494 61         170 $this->{'_h'} = $this->maybe_round( $this->{'_remainder'}
495             * $this->{'interest_rate'} / 1200
496             );
497 61         88 $this->{'total_paid_interest'} += $this->{'_h'};
498              
499 61         90 $this->{'_c'} = $this->{'_monthly_payment'} - $this->{'_h'};
500              
501 61 100       105 if($this->{'_remainder'} > $this->{'_c'}) { # normal case
502 60         117 $this->{'_remainder'} = $this->maybe_round($this->{'_remainder'}
503             - $this->{'_c'});
504             } else { # exceptional end case
505 1         2 $this->{'_c'} = $this->{'_remainder'};
506 1         1 $this->{'_remainder'} = 0;
507             }
508              
509             # maybe take a snapshot
510 61 50       128 unless($this->{'block_table'}) {
511 61         781 my $snapshot = bless {%$this}, ref($this); # lame-o copy
512             # Entries in the table are just snapshots of the object, minus 'table',
513             # and plus a few other things:
514 61         142 $snapshot->{'table'} = undef;
515 61         69 $snapshot->{'am_snapshot'} = 1;
516 61         55 push @{$this->{'table'}}, $snapshot;
  61         171  
517             }
518              
519             # maybe call the 'after' callback.
520 61 50       120 if($this->{'callback_after_monthly_calc'}) {
521 0         0 my @list = ($this);
522 0         0 &{$this->{'callback_after_monthly_calc'}}(@list);
  0         0  
523             }
524 61 50 0     104 if($this->{'_abort'}) { $this->{'error'} ||= "Abort flag set."; return 0; }
  0         0  
  0         0  
525              
526 61 50       125 if($this->{'_month_count'} > $this->{'_month_count_limit'}) {
527 0         0 $this->{'error'} = "_month_count_limit exceeded!";
528 0         0 return 0;
529             }
530 61         70 $last_month_date = $this->{'_date'};
531 61 50       163 $this->{'_date'} = &__inc_date($this->{'_date'})
532             if defined($this->{'_date'});
533             }
534 1         4 $this->{'_date'} = $last_month_date; # a hack
535            
536 1         2 $this->{'total_month_count'} = $this->{'_month_count'};
537              
538             # 'total_paid_interest' and 'total_month_count' hold useful values
539             # now
540              
541 1         9 return 1;
542             }
543              
544             #===========================================================================
545              
546             =item $loan->dump_table
547              
548             This method dumps a few fields selected from snapshots in the C
549             of the given object. It's here more as example code than as anything
550             particularly useful. See the source. You should be able to use this
551             as a basis for making code of your own that dumps relevant fields from
552             the contents of snapshots of loan objects.
553              
554             =cut
555              
556             sub dump_table {
557 0     0 1   my $this = $_[0];
558 0 0         return unless ref $this->{'table'}; # no table!
559 0           foreach my $line (@{$this->{'table'}}) {
  0            
560             # iterate over snapshots
561 0           printf
562             "%s (#% 4d) | % 12.2f || % 10.2f | % 10.2f || % 12.2f\n",
563             map($line->{$_},
564             '_date',
565             '_month_count',
566             '_old_amount',
567             '_h',
568             '_c',
569             '_remainder'
570             )
571             ;
572             }
573 0           return;
574             }
575             #===========================================================================
576              
577             =back
578              
579             =head1 REMEMBER
580              
581             When in panic or in doubt, run in circles, scream and shout.
582              
583             Or read the source. I really suggest the latter, actually.
584              
585             =head1 WARNINGS
586              
587             * There's little or no sanity checking in this class. If you want
588             to amortize a loan for $2 at 1% interest over ten million years,
589             this class won't stop you.
590              
591             * Perl is liable to produce tiny math errors, like just about any
592             other language that does its math in binary but has to convert to and
593             from decimal for purposes of human interaction. I've seen this
594             surface as tiny discrepancies in loan calculations -- "tiny" as in
595             less than $1 for even multi-million-dollar loans amortized over
596             decades.
597              
598             * Moreover, oddities may creep in because of round-off errors. This
599             seems to result from the fact that the formula that takes term,
600             interest rate, and principal, and returns the monthly payment, doesn't
601             know that a real-world monthly payment of "$1020.309" is impossible --
602             and so that ninth of a cent difference can add up across the months.
603             At worst, this may cause a 30-year-loan loan coming to term in 30
604             years and 1 month, with the last payment being needed to pay off a
605             balance of two dollars, or the like.
606              
607             These errors have never been a problem for any purpose I've
608             put this class to, but be on the look out.
609              
610             =head1 DISCLAIMER
611              
612             This program is distributed in the hope that it will be useful,
613             but B; without even the implied warranty of
614             B or B.
615              
616             But let me know if it gives you any problems, OK?
617              
618             =head1 COPYRIGHT
619              
620             Copyright 1999-2002, Sean M. Burke C, all rights
621             reserved. This program is free software; you can redistribute it
622             and/or modify it under the same terms as Perl itself.
623              
624             =head1 AUTHOR
625              
626             Sean M. Burke C
627              
628             =cut
629              
630              
631             # stuff...
632              
633             sub __date_now {
634 0     0     my $now;
635 0 0         $now = @ARGV ? $_[0] : $^T;
636 0           my($m, $y) = (localtime($now))[4,5];
637 0           return sprintf("%04d-%02d", $y + 1900, $m + 1);
638             }
639              
640             #===========================================================================
641              
642             sub __inc_date {
643 0     0     my $in_date = $_[0];
644 0           my($year, $month);
645 0 0         return "2000-01" unless $in_date =~ /^(\d\d\d\d)-(\d\d)/s;
646 0           ($year, $month) = ($1, $2);
647              
648 0 0         if(++$month > 12) {
649 0           $month = 1;
650 0           $year++;
651             }
652 0           return sprintf("%04d-%02d", $year, $month);
653             }
654              
655             #===========================================================================
656             1;
657              
658             __END__