File Coverage

blib/lib/Math/Financial.pm

Criterion	Covered	Total	%
statement	39	225	17.3
branch	0	108	0.0
condition	0	6	0.0
subroutine	11	24	45.8
pod	9	10	90.0
total	59	373	15.8

package Math::Financial;

# Copyright 1999 Eric Fixler
# All rights reserved. This program is free software;
# you can redistribute it and/or modify it under the same terms as Perl itself.

# $Id: Financial.pm,v 1.5 1999/09/15 19:08:41 fix Exp $
# $Source: /www/cgi/lib/Math/RCS/Financial.pm,v $

=pod

=head1 NAME

Math::Financial - Calculates figures relating to loans and annuities.

=head1 SYNOPSIS

$calc = new Math::Financial(fv =E 100000, pv =E 1000);
$calc-Eset->(pmt => 500, ir => 8);

$calc->compound_interest(find =E 'fv');

=head1 DESCRIPTION

This package contains solves mathematical problems relating to loans and annuities.

The attributes that are used in the equations may be set on a per-object basis, allowing
you to run a set of different calculations using the same numbers, or they may be fed
directly to the methods.

The attribute types, accessed through the C and C methods are

=over4

=item pv	=E 	Present Value

=item fv	=E 	Future Value

=item ir	=E  Yearly Interest Rate (in percent)

=item pmt	=E	Payment Amount

=item np	=E	Number of Payments/Loan Term

=item tpy	=E	Terms Per Year (defaults to 12)

=item pd	=E	Payments made so far (used only for loan/annuity balances)

=back

Attributes are case-insensitive.  The documentation for the individual methods
indicates which attributes must be set for those methods.

Calculations are based B on the attributes set with the C or C
methods, B with arguments fed directly to the methods.  This seemed like the
least confusing way to make the interface flexible for people who are using the
module in different ways.

Also, performing a calculation
does B update the attribute of the solution.  In other words, if
you solve an equation that returns fv, the solution is returned but the
internal fv field is unaffected.

Any attempted calculation which cannot be completed -- due to either missing or
invalid attributes -- will return C.

I am interested to hear from people using this module -- let me know what
you think about the interface and how it can be improved.

=head1 METHODS

=cut

sub BEGIN {
		*{__PACKAGE__.'::loan_payment'} = \&monthly_payment;
		use strict;
		use POSIX qw(:ctype_h);
		use vars qw(@ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS
					@ATTRIBUTES $DEFAULT_OBJECT $re_object);
		$VERSION = 0.76;
		use constant	PV	=>	0;
		use constant	FV	=> 	1;
		use constant	NP	=>	2;
		use constant	PMT	=>	3;
		use constant	IR	=> 	4;
		use constant	TPY	=> 	5; # TERMS PER YEAR
		use constant	PD	=> 	6;
		@ATTRIBUTES	= qw(PV FV NP PMT IR TPY PD);
		$re_object = '(?i)[a-z][\w]*?::[\w]';
		@ISA = qw(Exporter);
		@EXPORT= ();
		@EXPORT_OK = qw(loan_term loan_payment compound_interest funding_annuity
						loan_balance loan_size simple_interest);
		%EXPORT_TAGS = ( procedural => \@EXPORT_OK,
						 standard	=> \@EXPORT_OK);
}


sub new {
=pod

=head2 new

C<$calc = new Math::Financial();

C<$calc = new Math::Financial(pv =E 10000, ir =E 5, np => 12)>

Object constructor.  See above for a description of the available attributes.
You do not I to set attributes here, you can also do so using C,
or feed attributes directly to the methods.

There are no default values for any of the attributes except C (Terms Per Year),
which is 12 by default, and C which defaults to zero.

If you don't want to use the object-oriented interface, see the L section
below.

=cut
	my $class = ref($_[0]) || ($_[0] =~ /(.*?::.*)/)[0];
	my $parent = ref($class) ? $_[0] : [undef,undef,undef,undef,undef,12,0] ;
	if ($class) { shift(@_); } else { $class = __PACKAGE__ ; };
	my $params = { 	pv	=>	$parent->[PV],
					fv	=>	$parent->[FV],
					ir	=>	$parent->[IR],
					np	=>	$parent->[NP],
					pmt	=>	$parent->[PMT],
					tpy	=> 	$parent->[TPY],
					pd	=>  $parent->[PD],
					@_ };
	my $self = [];
	bless($self,$class);
	$self->set(%$params);
	return $self;
}


