``````unit ufinance;                                      { last modified 920520 }

{ Math Routines for Finance Calculations in Turbo Pascal }
{ Copyright 1992, J. W. Rider                            }
{ CIS mail: [70007,4652]                                 }

{  These are pascal implementations some of the finance functions
available for ObjectVision and Quattro Pro. They are intended to
work exactly as described in the Quattro Pro 3.0 @Functions manual.

The following are the Lotus 1-2-3 compatibility functions.

CTERM ( Rate, FV,      PV)
DDB   ( cost, salvage, life, period)
FV    ( Pmt,  Rate,    Nper)
PMT   ( PV,   RATE,    Nper)
PV    ( Pmt,  Rate,    Nper)
RATE  ( FV,   PV,      Nper)
SLN   ( cost, salvage, life)
SYD   ( cost, salvage, life, period)
TERM  ( pmt,  rate,    fv)

Also implemented are the extended versions of the routines that
balance the following "cash-flow" equation:

pval*(1+rate)^nper + paymt*(1+rate*ptype)*((1+rate)^nper-1)/rate + fval = 0

IRATE (            nper, pmt, pv, fv, ptype)
NPER  ( rate,            pmt, pv, fv, ptype)
PAYMT ( rate,      nper,      pv, fv, ptype)
PPAYMT( rate, per, nper,      pv, fv, ptype)
IPAYMT( rate, per, nper,      pv, fv, ptype)
PVAL  ( rate,      nper, pmt,     fv, ptype)
FVAL  ( rate,      nper, pmt, pv,     ptype)

In QPro and OV, the ptype code is either 0 or 1 to indicate that the
is made at the end or beginning of the month respectively.  My preferred
explanation is that "ptype" is the fraction of the interest rate that is
applied to a payment in the period that it is paid.  This has the same
effect when ptype is 0 or 1, but complicates the explanation for what is
right when ptype=1. THE EXAMPLES IN THE QPRO AND OV MANUALS DO NOT AGREE
FOR THE "PPAYMT" FUNCTION.  Someone needs to explain these discrepancies.
UFinance follows the QPro3 style, but the formula is different than what
QPro3 function reference says is used for IPaymt.

The "block" financial functions from QPro3 are also implemented:

IRR ( guess, block)
NPV ( rate, block, ptype)

These make use of the "UBlock.BlockType" object designed especially
for these functions.  The BlockType object provides access to a list
of indexed floating point numbers. See the test program FINTEST.PAS
for an example of BlockType usage.

Caveats:  under no circumstances will I be held responsible if someone
misuses this code.  The code is provided for the convenience of other
programmers.  It is the someone else's responsibility to ensure that
these functions satisfy financial needs.

While this is a relatively complete set of functions, it is not possible
to calculate all desirved components in the compound interest equation
directly.  In particular, there is no way provided to compute directly
the interest rate on an annuity or loan that goes from "pv" to "fv" in
"nper" intervals, paying "pmt" each period.  The "RATE" function
provided only determines the rate at which a compounded amount grows.
The "IRATE" function computes a value by successive approximation and
is inherently unstable. (The "IRR" function is subject to similar
instability.)

One way in which programmers go wrong is misunderstanding the
distinction between binary floating point representations of numbers and
decimal floating point representation.  Turbo Pascal, as well as most
other high speed number processing systems, uses the binary form.  While
such binary operations give results that are close to their decimal
counterparts, some differences may arise.  Especially, when you expect
results to round one way versus the other.
}

interface

uses ublock; { for "blocktype" of NPV and IRR functions }

{ "Extended" math is used if \$N+ is set.  Otherwise, use "real" math.}

{\$ifopt N-}
type extended = real;
{\$endif}

function CTERM ( Rate, FV, PV: extended):extended;
{ number of compounding periods for initial amount "PV" to accumulate
into amount "FV" at interest "Rate" }

function DDB   ( cost, salvage, life, period:extended):extended;
{ double declining balance depreciation for the "period" (should be a
positive, whole number) interval on an item with initial "cost" and
final "salvage" value at the end of "life" intervals }

function FV    ( Pmt, Rate, Nper:extended):extended;
{ accumulated amount from making "nper" payments of amount "pmt" with
interest accruing on the accumulated amount at interest "rate"
compounded per interval }

function FVAL  ( rate, nper, pmt, pv, ptype:extended):extended;
{ extended version of the FV function }

