#!/bin/false
# Time-stamp: "1999-03-05 12:43:02 MST"  -*-perl-*-

require 5;
package Business::US_Amort; # This is a class
use strict;
use vars qw($VERSION $Debug %Proto);
use Carp;

$Debug = 0 unless defined $Debug;
$VERSION = "0.04";

###########################################################################

=head1 NAME

Business::US_Amort - class encapsulating US-style amortization

=head1 SYNOPSIS

  use Business::US_Amort;
  my $loan = Business::US_Amort->new;
  $loan->principal(123654);
  $loan->interest_rate(9.25);
  $loan->term(20);
  
  my $add_before_50_amt = 700;
  sub add_before_50 {
    my $this = $_[0];
    if($this->{'_month_count'} == 50) {
      $this->{'_monthly_payment'} += $add_before_50_amt;
    }
  }
  $loan->callback_before_monthly_calc(\&add_before_50);
  $loan->start_date_be_now;
  
  $loan->run;
  $loan->dump_table;
  
  print "Total paid toward interest: ", $loan->total_paid_interest, "\n";

=head1 DESCRIPTION

This class encapsulates amortization calculations figured according to
what I've been led to believe is the usual algorithm for loans in the USA.

I used to think amortization was simple, just the output of an algorithm
that'd take just principle, term, and interest rate, and return the
monthly payment and maybe something like total paid toward interest.
However, I discovered that there's a need for loan calculations where,
say, between the 49th and 50th month, your interest rate drops, or where
you decide to add $100 to your monthly payment in the 32nd month.

So I wrote this class, so that I could amortize simply in simple cases
while still allowing any kind of strangeness in complex cases.

=cut

#===========================================================================

=head1 FUNCTIONS

This module provides one function, which is a simple amortizer.
This is just to save you the bother of method calls when you
really don't need any frills.

=over

=item Business::US_Amort::simple $principal, $interest_rate, $term

Amortizes based on these parameters.  In a scalar context,
returns the initial monthly payment.

In an array context, returns a three item list consisting of:
the initial monthly payment, the total paid toward interest,
and the loan object, in case you want to do things with it.

=back

Example usages:

  $monthly_payment = Business::US_Amort::simple(123654, 9.25, 20);
  
  ($monthly_payment, $total_toward_interest, $o)
    = Business::US_Amort::simple(123654, 9.25, 20);

Of course, if you find yourself doing much of anything with the
loan object, you probably should be using the OOP interface instead
of the functional one.

=cut

sub simple ($$$) {
  my($p, $i, $t) = @_[0,1,2];
  my $o = Business::US_Amort->new;
  $o->principal($p);
  $o->interest_rate($i);
  $o->term($t);

  $o->run || croak("Error while amortizing: " . $o->error . "\n");
  
  return
    wantarray ?
      ($o->initial_monthly_payment, $o->total_paid_toward_interest, $o)
    : $o->initial_monthly_payment
  ;
}

#===========================================================================

=head1 OBJECT ATTRIBUTES

All attributes for this class are scalar attributes.  They can be read via:

  $thing = $loan->principal     OR    $thing = $loan->{'principal'}

or set via:

  $loan->principal(VALUE)       OR    $loan->{'principal'} = VALUE


=head2 MAIN ATTRIBUTES

These attributes are used as parameters to the C<run> method.

=over

=item principal

The principal amount of the loan.

=item interest_rate

The annual rate, expressed like 8.3, not like .083.

Note that if you're defining callbacks, you can change this attribute
at any time in your callbacks, to change the rate of interest from
then on.

=item term

The term of the loan, in years, not months.

=item callback_before_monthly_calc

If set, this should be a coderef to a routine to call at the B<beginning>
of each month, B<before any> calculations are done.
The one parameter passed to this routine, in $_[0], is the object.
See the SYNOPSIS, above, for an example.

=item callback_after_monthly_calc

If set, this should be a coderef to a routine to call at the B<end>
of each month, B<after all> monthly calculations are done.
The one parameter passed to this routine, in $_[0], is the object.

=item block_table

If set to true, this inhibits C<run> from adding to C<table>.  (This
is false by default.) If you're not going to access C<table>, set this
to true before calling C<run> -- it'll speed things up and use less
memory.

=item start_date

