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[2]);
  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[1]+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.