function IPAYMT(rate, per, nper, pv, fv, ptype:extended):extended;
{ computes the portion of a loan payment that is interest on the
principal }

function IRATE ( nper, pmt, pv, fv, ptype:extended):extended;
{ extended version of the RATE function }

function IRR   ( guess: extended; var block: blocktype): extended;
{ returns internal rate-of-return of sequence of cashflows }

function NPER  ( rate, pmt, pv, fv, ptype:extended):extended;
{ extended version of the CTERM and TERM functions }

function NPV   (
rate: extended; var block: blocktype; ptype:extended): extended;
{ return net present value of sequence of cash flows }

function PAYMT ( rate, nper, pv, fv, ptype:extended):extended;
{ extended version of the PMT function }

function PMT   ( PV, RATE, Nper: extended): extended;
{ payment amount per interval on loan or annuity of initial value "PV"
with payments spread out over "nper" intervals and with interest
accruing at "rate" per interval }

function PPAYMT( rate, per, nper, pv, fv, ptype:extended):extended;
{ computes the portion of a loan payment that reduces the principal }

function PV    ( Pmt, Rate, Nper: extended): extended;
{ initial value of loan or annuity that can be paid off by making "nper"
payments of "pmt" which interest on the unpaid amount accrues at
"rate" per interval }

function PVAL  ( rate, nper, pmt, fv, ptype:extended):extended;
{ extended version of the PV function }

function RATE  ( FV, PV, Nper: extended): extended;
{ determines interest rate per interval when initial amount "pv"
accumulates into amount "fv" by compounding over "nper" intervals }

function SLN   ( cost, salvage, life: extended): extended;
{ straight line depreciation per interval when item of initial value
"cost" has a value of "salvage" after "life" intervals }

function SYD   ( cost, salvage, life, period: extended): extended;
{ sum-of-year-digits depreciation amount for the "period" (should be a
positive, whole number) interval on a item with initial "cost" and
final "salvage" value at the end of "life" intervals }

function TERM  ( pmt, rate, fv: extended): extended;
{ number of compounding periods required to accumulate "fv" by making
periodic deposits of "pmt" with interest accumulating at "rate" per
period }

implementation

function CTERM ( Rate, FV, PV: extended):extended;
begin cterm:=ln(fv/pv)/ln(1+rate) end;

function DDB   ( cost, salvage, life, period:extended):extended;
var x:extended; n:integer;
begin
x:=0; n:=0;
while period>n do begin
x:=2*cost/life;
if (cost-x)<salvage then x:=cost-salvage;
if x<0 then x:=0;
cost:=cost-x; inc(n); end;
ddb:=x;
end;

function FV    ( Pmt, Rate, Nper:extended):extended;
begin
if abs(rate)>1e-6 then fv:=pmt*(exp(nper*ln(1+rate))-1)/rate
else                   fv:=pmt*nper*(1+(nper-1)*rate/2); end;

function FVAL  ( rate, nper, pmt, pv, ptype:extended):extended;
var f: extended;
begin
f:=exp(nper*ln(1+rate));
if abs(rate)<1e-6 then
fval :=-pmt*nper*(1+(nper-1)*rate/2)*(1+rate*ptype)-pv*f
else
fval := pmt*(1-f)*(1/rate+ptype)-pv*f;
end;

function IPAYMT(rate, per, nper, pv, fv, ptype:extended):extended;
begin
ipaymt := rate
* fval( rate, per-ptype-1, paymt( rate, nper, pv, fv, ptype), pv, ptype);
end;

function IRATE ( nper, pmt, pv, fv, ptype:extended):extended;
var rate,x0,x1,y0,y1:extended;

function y:extended;
var f:extended;
begin
if abs(rate)<1e-6 then y:=pv*(1+nper*rate)+pmt*(1+rate*ptype)*nper+fv
else begin
f:=exp(nper*ln(1+rate));
y:=pv*f+pmt*(1/rate+ptype)*(f-1)+fv; end; end;

begin {irate}

{ JWR: There are two fundamental problems with solutions by successive
approximation.  One is figuring out where you want to start; the
other is figuring out where you want to stop.  If you don't set them
right, then your solution will approximate successively forever.
This is my guess, but there is no guarantee that the solution will
even exist, much less converge. }