If set to a date in the format "YYYY-MM", C<_date> will be defined
appropriately for each month.  You can set C<start_date> to the current
month by just saying $loan->start_date_be_now.

=item cent_rounding

If set to true, figures are rounded to the nearest cent at appropriate
moments, so as to avoid having to suppose that the debtor is to make a
monthly payment of $1025.229348723948 on a remaining principal of
$196239.12082309123408, or the like.

=back

These attributes are set by the C<run> method:

=over

=item initial_monthly_payment

The monthly payment that follows from the basic amortization parameters
given.  Compare with C<_monthly_payment>.

=item total_paid_interest

The total amount paid toward interest during the term of this loan.

=item total_month_count

The total number of months the loan took to pay off.
E.g., "12" for a loan that took 12 months to pay off.

=item table

This will be a reference to a list of copies made of the object
("snapshots") each month.  You can then use this if you want to
generate a dump of particular values of the object's state in
each month.

Note that snapshots have their C<am_snapshot> attribute set to true,
and have their C<table> attribute set to undef.  (Otherwise this'd be
a circular data structure, which would be a hassle for you and me.)

=item error

A string explaining any error that might have occurred, which would/should
accompany C<run> returning 0.  Use like:

  $loan->run or die("Run failed: " . $loan->error);

=back

Other attributes:

=over

=item am_snapshot

This attribute is set to true in snapshots, as stored in C<table>.

=item _month_count_limit

This is a variable such that if the month count ever exceeds this
amount, the main loop will abort.  This is intended to keep the
iterator from entering any infinite loops, even in pathological cases.
Currently the C<run> method sets this to twelve plus twice the number
of months that it's expected this loan will take.
Increase as necessary.

=back

=head2 INTERATION ATTRIBUTES

These are attributes of little or no interest once C<run> is done, but
may be of interest to callbacks while C<run> is running, or may
be of interest in examining snapshots in C<table>.

=over

=item _month_count

This is how many months we are into the loan.  The first month is 1.

=item _abort

If you want callbacks to be able to halt the iteration for some
reason, you can have them set C<_abort> to true.  You may also choose
to set C<error> to something helpful.

=item _monthly_payment

The amount to be paid to toward the principal each month. At the start
of the loan, this is set to whatever C<initial_monthly_payment> is
figured to be, but you can manipulate C<_monthly_payment> with
callbacks to change how much actually gets paid when.

=item _remainder

The balance on the loan.

=item _date

The given month's date, if known, in the format "YYYY-MM".  Unless you'd
set the C<start_date> to something, this will be undef.

=item _h

The interest to be paid this month.

=item _old_amount

What the remainder was before we made this month's payment.

=item _c

The current monthly payment, minus the monthly interest, possibly
tweaked in the last month to avoid paying off more than is actually left
on the loan.

=back

=cut

###########################################################################

%Proto =  # public attributes and their values
(
  principal => 0,
  interest_rate => 8, # annual, percent
  term => 30, # years (target term)
  error => '',
  cent_rounding => 1,
  start_date => undef,

  initial_monthly_payment => undef,
  total_paid_interest => undef,
  total_month_count => undef,

  am_snapshot => 0, # flag for objects that are snapshots
  block_table => 0, # set to 1 to block table generation

  table => undef,
  callback_before_monthly_calc => undef,
  callback_after_monthly_calc => undef,

  _month_count_limit => undef,
  _abort => undef,
  _remainder => undef,
  _date => undef,
  _h => undef,
  _old_amount => undef,
  _monthly_payment => undef,
);

#===========================================================================
 # make accessors -- just simple scalar accessors
foreach my $k (keys %Proto) { # attribute method maker
   no strict 'refs';
   *{$k} = sub {
     my $it = shift @_;
     return ($it->{$k} = $_[0]) if @_;
     return $it->{$k};
   }
   unless defined &{$k}
}

#--------------------------------------------------------------------------
# the usual doofy service methods

=head1 METHODS

=over

=item $loan = Business::US_Amort->new

Creates a new loan object.

=cut

sub new { # constructor
  my $class = shift @_;
  $class = ref($class) || $class;
  return bless { %Proto, @_ }, $class;
}

=item $loan->copy

Copies a loan object or snapshot object.  Also performs a somewhat
deep copy of its table, if applicable.

=cut