sub _get_attribute_key {
	 # if fed a list, will return a list
	 my ($self,@args) = _get_self(@_);
	 return undef unless scalar(@args);
	 my @keys = ();
	 foreach (@args) {
	 	if (isdigit($_)) { push(@keys,$_); next; };
	 	my $attrib = quotemeta($_);
	 	for (my $j = 0; $j <= $#ATTRIBUTES; $j++) {
	 	 	if ($ATTRIBUTES[$j] =~ /$attrib/i) { push(@keys,$j); next; };
	 	};
	 	push(@keys,undef); #unfound key
	 }
	 if (not($#args)) {
	 	return $keys[0];
	 } else {
	 	return wantarray ? @keys : \@keys;
	 };
};

sub set {
=pod

=head2 set

C<$calc-Eset(fv =E 100000, pmt =E 500)>

You can set any of the stored attributes using this method, which is is also
called by .  Returns the number of attributes set.

=cut
	 my ($self,@args) = _get_self(@_);
	 my $params = { @args };
	 my ($field,$val,$key); my $count = 0;
	 while (($field, $val) = each(%$params)) {
	 	$key = $self->_get_attribute_key($field);
	 	if (defined($key)) { $self->[$key] = $val; $count++; }
	 }
	 return $count;
}

sub get {
=pod

=head2 get

C<$calc-Eget(field => 'ir')>

C<$calc-Eget('ir','pmt','pv')>

C<$calc-Eget([qw(ir pmt pv)])>

You can get one or several attributes using this method.  In the multiple
attribute formats, it accepts either a list or a list reference as input.

In single attribute context, returns a scalar.  In multiple attribute context,
it returns a list or a reference to a list, depending on the calling context.

=cut
	 my ($self,@args) = _get_self(@_);
	 ($args[0] =~ /field/io) and shift(@args);
	 my @gets = ();
	 foreach my $field (@args) {
	 	if 		(ref($field) eq 'ARRAY') { push(@gets,map({ $self->get($_) } @$field)) ; next; }
	 	else	{ 	my $key = $self->_get_attribute_key($field);
	 			 	push(@gets, defined($key) ? $self->[$key] : $key); next; }
	 }
	 if ($#gets) {
	 	return wantarray ? @gets : \@gets;
	 } else { return $gets[0]; };
}


sub compound_interest {
=pod

=head2 compound_interest

C<$calc-Ecompound_interest>

C<$calc-Ecompound_interest-E('fv')>

C<$calc-Ecompound_interest-E(find =E 'fv')>

Calculates compund interest for an annuity.  With any 3 of pv, fv, np, and ir,
you can always solve the fourth.

Without arguments, the method will attempt to figure out what you'd like to solve
based on what attributes of the object are defined.  Usually, you'll probably want to
explicitly request what attribute you'd like returned, which you can do using
the second or third method.

=cut
	my ($self,@args) = _get_self(@_);
	(scalar(@args) == 1) and unshift(@args,'find');
	if (scalar(@args) > 2) {
		my $temp = __PACKAGE__->new(@args[2..$#args]);
		return $temp->compound_interest(@args[0..1]);
	};
	my $solve_for = $self->_get_attribute_key($args[1]);
	my (@numbers,$result);
	if (not(defined($solve_for))) {
		if 		(@numbers = $self->_verify_fields(IR,PV,NP)) {  $solve_for = FV; }
		elsif	(@numbers = $self->_verify_fields(IR,FV,NP)) {  $solve_for = PV; }
		elsif	(@numbers = $self->_verify_fields(IR,PV,FV)) {  $solve_for = NP; }
		elsif	(@numbers = $self->_verify_fields(PV,FV,NP)) {  $solve_for = IR; }
		else { return undef; };
	} else {
		my @combos = ();
		$combos[FV] = [IR,PV,NP]; $combos[PV] = [IR,FV,NP]; $combos[NP] = [IR,PV,FV];
		$combos[IR] = [PV,FV,NP];
		$set = $combos[$solve_for];
		@numbers = $self->_verify_fields(@$set) or return undef;
	}
	eval {if ($solve_for == FV) {
		$ir = ($numbers[0]/100) / $self->[TPY];
		($pv,$np) = @numbers[1,2];
		$result = abs($pv) * ( ($ir + 1) ** $np);
	} elsif ($solve_for == PV) {
		 $ir = ($numbers[0]/100) / $self->[TPY];
		 ($fv,$np) = @numbers[1,2];
		 $result = abs($fv) * ( ($ir + 1) ** (0 - $np) );
	} elsif ($solve_for == NP) {
		$ir = $numbers[0]/100/$self->[TPY];
		($pv,$fv) = @numbers[1,2];
		my $num = log(abs($fv)/$pv);
		my $den = log( 1 + $ir);
		$result = $num / $den;
	} elsif ($solve_for == IR) {
		($pv,$fv,$np) = @numbers;
		$ir = (( abs($fv)/abs($pv) ) ** (1 / $np) ) - 1;
		$result = $ir * 100 * $self->[TPY];
	};};

	return ($@) ? undef : $result;
}

sub funding_annuity {
=pod

=head2 funding_annuity

C<$calc-Efunding_annuity>

C<$calc-Efunding_annuity-E(pmt =E 2000, ir =E 6.50, np =E 40, tpy => 4)>

C calculates how much money ( C ) you will have at the end of C periods
if you deposit C into the account each period and the account earns C interest per year.

You may want to set the C attribute here to something other than 12, since, while loans
usually compound monthly, annuities rarely do.

=cut

my ($self,@args) = _get_self(@_);
	if (scalar(@args)) {
		my $temp = __PACKAGE__->new(@args);
		return $temp->funding_annuity();
	};
	my @numbers = $self->_verify_fields(IR,PMT,NP);
	return undef unless scalar(@numbers);
	my ($result); #solving for fv here
	my ($pmt,$np) = @numbers[1,2];
	my $ir = $numbers[0]/100/$self->[TPY];
	eval { $result = ($pmt * ( ((1 + $ir) ** $np) - 1))/$ir; };
	return $@ ? undef : $result;
 }


sub loan_balance {
=pod

=head2 loan_balance

C<$calc-Eloan_balance>

C<$calc-Eloan_balance-E(pmt =E 2000, ir =E 6.50, np =E 360, pd =E 12)>

C calculates the balance on a loan that is being made in C equal payments,
given that C payments have already been made. You can also use this method to determine
the amount of money left in an annuity that you are drawing down.

=cut
my ($self,@args) = _get_self(@_);
if (scalar(@args)) {
		my $temp = __PACKAGE__->new(@args);
		return $temp->loan_balance();
	};
	my @numbers = $self->_verify_fields(IR,PMT,NP);
	return undef unless scalar(@numbers);
	my ($pmt,$np) = @numbers[1,2];
	my $ir = $numbers[0]/100/$self->[TPY]; my ($result);
	eval { 	my $a = (1 + $ir) ** ($self->[PD] - $np);
			$result = $pmt/$ir * (1 - $a)  ; };
	return $@ ? undef : $result;
}

sub monthly_payment {
=pod

=head2 loan_payment

C<$calc-Eloan_payment>

Return the payment amount, per period, of a loan.  This is also known as amortizing.
The ir, np, and pv fields must be set.

=cut
	my ($self,@args) = _get_self(@_);
	if (scalar(@args)) {
		my $temp = __PACKAGE__->new(@args);
		return $temp->monthly_payment();
	};
	my @numbers = $self->_verify_fields(IR,PV,NP);
	return undef unless scalar(@numbers);
	my ($result,$ir);
	my ($pv,$np) =  @numbers[1,2];
	$ir = ($numbers[0]/100) / $self->[TPY];
	my $a = (1 + $ir) ** (0 - $np);
	my $denominator = 1 - $a;
	my $numerator 	= $pv * $ir;
	$result = eval { $numerator / $denominator };
	return $@ ? undef : $result;
}


sub loan_size {
=pod

=head2 loan_size

C<$calc-Eloan_term>

C<$calc-Eloan_size-E(pmt =E 2000, ir =E 6.50, np =E 360)>

C calculates the size of loan you can get based on the monthly payment
you can afford.

=cut

my ($self,@args) = _get_self(@_);
	if (scalar(@args)) {
		my $temp = __PACKAGE__->new(@args);
		return $temp->loan_size();
	};
	my @numbers = $self->_verify_fields(IR,PMT,NP);
	return undef unless scalar(@numbers);
	my ($result);
	my ($pmt,$np) = @numbers[1,2];
	my $ir = $numbers[0]/100/$self->[TPY];
	eval { $result = ($pmt * (1 - ((1 + $ir) ** (0 - $np))))/$ir; };
	return $@ ? undef : $result;
};

sub loan_term {
=pod

=head2 loan_term

C<$calc-Eloan_term>

Return the number of payments (term) of a loan given the interest rate
C, payment amount C and loan amount C.   The ir, pmt, and pv fields must be set.

=cut
	my ($self,@args) = _get_self(@_);
	if (scalar(@args)) {
		my $temp = __PACKAGE__->new(@args);
		return $temp->loan_term();
	};
	my @numbers = $self->_verify_fields(IR,PMT,PV);
	return undef unless scalar(@numbers);
	my ($pmt, $pv) =  @numbers[1,2];
	$pv = abs($pv);
	my $ir = $numbers[0]/100/$self->[TPY];
	my ($result);
	$result = eval {
		my $numerator = log($pmt/($pmt - ($ir * $pv)));
		my $denominator = log(1 + $ir);
		return $numerator / $denominator;
		};
	return $@ ? undef : $result;
}


sub simple_interest {
=pod

=head2 simple_interest

C<$calc-Esimple_interest>

C<$calc-Esimple_interest-E('ir')>

C<$calc-Esimple_interest-E(find =E 'ir')>

This works just like compound interest, but there is no consideration of C.
With any 2 of pv, fv, and ir, you can always solve for the third.

Without arguments, the method will attempt to figure out what you'd like to solve
based on what attributes of the object have been defined.  Usually, you'll probably want to
explicitly request what attribute you'd like returned, which you can do using
the second or third method.

=cut
	my ($self,@args) = _get_self(@_);
	(scalar(@args) == 1) and unshift(@args,'find');
	if (scalar(@args) > 2) {
		my $temp = __PACKAGE__->new(@args[2..$#args]);
		return $temp->simple_interest(@args[0..1]);
	};
	my $solve_for = $self->_get_attribute_key($args[1]);
	my (@numbers,$ir,$pv,$pmt,$result);
	if (not(defined($solve_for))) {
		if 		(@numbers = $self->_verify_fields(IR,PV)) 		{  $solve_for = PMT; }
		elsif	(@numbers = $self->_verify_fields(IR,PMT)) 		{  $solve_for = PV; }
		elsif	(@numbers = $self->_verify_fields(PMT,PV)) 		{  $solve_for = IR; }
		else { return undef; };
	} else {
		my @combos = ();
		$combos[PV] = [IR,PMT]; $combos[IR] = [PMT,PV]; $combos[PMT] = [IR,PV];
		$set = $combos[$solve_for];
		@numbers = $self->_verify_fields(@$set) or return undef;
	}
	# equations go here
	if ($solve_for == PMT) {
		$result =  $numbers[1] * ($numbers[0]/100);
	} elsif  ($solve_for == PV) {
		eval { $result =  $numbers[1]/($numbers[0]/100); };
	} elsif ($solve_for == IR) {
		eval { $result = ($numbers[0]/$numbers[1]) * 100; };
	}
	return ($@) ? undef : $result;
}

sub _get_self {
	my $self = (ref($_[0]) !~ /$re_object/o) ?  $DEFAULT_OBJECT ||= new __PACKAGE__ : shift(@_) ;
	return($self,@_);
}

sub _verify_fields {
	my ($self,@args) = _get_self(@_);
	my @defined = grep(/[0-9]/, @$self[@args]);
	return (scalar(@defined) == scalar(@args)) ? @defined : ();
}


1;

__END__