rate:=0; y0:=pv+pmt*nper+fv; x0:=rate;
rate:=exp(1/nper)-1; y1:=y; x1:=rate;
while abs(y0-y1)>1e-6 do begin { find root by secant method }
rate:=(y1*x0-y0*x1)/(y1-y0); x0:=x1; x1:=rate; y0:=y1; y1:=y; end;
irate:=rate;
end; {irate}

function IRR( guess: extended; var block: blocktype): extended;
var orate, rate: extended;

function drate(rate:extended):extended;
var npv,npvprime,blockvaluei:extended; i:longint;
begin
npv:=0; npvprime:=0; rate:=1/(1+rate);
for I:=block.count downto 1 do begin
blockvaluei:=block.value(i);
npv:=npv*rate+blockvaluei;
npvprime:=(npvprime+blockvaluei*i)*rate; end;
if abs(npvprime)<1e-6 then drate:=npv*1e-6 { a guess }
else                       drate:=npv/npvprime; end;

begin {IRR}

{ JWR: same caveats as for IRate }

orate:=guess; rate:=orate+drate(orate);
while abs(rate-orate)>1e-6 do begin { find root by newton-raphson }
orate:=rate; rate:=rate+drate(rate); end;
irr:=rate;
end;

function NPER  ( rate, pmt, pv, fv, ptype:extended):extended;
var f:extended;
begin
f:=pmt*(1+rate*ptype);
if abs(rate)>1e-6 then
nper:=ln((f-rate*fv)/(pv*rate+f))/ln(1+rate)
else
nper:=-(fv+pv)/(pv*rate+f); end;

function NPV   (
rate: extended; var block: blocktype; ptype:extended): extended;
var x:extended; i:longint;
begin
x:=0; rate:=1/(1+rate); {note: change in meaning of "rate"!}
for I:=block.count downto 1 do x:=x*rate+block.value(i);
npv:=x*exp((1-ptype)*ln(rate)); end;

function PAYMT ( rate, nper, pv, fv, ptype:extended):extended;
var f:extended;
begin
f:=exp(nper*ln(1+rate));
paymt:= (fv+pv*f)*rate/((1+rate*ptype)*(1-f)); end;

function PMT   ( PV, RATE, Nper: extended): extended;
begin pmt:=pv*rate/(1-exp(-nper*ln(1+rate))) end;

function PPAYMT( rate, per, nper, pv, fv, ptype:extended):extended;
var f:extended;
begin
f:=paymt(rate,nper,pv,fv,ptype);
ppaymt:=f-rate*fval(rate,per-ptype-1,f,pv,ptype);
end;

function PV    ( Pmt, Rate, Nper: extended): extended;
begin
if abs(rate)>1e-6 then
pv:=pmt*(1-exp(-nper*ln(1+rate)))/rate
else
pv:=pmt*nper*(1+(nper-1)*rate/2)/(1+nper*rate)
end;

function PVAL  ( rate, nper, pmt, fv, ptype:extended):extended;
var f:extended;
begin
if abs(rate)>1e-6 then begin
f:=exp(nper*ln(1+rate)); pval := (pmt*(1/rate+ptype)*(1-f)-fv)/f; end
else
pval:=-(pmt*(1+rate*ptype)*nper+fv)/(1+nper*rate)
end;

function RATE  ( FV, PV, Nper: extended): extended;
begin rate:=exp(ln(fv/pv)/nper)-1 end;

function SLN   ( cost, salvage, life: extended): extended;
begin sln:=(cost-salvage)/life end;

function SYD   ( cost, salvage, life, period: extended): extended;
begin syd:=2*(cost-salvage)*(life-period+1)/(life*(life+1)) end;

function TERM  ( pmt, rate, fv: extended): extended;
begin  term:=ln(1+(fv/pmt)*rate)/ln(1+rate) end;

end.

{ ----------------------    CUT HERE -------------------------- }

unit ublock;

{ defines the "BlockType" object used for the UFinance NPV and IRR functions }
{ Copyright 1992 by J. W. Rider }
{ CIS mail: [70007,4652] }

interface

{\$ifopt N-}
type
extended = real;
{\$endif}

type

{ the abstract "block": this is the type that is used for the
type of "var" parameters in procedures and functions }
BlockTypePtr = ^BlockType;
BlockType = object
function count: longint; virtual;  { number of values in "block" }
function value(n:longint):extended; virtual; { return nth value }
destructor done; virtual;
end;