sub copy { # duplicator
  my $this = shift @_;
  return $this->new unless ref($this);

  my $new = bless { %$this }, ref($this);
  
  if(ref($new->{'table'})) {
    $new->{'table'} =
      [ # copy listref
        map( bless({ %$_ }, ref($_)), # copy hashref
             @{ $new->{'table'} }
           )
      ]
    ;
  } # copy the list of hashrefs
  
  return $new;
}

=item $loan->destroy

Destroys a loan object.  Probably never necessary, given Perl's garbage
collection techniques.

=cut

sub destroy { # destructor
  my $this = @_;
  return unless ref($this);
  %$this = ();
  bless $this, 'DEAD';
  return;
}
\&DEAD::destroy = \&destroy;

#===========================================================================

=item $loan->start_date_be_now

This sets C<start_date> to the current date, based on C<$^T>.

=cut

sub start_date_be_now {
  my $this = $_[0];
  $this->{'start_date'} = &__date_now;
}

#===========================================================================

sub maybe_round {
  my $this = $_[0];
  return $this->{'cent_rounding'} ? (0 + sprintf("%.02f", $_[1])) : $_[1];
}

#===========================================================================

=item $loan->run

This performs the actual amortization calculations.
Returns 1 on success; otherwise returns 0, in which case you should
check the C<error> attribute.

=cut

sub run {
  my $this = $_[0];
  croak "Can't call loan->run() on a snapshot" if $this->{'am_snapshot'};
  $this->{'error'} = '';
  
  # not a whole lot of sanity checking here

  unless($this->{'principal'} > 0) {
    $this->{'error'} = 'principal must be positive and nonzero';
    return 0;
  }

  $this->{'_remainder'} = $this->maybe_round( $this->{'principal'} ); # AKA "p"

  unless($this->{'interest_rate'} > 0) {
    $this->{'error'} = 'interest rate must be positive and nonzero';
    return 0;
  }

  $this->{'term'} = abs($this->{'term'} + 0);
  unless($this->{'term'}) {
    $this->{'error'} = 'term must be positive and nonzero';
    return 0;
  }

  # The only real voodoo is here:
  my $j = # monthly interest rate in decimal -- in percent, not like .0875
    $this->{'interest_rate'} / 1200;
  my $n = # number of months the loan is amortized over
    int($this->{'term'} * 12);
  $this->{'initial_monthly_payment'} =
    $this->maybe_round(
      $this->{'_remainder'} * $j / ( 1 - (1 + $j) ** (-$n) )
    );
  # ...the rest is just iteration

  # init...
  $this->{'table'} = []; # clear
  $this->{'total_paid_interest'} = 0;
  $this->{'_monthly_payment'} = $this->{'initial_monthly_payment'};
    # this can vary if the user starts tweaking it
  $this->{'_month_count'} = 0;
  $this->{'_date'} = $this->{'start_date'} || undef;
  $this->{'_month_count_limit'} = $n * 2 + 12
    unless defined $this->{'_month_count_limit'};
   # throw an error if our _month_count ever hits this

  my $last_month_date;
  while($this->{'_remainder'} >= 0.01) { # while there's more than a cent left
    ++$this->{'_month_count'};
    $this->{'_old_amount'} = $this->{'_remainder'};

    # maybe call the 'before' callback
    if($this->{'callback_before_monthly_calc'}) {
       my @list = ($this);
       &{$this->{'callback_before_monthly_calc'}}(@list);
    }
    if($this->{'_abort'}) { $this->{'error'} ||= "Abort flag set."; return 0 }

    # and now all the calcs for this month
    $this->{'_h'} = $this->maybe_round( $this->{'_remainder'}
                                        * $this->{'interest_rate'} / 1200
                                      );
    $this->{'total_paid_interest'} += $this->{'_h'};

    $this->{'_c'} = $this->{'_monthly_payment'} - $this->{'_h'};

    if($this->{'_remainder'} > $this->{'_c'}) { # normal case
      $this->{'_remainder'} = $this->maybe_round($this->{'_remainder'}
                              - $this->{'_c'});
    } else { # exceptional end case
      $this->{'_c'} = $this->{'_remainder'};
      $this->{'_remainder'} = 0;
    }

    # maybe take a snapshot
    unless($this->{'block_table'}) {
      my $snapshot = bless {%$this}, ref($this); # lame-o copy
      # Entries in the table are just snapshots of the object, minus 'table',
      #  and plus a few other things:
      $snapshot->{'table'} = undef;
      $snapshot->{'am_snapshot'} = 1;
      push @{$this->{'table'}}, $snapshot;
    }

    # maybe call the 'after' callback.
    if($this->{'callback_after_monthly_calc'}) {
       my @list = ($this);
       &{$this->{'callback_after_monthly_calc'}}(@list);
    }
    if($this->{'_abort'}) { $this->{'error'} ||= "Abort flag set."; return 0; }

    if($this->{'_month_count'} > $this->{'_month_count_limit'}) {
      $this->{'error'} = "_month_count_limit exceeded!";
      return 0;
    }
    $last_month_date = $this->{'_date'};
    $this->{'_date'} = &__inc_date($this->{'_date'})
     if defined($this->{'_date'});
  }
  $this->{'_date'} = $last_month_date; # a hack
  
  $this->{'total_month_count'} = $this->{'_month_count'};

  # 'total_paid_interest' and 'total_month_count' hold useful values
  # now

  return 1;
}

