[Back to MATH SWAG index] [Back to Main SWAG index] [Original]

    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.

[Back to MATH SWAG index] [Back to Main SWAG index] [Original]