type
ExtendedArrayPtr = ^ExtendedArray;
ExtendedArray = array [1..\$fff8 div sizeof(extended)] of extended;

type
{ a special-purpose block that extracts values from "extended" arrays.
This is the type that would be declared as "const" or "var" or
allocated on the heap in your program.  This one is very simple; you
could easily extend the abstract block to other storage forms. }
{  Note that "extended" means the same as "real" if \$N-. }
ExtendedArrayBlockTypePtr = ^ExtendedArrayBlockType;
ExtendedArrayBlockType = object(BlockType)
c: word;
d: extendedarrayptr;
function count:longint; virtual;
function value(n:longint):extended; virtual;
constructor init(dim:word; var firstvalue:extended);
end;

implementation

function blocktype.count; begin count:=0 end;
function extendedarrayblocktype.count; begin count:=c; end;

destructor blocktype.done; begin end;

constructor extendedarrayblocktype.init; begin c:=dim; d:=@firstvalue; end;

function blocktype.value; begin value:=0; end;
function extendedarrayblocktype.value; begin value:=d^[n] end;

end.

{ ========================   DEMO ============================= }

{JWR: The output scrolls without stopping.  You might want to replace
"writeln;" with "readln;" so that you can follow along in the QPRO
manual while you run the example. What I usually do for testing is
just to redirect everything to a file from the command line and then
examine the file.}

program fintest;
uses ufinance,ublock;

{ these types and consts are used for the IRR and NPV functions }

type
xray3 = array [1..3] of extended;
xray5 = array [1..5] of extended;
xray7 = array [1..7] of extended;
bt = object(extendedarrayblocktype) end;

const
x1: xray3 = (-10,150,-145);
x2: xray3 = (-10,150.1,-145);
a: xray7 = (-3000,700,600,750,900,1000,1400);
b: xray7 = (-50000,-8000,2000,4000,6000,5000,4500);
c: xray7 = (-10000,1000,1000,1200,2000,3000,4000);
a2: xray5 = (-5000,2000,2000,2000,2000);
b2: xray7 = (8000,9000,8500,9500,10000,11000,10000);
c2: xray7 = (200,350,-300,600,700,1000,1200);
d2: xray7 = (3500,4000,3000,5000,4000,6500,7000);

block1:bt = (c:3; d:@x1);
block2:bt = (c:3; d:@x2);
block3:bt = (c:7; d:@a);
block4:bt = (c:7; d:@b);
block5:bt = (c:7; d:@c);
block6:bt = (c:5; d:@a2);
block7:bt = (c:4; d:@a2);
block8:bt = (c:7; d:@b2);
block9:bt = (c:7; d:@c2);
block10:bt = (c:7; d:@d2);

begin