#===========================================================================

=item $loan->dump_table

This method dumps a few fields selected from snapshots in the C<table>
of the given object.  It's here more as example code than as anything
particularly useful.  See the source.  You should be able to use this
as a basis for making code of your own that dumps relevant fields from
the contents of snapshots of loan objects.

=cut

sub dump_table {
  my $this = $_[0];
  return unless ref $this->{'table'}; # no table!
  foreach my $line (@{$this->{'table'}}) {
     # iterate over snapshots
    printf
      "%s (#% 4d) | % 12.2f || % 10.2f | % 10.2f || % 12.2f\n",
      map($line->{$_},
          '_date',
          '_month_count',
          '_old_amount',
          '_h',
          '_c',
          '_remainder'
         )
    ;
  }
  return;
}
#===========================================================================

=back

=head1 REMEMBER

When in panic or in doubt, run in circles, scream and shout.

Or read the source.  I really suggest the latter, actually.

=head1 WARNINGS

* There's little or no sanity checking in this class.  If you want
to amortize a loan for $2 at 1% interest over ten million years,
this class won't stop you.

* Perl is liable to produce tiny math errors, like just about any
other language that does its math in binary but has to convert to and
from decimal for purposes of human interaction.  I've seen this
surface as tiny discrepencies in loan calculations -- "tiny" as in
less than $1 for even multi-million-dollar loans amortized over
decades.

* Moreover, oddities may creep in because of round-off errors. This
seems to result from the fact that the formula that takes term,
interest rate, and principal, and returns the monthly payment, doesn't
know that a real-world monthly payment of "$1020.309" is impossible --
and so that ninth of a cent difference can add up across the months.
At worst, this may cause a 30-year-loan loan coming to term in 30
years and 1 month, with the last payment being needed to pay off a
balance of two dollars, or the like.

These errors have never been a problem for any purpose I've
put this class to, but be on the look out.

=head1 DISCLAIMER

This program is distributed in the hope that it will be useful,
but B<without any warranty>; without even the implied warranty of
B<merchantability> or B<fitness for a particular purpose>.

But let me know if it gives you any problems, OK?

=head1 COPYRIGHT

Copyright 1999, Sean M. Burke C<sburke@netadventure.net>, all rights
reserved.  This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=head1 AUTHOR

Sean M. Burke C<sburke@netadventure.net>

=cut


#  stuff...

sub __date_now {
  my $now;
  $now = @ARGV ? $_[0] : $^T;
  my($m, $y) = (localtime($now))[4,5];
  return sprintf("%04d-%02d", $y + 1900, $m + 1);
}

#===========================================================================

sub __inc_date {
  my $in_date = $_[0];
  my($year, $month);
  return "2000-01" unless $in_date =~ /^(\d\d\d\d)-(\d\d)/s;
  ($year, $month) = ($1, $2);

  if(++$month > 12) {
    $month = 1;
    $year++;
  }
  return sprintf("%04d-%02d", $year, $month);
}

#===========================================================================
1;

__END__


%seen = ();
while(<DATA>) {
  while(/->\{['"]([^'"]+)['"]\}/g) {
    print "$1 # $.\n" unless $seen{$1}++
  }
}