writeln('Test of UFinance unit.  Examples from');
writeln('    Quattro Pro 3.0 @Functions and Macros manual');
writeln;
writeln('page 29 (CTERM):');
writeln(cterm(0.07,5000,3000):10:2);
writeln(nper(0.07,0,-3000,5000,0):10:2,'(nper)');
writeln(cterm(0.1,5000,3000):10:6);
writeln(cterm(0.12,5000,3000):10:6);
writeln(cterm(0.12,10000,7000):10:6);
writeln;
writeln('pages 35-36 (DDB):');
writeln(ddb(4000,350,8,2):10:0);
writeln(ddb(15000,3000,10,1):10:0);
writeln(ddb(15000,3000,10,2):10:0);
writeln(ddb(15000,3000,10,3):10:0);
writeln(ddb(15000,3000,10,4):10:0);
writeln(ddb(15000,3000,10,5):10:0);
writeln;
writeln('page 48 (FV):');
writeln(fv(500,0.15,6):10:2);
writeln(fval(0.15,6,-500,0,0):10:2,'(fval)');
writeln(fv(200,0.12,5):10:2);
writeln(fv(500,0.9,4):10:2);
writeln(fv(800,0.9,3):10:2);
writeln(fv(800,0.9,6):10:2);
writeln;
writeln('page 49 (FVAL):');
writeln(fval(0.15,6,-500,0,1):10:2);
writeln(fval(0.15,6,-500,-340,1):10:2);
writeln;
writeln('page 57 (IPAYMT):');
writeln(ipaymt(0.1/12,2*12,30*12,100000,0,0):10:2);
writeln;
writeln('pages 57-58 (IRATE):');
writeln(irate(5*12,-500,15000,0,0):10:5);
writeln(irate(5,-2000,-2.38,15000,0):10:4);
writeln;
writeln('pages 60-61 (IRR):');
writeln(irr(0,block1)*100:10:2,'%');
writeln(irr(10,block1)*100:10:0,'%');
writeln(irr(0,block2)*100:10:2,'%');
writeln(irr(10,block2)*100:10:0,'%');
writeln(irr(0,block3)*100:10:2,'%');
writeln(irr(0,block4)*100:10:2,'%');
writeln(irr(0,block5)*100:10:2,'%');
writeln;
writeln('page 73 (NPER):');
writeln(nper(0.115,-2000,-633,50000,0):10:2);
writeln;
writeln('page 75 (NPV):');
writeln(npv(0.1,block6,1):10:0);
writeln(a2+npv(0.1,block7,0):10:0);
writeln(npv(0.0125,block8,0):10:2);
writeln(npv(0.15/12,block9,0):10:0);
writeln(npv(0.15/12,block10,0):10:0);
writeln;
writeln('page 77 (PAYMT):');
writeln(paymt(0.175/12,12*30,175000,0,0):10:2);
writeln(paymt(0.175/12,12*30,175000,0,1):10:2);
writeln(paymt(0.175/12,12*30,175000,-80000,0):10:2);
writeln;
writeln('pages 78-79 (PMT)');
writeln(pmt(10000,0.15/12,3*12):10:2);
writeln(paymt(0.15/12,3*12,10000,0,0):10:2,'(paymt)');
writeln(pmt(1000,0.12,5):10:2);
writeln(pmt(500,0.16,12):10:2);
writeln(pmt(5000,0.16/12,12):10:2);
writeln(pmt(12000,0.11,15):10:2);
writeln;
writeln('page 79 (PPAYMT):');
writeln(ppaymt(0.1/12,2*12,30*12,100000,0,0):10:2);
writeln(ppaymt(0.15/4,24,40,10000,0,1):10:2);
writeln;
writeln('page 81 (PV)');
writeln(pv(350,0.07/12,5*12):10:2);
writeln(pval(0.07/12,5*12,-350,0,0):10:2,'(pval)');
writeln(pv(277,0.12,5):10:2);
writeln(pv(600,0.17,10):10:2);
writeln(pv(100,0.11,12):10:2);
writeln;
writeln('page 82 (PVAL)');
writeln(pval(0.1,12,2000,0,0):10:2);
writeln(pval(0.1,15,0,30000,0):10:2);
writeln;
writeln('page 84 (RATE)');
writeln(rate(4000,2000,10)*100:6:2,'%');
writeln(rate(10000,7000,6*12)*100:6:2,'%');
writeln(rate(1200,1000,3)*100:6:2,'%');
writeln(rate(500,100,25)*100:6:2,'%');
writeln;
writeln('page 89 (SLN)');
writeln(sln(4000,350,8):10:2);
writeln(sln(15000,3000,10):10:0);
writeln(sln(5000,500,5):10:0);
writeln(sln(1800,0,3):10:0);
writeln;
writeln('pages 94-95 (SYD)');
writeln(syd(4000,350,8,2):10:2);
writeln(syd(12000,1000,5,1):10:0);
writeln(syd(12000,1000,5,2):10:0);
writeln(syd(12000,1000,5,3):10:0);
writeln(syd(12000,1000,5,4):10:0);
writeln(syd(12000,1000,5,5):10:0);
writeln;
writeln(ddb(12000,1000,5,1):10:0,'(ddb)');
writeln(ddb(12000,1000,5,2):10:0,'(ddb)');
writeln(ddb(12000,1000,5,3):10:0,'(ddb)');
writeln(ddb(12000,1000,5,4):10:0,'(ddb)');
writeln(ddb(12000,1000,5,5):10:0,'(ddb)');
writeln;
writeln('page 96 (TERM)');
writeln(term(2000,0.11,50000):10:2);
writeln(nper(0.11,-2000,0,50000,0):10:2,'(nper)');
writeln(term(300,0.06,5000):10:1);
writeln(term(500,0.07,1000):10:2);
writeln(term(500,0.07,1000):10:2);
writeln(term(1000,0.10,50000):10:1);
writeln(term(100,0.05,1000):10:1);
end.

``````