home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
dblib201.zip
/
FINANCE.PRG
< prev
next >
Wrap
Text File
|
1993-02-23
|
46KB
|
1,099 lines
*-------------------------------------------------------------------------------
*-- Program...: FINANCE.PRG
*-- Programmer: Ken Mayer (CIS: 71333,1030)
*-- Date......: 02/23/1993
*-- Notes.....: These finance functions are for use with interest rates and
*-- such. See the file README.TXT for details about the use of this
*-- library file.
*--
*-- NOTES ABOUT THESE ROUTINES (the ones written by Jay Parsons)
*-- The functions that use (1+nRate)^nPeriods require that the
*-- rate be stated in the same terms as the compounding period.
*-- That is, for monthly compounding the nRate should be the annual
*-- rate / 12, and the nPeriods the number of months, and so forth.
*--
*-- If the situation involves continuous compounding, state the
*-- rate as the exponent of the annual rate, less 1, and state the
*-- periods in years. Accordingly, to find the value in 30 months
*-- of a $1000 investment continuously compounded at 6%, use:
*-- FuturVal(1000,exp(.06)-1,30/12)
*--
*-- These functions (except NPV(), which sums a series of equal
*- or unequal cash flows), are designed for use with a single
*-- "investment", one payment or receipt. If the problem involves
*-- a series of equal payments or receipts like a mortgage loan,
*-- a Holiday Club or an annuity, the fv() and pv() functions
*-- built in to dBASE IV should be used instead where possible.
*-------------------------------------------------------------------------------
FUNCTION Discount
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Compute the present value of an amount to be received at the
*-- end of a number of periods given a periodic interest rate.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Discount(<nFuturVal>,<nRate>,<nPeriods>)
*-- Example.....: ?Discount(1000,.08,6)
*-- Returns.....: Numeric
*-- Parameters..: nFuturVal = the amount to be received/paid in the future
*-- nRate = the periodic rate of interest
*-- nPeriods = the number of periods
*-------------------------------------------------------------------------------
parameters nFuturVal, nRate, nPeriods
RETURN nFuturVal / ( 1 + nRate ) ^ nPeriods
*-- EoF: Discount()
FUNCTION FuturVal
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Compute the future value of an initial amount at compound
*-- interest received at a given periodic rate for a number of
*-- periods.
*-- Written for.: dBASE IV, 1.0
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: FuturVal(<nPresVal>,<nRate>,<nPeriods>)
*-- Example.....: ?FuturVal(10000,.06,48)
*-- Returns.....: Numeric
*-- Parameters..: nPresVal = Present Value
*-- nRate = Periodic interest rate
*-- nPeriods = Number of periods to calculate for
*-------------------------------------------------------------------------------
parameters nPresVal, nRate, nPeriods
RETURN nPresVal * ( 1 + nRate ) ^ nPeriods
*-- EoF: FuturVal()
FUNCTION Rate
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Compute rate of periodic interest needed to produce a future
*-- value from a present value in a given number of periods. If
*-- the periods are not years, you'll probably want to multiply
*-- the rate returned by the number of periods in a year to
*-- obtain the equivalent annual rate.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Rate(<nFutVal>,<nPresVal>,<nPeriods>)
*-- Example.....: ?Rate(50000,10000,48)
*-- Returns.....: Numeric
*-- Parameters..: nFutVal = Future Value
*-- nPresVal = Present Value
*-- nPeriods = Number of periods to calculate for
*-------------------------------------------------------------------------------
parameters nFutVal, nPresVal, nPeriods
RETURN ( nFutVal / nPresVal ) ^ ( 1 / nPeriods ) - 1
*-- EoF: Rate()
FUNCTION ContRate
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Rate if compounding is continuous. Periods must be years.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: RATE() Function in FINANCE.PRG
*-- Called by...: Any
*-- Usage.......: ContRate(<nFutVal>,<nPresVal>,<nYears>)
*-- Example.....: ?ContRate(50000,10000,4)
*-- Returns.....: Numeric
*-- Parameters..: nFutVal = Future Value
*-- nPresVal = Present Value
*-- nYears = Number of years to calculate for
*-------------------------------------------------------------------------------
parameters nFutVal, nPresVal, nYears
RETURN log( 1 + Rate( nFutval, nPresval, nYears ) )
*-- EoF: ContRate()
FUNCTION NPV
*-------------------------------------------------------------------------------
*-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Net present value of array aCashflow[ nPeriods ]
*-- Calculates npv given assumed rate and # periods.
*-- See "Other inputs" below for instructions/details ...
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: NPV(<nRate>,<nPeriods>)
*-- Example.....: ? NPV( .06, 6 )
*-- Returns.....: Float = value of the project at given rate
*-- Parameters..: nRate = Interest Rate
*-- : nPeriods = Number of Periods to calculate for
*-- Other inputs: Requires the array aCashflow[ ] set up before calling.
*-- : Each of its elements [n] holds the cash flow at the
*-- : beginning of period n, with a negative amount indicating
*-- : a cash outflow. Elements of value 0 must be included for
*-- : all periods with no cash flow, and all periods must be of
*-- : equal length.
*-- : If the project is expected to require an immediate outlay
*-- : of $6,000 and to return $2,000 at the end of each of the
*-- : first five years thereafter, the array will be:
*-- : aCashflow[1] = -6000
*-- : aCashflow[2] = 2000
*-- : aCashflow[3] = 2000
*-- : * * *
*-- : aCashflow[6] = 2000
*-- :
*-- : If the cash flows are at the end of the periods, rather
*-- : than at the beginning, assign 0 to aCashFlow[1], then
*-- : assign cash flows successively. aCashFlow[2] will then
*-- : represent the cash flow at the end of period 1, rather
*-- : than at the beginning of period 2, which is the same thing.
*-- :
*-- : Rewriting the function to have array name passed as a
*-- : parameter is possible, but will slow down execution to an
*-- : extent that will be very noticeable if this function is being
*-- : repeatedly executed, as by Zeroin() to find an Internal Rate
*-- : of Return.
*-------------------------------------------------------------------------------
parameters nRate, nPeriods
private nDiscount, nFactor, nPeriod, nNpv
nPeriod = 1
nNpv = aCashflow[ 1 ]
nDiscount = float( 1 )
nFactor = 1 / ( 1 + nRate )
do while nPeriod < nPeriods
nPeriod = nPeriod + 1
nDiscount = nDiscount * nFactor
nNpv = nNpv + aCashflow[ nPeriod ] * nDiscount
enddo
RETURN nNpv
*-- EoF: NPV()
FUNCTION Irr
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- : Based on code by Tony Lima (CIS: 72331,3724), 1990.
*-- Date........: 4/13/1992
*-- Notes.......: Finds internal rate of return using Zeroin().
*-- : An internal rate of return is an interest rate at
*-- : which the net present value of a series of cash flows
*-- : is zero. In the normal case of an investment, where
*-- : cash flows out at first, then comes back in later periods,
*-- : the IRR gives the interest rate for an equally-good deal, and
*-- : investments with higher IRR should be considered first.
*-- :
*-- : As this function uses the Npv() function to evaluate the
*-- : cash flows at each assumed rate, and Npv() requires for
*-- : speed that the cash flows be placed in the array aCashflow[],
*-- : the cash flows must be placed there before calling this
*-- : function. The number of rows in aCashflow[] is a parameter
*-- : passed through by Zeroin() to Npv().
*-- :
*-- Written for.: dBASE IV Version 1.5
*-- Rev. History: Original function 1990.
*-- : Modified to match Zeroin(), Npv(), 4/13/1992
*-- Calls : Zeroin() Function in STATS.PRG
*-- : Arrayrows() Function in ARRAYS.PRG
*-- Called by...: Any
*-- Usage.......: ? Irr( <fX1>, <fX2>, n_Flag )
*-- Example.....: nRate = Irr( 11, 0, 200, n_Flag )
*-- Returns : a float value representing Irr, if n_Flag < 3.
*-- Parameters..: fX1, lowest plausible rate of return from this project.
*-- : fX2, highest plausible rate of return, ditto.
*-- : n_Flag, an integer to signal success ( < 3 ) or failure.
*-- Other input : Requires advance setup of array to be called by Npv,
*-- : as furnished "aCashflow[]", to hold cash flows.
*-- Side effects: Uses and alters a global numeric variable, here called
*-- : "n_Flag", to report error conditions resulting in value
*-- : returned being meaningless.
*-------------------------------------------------------------------------------
PARAMETERS fX1, fX2, n_Flag
RETURN Zeroin( "Npv", fX1, fX2, float( 1 / 10 ^ 6 ), 100, ;
n_Flag, arrayrows( "aCashflow" ) )
*-- EoF: Irr()
FUNCTION Irr2 && {version 1.01}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/25/1993
*-- Notes.......: Returns internal rate of return on an investment from
*-- evenly-spaced periodic cashflows. The UDF simultaneously
*-- accumulates the periodic Net Present Values of the
*-- individual cashflows along with the first derivative of
*-- the function. After the summation is completed for each
*-- guess, the guess is adjusted by subtracting the ratio
*-- of the function to its derivative.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/25/1993 -- Original
*-- 01/28/1993 - 1.01 -- to add missing private variables. To
*-- count iterations without sign change in PV. Move
*-- division by nRatio outside inner loop.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Irr2(<nN>, <cFlow>, <lSw>, <nGuess>)
*-- Example.....: Rate = Irr2(6, "Cash", Switch, .01)
*-- Returns.....: Internal Rate of Return.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of the array holding the cashflows
*-- lSw = name of a logical variable to be switched to
*-- indicate valid IRR returned (.t.).
*-- nGuess = optional guess for initialing search.
*-------------------------------------------------------------------------------
parameters nN, cFlow, lSw, nGuess
private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
private nSignChng, nDiscount, nRatio, nSumPV, nCurrPV, nSumDeriv, nOldPV
private nIters, lSw1
store 0 to nI, nPosVal, nNegVal, nIters
store .t. to lSw
store .f. to lSw1
declare nCashFlow[nN]
*-- Transfer cashflows to a private array and separate negatives from
*-- positives
do while nI < nN
nI = nI+1
store &cFlow[nI] to nCashFlow[nI], nCurVal
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if nNegVal = 0 .or. nPosVal = 0
wait "Must have at least one positive and one negative value"
endif
*-- Use initializing guess if provided, otherwise calculate from
*-- weighted average returns.
if pcount() = 4
nIRR = nGuess
else
nIRR = ((-nPosVal/nNegVal)-1)/nN
endif
*-- Housekeeping summary accumulators, etc., before entering loop
store 1 to nNuDelta, nOlDelta
store 0 to nSignChng, nBigChange
*-- Loop until estimated rate indicated accuracy
do while abs(nNuDelta) > .000001
store 0 to nI, nSumPV, nSumDeriv
*-- Set up cumulative denominator to calculate incremental NPV
nDiscount = 1
nRatio = 1 + nIRR
do while nI < nN
nI = nI+1
nDiscount = nDiscount/nRatio
*-- Calculate incremental PV and add to sum
nCurrPV = nDiscount * nCashFlow[nI]
nSumPV = nSumPV + nCurrPV
*-- Add incremental first derivative to derivative sum
nSumDeriv = nSumDeriv - nI * nCurrPV
enddo
*-- count iterations and test for sign change of future value
if .not. lSw1 .and. nIters > 0
lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
endif
nIters = nIters + 1
nOldPV = nSumPV
*-- Calculate indicated change in IRR
nNuDelta = nRatio * nSumPV/nSumDeriv
*-- Test for big changes in adjusted IRR, limit to 10 times
*-- current guess for IRR and count big changes.
if abs(nNuDelta/nIRR) > 10
nNuDelta = sign(nNuDelta) * 10 * nIRR
nBigChange = nBigChange + 1
endif
nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR
*-- Count reversals in adjustments to limit hunting
nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
nOlDelta = nNuDelta
*-- Test for hunting, too many bigchanges or too large a solution
*-- and set external switch if abnormal exit is used.
if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
(nIters > 9 .and. .not. lSw1)
store .f. to lSw
exit
endif
enddo
RETURN nIRR
*-- EoF: Irr2()
FUNCTION Mirr && {version 1.0}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/27/1993
*-- Notes.......: Used to calculate the Modified Internal Rate of Return
*-- for evenly-spaced periodic cashflows. The modifications
*-- assume that more realistic investment models should
*-- account for the cost of borrowing or the lower 'safe'
*-- rate for keeping reserve funds to cover outlays and the
*-- fact that reinvestments will be made at some other rate
*-- than the IRR itself. This model calculates the answer
*-- directly, therefore more rapidly than the iterative
*-- approach used by IRR.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/27/1993 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Mirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
*-- Example.....: Rate = Mirr(6, "Cash", .1, .14)
*-- Returns.....: Modified Internal Rate of Return per period.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of the array holding the cashflows
*-- nRrate = Reinvestment rate for positive cashflows.
*-- nFrate = 'Safe' rate expected on reserve funds to
*-- cover disbursements.
*-------------------------------------------------------------------------------
parameters nN, cFlow, nRrate, nFrate
private nI, nNegVal, nPosVal, nCurVal
store 0 to nI, nNegVal, nPosVal
*-- Pass through array once computing present value of negative
*-- cashflows at 'safe' rate and present value of positive values
*-- at the reinvestment rate.
do while nI < nN
nI = nI+1
nCurVal = &cFlow[nI]
nCurVal = nCurVal*(1+iif(nCurVal<0,nFrate,nRrate))^-(nI-1)
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if abs(nNegVal) = 0 .or. nPosVal = 0
wait " There must be at least one negative and one positive value! "
return 0
endif
*-- Calculate the rate of return required to yield a future value
*-- of the positive values reinvested at nRrate from the present
*-- value of the negative values invested at the 'safe' rate.
RETURN ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
*-- EoF: Mirr()
FUNCTION Xmirr && {version 1.01}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/27/1993
*-- Notes.......: Used to calculate the Modified Internal Rate of Return
*-- from cashflows on random dates. Except for the need to
*-- supply both the dates of transactions and the cashflows
*-- in an 'nN' by 2 array, the other inputs are the same as
*-- in Mirr(). Dates may be in random order except for the
*-- first date. The first date in the array establishes
*-- the date to which present value applies. Enter 'Safe'
*-- rate for reserves and 'Reinvestment' rate for positive
*-- cashflows as annual rates, e.g., .075 for 7.5%.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/27/1993 -- 1.01 - to allow entry of 'Safe' reserve rate
*-- and 'Reinvestment' rate as annual rates rather than
*-- rates. Also, to return the 'effective' rate of interest
*-- when compounded daily, rather than the 'nominal' rate.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Xmirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
*-- Example.....: Rate = Xmirr(5, "Cash", .14, .1)
*-- Returns.....: Annualized Effective Modified Internal Rate of Return
*-- based on daily compounded interest.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of 'nN' by 2 array holding the dates (col 1)
*-- and cashflow amounts (col 2).
*-- nRrate = Reinvestment rate for positive cashflows.
*-- nFrate = 'Safe' rate expected on reserve funds to
*-- cover disbursements.
*-------------------------------------------------------------------------------
parameters nN, cFlow, nRrate, nFrate
private nI, nCurVal, nNegVal, nPosVal, dPDate
private dMaxDate, dCurDate, nCurN, nMirr
store 0 to nI, nNegVal, nPosVal
store (1+nRrate)^(1/365)-1 to nRrate
store (1+nFrate)^(1/365)-1 to nFrate
store &cFlow[1,1] to dPDate
dMaxDate = dPDate
do while nI < nN
nI = nI+1
nCurVal = &cFlow[nI,2]
dCurDate = &cFlow[nI,1]
dMaxDate = max(dCurDate,dMaxDate)
nCurN = dCurDate-dPDate
nCurVal = nCurVal/(1+iif(nCurVal<0,nFrate,nRrate))^nCurN
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if nNegVal = 0 .or. nPosVal = 0
wait " There must be at least one negative and one positive value! "
return 0
endif
nN = dMaxDate - dPDate
nMirr = ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
RETURN (1+nMirr)^365-1
*-- EoF: Xmirr()
FUNCTION Xirr && {version 1.01}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/25/1993
*-- Notes.......: Used to calculate the Internal Rate of Return from
*-- cashflows on random dates. Except for the need to
*-- supply both the dates of transactions and the cashflows
*-- in an 'nN' by 2 array, the other inputs are the same as
*-- in Irr(). Dates may be in random order except for the
*-- first date. The first date in the array establishes
*-- the date to which present value applies.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/25/1993 -- Original
*-- 01/28/1993 - 1.01 -- to return 'effective' rate of interest
*-- when compounded daily rather than the 'nominal' rate.
*-- Also to count iterations without a sign change in PV.
*-- Move division by nRatio outside inner loop.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
*-- Example.....: Rate = Irr(5, "Cash", "Switch", .01)
*-- Returns.....: Effective Internal Rate of Return.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of the 'nN' by 2 array holding the
*-- dates (col 1) and cashflows (col 2). Dates
*-- may be entered in any order except for the
*-- date, which is the date to which present
*-- value applies.
*-- lSw = name of a logical variable to be switched to
*-- indicate valid IRR returned (.t.).
*-- nGuess = optional guess for initializing search.
*-------------------------------------------------------------------------------
parameters nN, cFlow, lSw, nGuess
private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
private nSignChng, nRatio, dPDate, dMaxDate, nCurrPV, nSumDeriv
private nSumPV, dCurDate, nIters, lSw1
store 0 to nI, nPosVal, nNegVal, nIters
Store .t. to lSw
declare nCashFlow[nN,2]
store &cFlow[1,1] to dMaxDate, dPDate
store .f. to lSw1
*-- Transfer cashflows to a private array and separate negatives from
*-- positives. Find last date.
do while nI < nN
nI = nI+1
store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
store max(dCurDate,dMaxDate) to dMaxDate
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if nNegVal = 0 .or. nPosVal = 0
wait "Must have at least one positive and one negative value"
endif
*-- Use initializing guess if provided, otherwise calculate from
*-- weighted average returns.
if pcount() = 4
nIRR = nGuess
else
nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
(dMaxDate-dPDate)
endif
*-- Housekeeping summary accumulators, etc., before entering loop
store 1 to nNuDelta, nOlDelta
store 0 to nSignChng, nBigChange
*-- Loop until estimated rate indicated accuracy
do while abs(nNuDelta) > .000001
store 0 to nI, nSumPV, nSumDeriv
store 1 + nIrr to nRatio
do while nI < nN
nI = nI+1
*-- Calculate incremental PV and add to sum
nCurrPV = nCashFlow[nI,2] / nRatio^(nCashFlow[nI,1] - dPDate)
nSumPV = nSumPV + nCurrPV
*-- Add incremental first derivative to derivative sum
nSumDeriv = nSumDeriv - (nCashFlow[nI,1] - dPDate) * nCurrPV
enddo
*-- count iterations and test for sign change of future value
if .not. lSw1 .and. nIters > 0
lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
endif
nIters = nIters + 1
nOldPV = nSumPV
*-- Calculate indicated change in IRR
nNuDelta = nRatio * nSumPV/nSumDeriv
*-- Test for big changes in adjusted IRR, limit to 10 times
*-- current guess for IRR and count big changes.
if abs(nNuDelta/nIRR) > 10
nNuDelta = sign(nNuDelta) * 10 * nIRR
nBigChange = nBigChange + 1
endif
nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR
*-- Count reversals in adjustments to limit hunting
nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
nOlDelta = nNuDelta
*-- Test for hunting, too many bigchanges or too large a solution
*-- and set external switch if abnormal exit is used.
if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
(nIters > 9 .and. .not. lSw1)
store .f. to lSw
exit
endif
enddo
RETURN (1+nIrr)^365 -1
*-- EoF: Xirr()
FUNCTION FVirr && {version 1.01}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/28/1993
*-- Notes.......: Returns same roots as Irr(), but averages 20% faster.
*-- Irr() searches for the roots of NPV (Net Present Value),
*-- while FVirr() searches for the same roots of NFV (Net
*-- Future Value), both with respect to the rate of return.
*-- The user may wish to use this UDF in place of Irr() and
*-- use Irr() as an alternate to help locate more multiple
*-- solutions. The reason this UDF is 'usually' faster is due
*-- to the fact that the NFV curve is 'usually' steeper as
*-- it crosses the zero axis.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/28/1993 -- Original
*-- 01/28/1993 -- 1.01 - Modified Irr() to use Net Future Value
*-- curve instead of Net Present Value curve.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
*-- Example.....: Rate = Irr(6, "Cash", Switch, .01)
*-- Returns.....: Internal Rate of Return.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of the array holding the cashflows
*-- lSw = name of a logical variable to be switched to
*-- indicate valid IRR returned (.t.).
*-- nGuess = optional guess for initialing search.
*-------------------------------------------------------------------------------
parameters nN, cFlow, lSw, nGuess
private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
private nSignChng, nDiscount, nRatio, nSumFV, nCurrFV, nSumDeriv, nOldFV
private nIters, lSw1
store 0 to nI, nPosVal, nNegVal, nIters
store .t. to lSw
store .f. to lSw1
declare nCashFlow[nN]
*-- Transfer cashflows to a private array and separate negatives from
*-- positives
do while nI < nN
nI = nI+1
store &cFlow[nI] to nCashFlow[nI], nCurVal
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if nNegVal = 0 .or. nPosVal = 0
wait "Must have at least one positive and one negative value"
endif
*-- Use initializing guess if provided, otherwise calculate from
*-- weighted average returns.
if pcount() = 4
nIRR = nGuess
else
nIRR = ((-nPosVal/nNegVal)-1)/nN
endif
*-- Housekeeping summary accumulators, etc., before entering loop
store 1 to nNuDelta, nOlDelta
store 0 to nSignChng, nBigChange
*-- Loop until estimated rate indicated accuracy
do while abs(nNuDelta) > .000001
store 0 to nI, nSumFV, nSumDeriv
*-- Set up cumulative denominator to calculate incremental NFV
nRatio = 1 + nIRR
nDiscount = nRatio^nN
do while nI < nN
nI = nI+1
nDiscount = nDiscount/nRatio
*-- Calculate incremental FV and add to sum
nCurrFV = nDiscount * nCashFlow[nI]
nSumFV = nSumFV + nCurrFV
*-- Add incremental first derivative to derivative sum
nSumDeriv = nSumDeriv - nI * nCurrFV
enddo
*-- count iterations and test for sign change of future value
if .not. lSw1 .and. nIters > 0
lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
endif
nIters = nIters + 1
nOldFV = nSumFV
*-- Calculate indicated change in IRR
nNuDelta = nRatio * nSumFV/nSumDeriv
*-- Test for big changes in adjusted IRR, limit to 10 times
*-- current guess for IRR and count big changes.
if abs(nNuDelta/nIRR) > 10
nNuDelta = sign(nNuDelta) * 10 * nIRR
nBigChange = nBigChange + 1
endif
nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR
*-- Count reversals in adjustments to limit hunting
nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
nOlDelta = nNuDelta
*-- Test for hunting, too many bigchanges or too large a solution
*-- and set external switch if abnormal exit is used.
if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
(nIters > 9 .and. .not. lSw1)
store .f. to lSw
exit
endif
enddo
RETURN nIRR
*-- EoF: FVirr()
FUNCTION FVxirr && {version 1.01}
*-------------------------------------------------------------------------------
*-- Programmer..: Ron Allen (CIS: 71201,2502)
*-- Date........: 01/28/1993
*-- Notes.......: Same as Xirr() except that the Net Future Value (NFV)
*-- function is used instead of the Net Present Value (NPV)
*-- function. The roots are the same, but this function is
*-- usually faster for the same reasons that FVirr() is
*-- faster than Irr(). As in Xirr(), all dates except the
*-- first date in the array may be in random order. The first
*-- date in the nN by 2 array along with the maximum date
*-- establishes the range of the investment analysis.
*-- Written for.: dBASEIV, version 1.5, tested on build xx71
*-- Rev. History: 01/28/1993
*-- 01/28/1993 -- 1.01 - Modified Xirr() to find roots of the
*-- Net Future Value curve.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
*-- Example.....: Rate = Irr(5, "Cash", Switch, .01)
*-- Returns.....: Effective Internal Rate of Return.
*-- Parameters..: nN = number of cashflows in model
*-- cFlow = name of the 'nN' by 2 array holding the
*-- dates (col 1) and cashflows (col 2). Dates
*-- may be entered in any order except for the
*-- date, which is the date to which present
*-- value applies.
*-- lSw = name of a logical variable to be switched to
*-- indicate valid IRR returned (.t.).
*-- nGuess = optional guess for initializing search.
*-------------------------------------------------------------------------------
parameters nN, cFlow, lSw, nGuess
private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
private nSignChng, nRatio, dPDate, dMaxDate, nCurrFV, nSumDeriv
private nSumFV, dCurDate, lSw1, nIters
store 0 to nI, nPosVal, nNegVal, nIters
Store .t. to lSw
declare nCashFlow[nN,2]
store &cFlow[1,1] to dMaxDate, dPDate
*-- Transfer cashflows to a private array and separate negatives from
*-- positives. Find last date.
do while nI < nN
nI = nI+1
store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
store max(dCurDate,dMaxDate) to dMaxDate
if nCurVal < 0
nNegVal = nNegVal + nCurVal
else
nPosVal = nPosVal + nCurVal
endif
enddo
if nNegVal = 0 .or. nPosVal = 0
wait "Must have at least one positive and one negative value"
endif
*-- Use initializing guess if provided, otherwise calculate from
*-- weighted average returns.
if pcount() = 4
nIRR = nGuess
else
nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
(dMaxDate-dPDate)
endif
*-- Housekeeping summary accumulators, etc., before entering loop
store 1 to nNuDelta, nOlDelta
store 0 to nSignChng, nBigChange
store .f. to lSw1
*-- Loop until estimated rate indicated accuracy
do while abs(nNuDelta) > .000001
store 0 to nI, nSumFV, nSumDeriv
store 1 + nIrr to nRatio
do while nI < nN
nI = nI+1
*-- Calculate incremental FV and add to sum
nCurrFV = nCashFlow[nI,2] * nRatio^(dMaxDate - nCashFlow[nI,1])
nSumFV = nSumFV + nCurrFV
*-- Add incremental first derivative to derivative sum
nSumDeriv = nSumDeriv + (dMaxDate - nCashFlow[nI,1]) * nCurrFV
enddo
*-- count iterations and test for sign change of future value
if .not. lSw1 .and. nIters > 0
lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
endif
nIters = nIters + 1
nOldFV = nSumFV
*-- Calculate indicated change in IRR
nNuDelta = nRatio * nSumFV/nSumDeriv
*-- Test for big changes in adjusted IRR, limit to 10 times
*-- current guess for IRR and count big changes.
if abs(nNuDelta/nIRR) > 10
nNuDelta = sign(nNuDelta) * 10 * nIRR
nBigChange = nBigChange + 1
endif
nIRR = nIRR - nNuDelta && Make adjustment to guess for IRR
*-- Count reversals in adjustments to limit hunting
nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
nOlDelta = nNuDelta
*-- Test for hunting, too many bigchanges or too large a solution
*-- and set external switch if abnormal exit is used.
if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
(nIters > 9 .and. .not. lSw1)
store .f. to lSw
exit
endif
enddo
RETURN (1+nIrr)^365 -1
*-- EoF: FVxirr()
*-------------------------------------------------------------------------------
*-- Note: The following functions are here as a courtesy, as they are used in at
*-- least one of the functions above.
*-------------------------------------------------------------------------------
FUNCTION Zeroin
*-------------------------------------------------------------------------------
*-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
*-- Date........: 04/13/1992
*-- Notes.......: Finds a zero of a continuous function.
*-- : In substance, what this function does is close in on a
*-- : solution to a function that cannot otherwise be solved.
*-- : Assuming Y = f(X), if Y1 and Y2, the values of the function
*-- : for X1 and X2, have different signs, there must be at least
*-- : one value of X between X1 and X2 for which Y = 0, if the
*-- : function is continuous. This function closes in on such a
*-- : value of X by a trial-and-error process.
*-- :
*-- : This function is very slow, so a maximum number of iterations
*-- : is passed as a parameter. If the number of iterations is
*-- : exceeded, the function will fail to find a root. If this
*-- : occurs, pick different original "X" values, increase the
*-- : number of iterations or increase the errors allowed. Once
*-- : an approximate root is found, you can use values of X close
*-- : on either side and reduce the error allowed to find an
*-- : improved solution. Also, of course, the signs of Y must be
*-- : different for the starting X values for the function to
*-- : proceed at all.
*-- :
*-- : NOTE ESPECIALLY - There is NO guarantee that a root returned
*-- : by this function is the only one, or the most meaningful.
*-- : It depends on the function that this function calls, but if
*-- : that function has several roots, any of them may be returned.
*-- : This can easily happen with such called functions as net
*-- : present value where the cash flows alternate from positive
*-- : to negative and back, and in many other "real life" cases.
*-- : See the discussion of @IRR in the documentation of a good
*-- : spreadsheet program such as Quattro Pro for further
*-- : information.
*-- :
*-- : The method used by this function is a "secant and bisect"
*-- : search. The "secant" is the line connecting two X,Y
*-- : points on a graph using standard Cartesian coordinates.
*-- : Where the secant crosses the X axis is the best guess for
*-- : the value of X that will have Y = 0, and will be correct
*-- : if the function is linear between the two points. The
*-- : basic strategy is to calculate Y at that value of X, then
*-- : keep the new X and that one of the old X values that had
*-- : a Y-value of opposite sign, and reiterate to close in.
*-- :
*-- : If the function is a simple curve with most of the change
*-- : in Y close to one of the X-values, as often occurs if the
*-- : initial values of X are poorly chosen, repeated secants
*-- : will do little to find a Y-value close to zero and will
*-- : reduce the difference in X-values only slightly. In this
*-- : case the function shifts to choosing the new X halfway
*-- : between the old ones, bisecting the difference and always
*-- : reducing the bracket by half, for a while.
*-- :
*-- : While this function finds a "zero", it may be used to
*-- : find an X corresponding to any other value of Y. Suppose
*-- : the function of X is FUNCTION Blackbox( X ) and it is
*-- : desired to find a value of X for which f(X) = 7. The trick
*-- : is to interpose a function between Zeroin() and Blackbox()
*-- : that will return a 0 to Zeroin() whenever Blackbox() returns
*-- : 7. By calling that function, Zeroin() finds a value of
*-- : X for which Blackbox( X ) = 7, as required:
*-- : Result = Zeroin( "Temp", <other parameters omitted> )
*-- :
*-- : FUNCTION Temp
*-- : parameters nQ
*-- : RETURN Blackbox( nQ ) - 7
*-- :
*-- Written for.: dBASE IV Version 1.5
*-- Rev. History: Original function 1990.
*-- : Modified to take optional parameters, 4/13/1992
*-- Calls : The function whose name is first parameter.
*-- Called by...: Any
*-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ;
*-- : <nMaxiter>, <n_Flag> ;
*-- : [, xPass1 [, xPass2 [, xPass3 ] ] ] )
*-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
*-- Returns : a float value representing a root, if n_Flag < 3.
*-- Parameters..: cFunction, the name of the function to solve for a root.
*-- fX1, one of the X-values between which the root is sought.
*-- fX2, the second of these values.
*-- Note: These MUST be chosen so the f( X ) values for the two
*-- of them have opposite signs (they must bracket the result).
*-- fAbserror, the absolute error allowed in the result.
*-- nMaxiter, the maximum number of times to iterate.
*-- n_Flag, an integer to signal success ( < 3 ) or failure.
*-- xPass1 . . . 3, arguments to be passed through to cFunction.
*-- The parameter "n_Flag" should be passed as a variable so it
*-- may be accessed on return. The limit of 9 literal parameters
*-- may require passing others as variables. The "xPass"
*-- parameters are optional and the fact there are three of them
*-- is arbitrary; they exist to hold whatever parameters may be
*-- needed by the function cFunction being called aside from
*-- the value of X for which it is being evaluated. Add more
*-- and change the 3 "&cFunc." lines below if you need more.
*-- Side effects: Uses and alters a global numeric variable, here called
*-- "n_Flag", to report error conditions resulting in value
*-- returned being meaningless. Possible n_Flag values are:
*-- 1 success - root found within error allowed
*-- 2 success - root was found exactly
*-- 3 error - function value not converging
*-- 4 error - original values do not bracket a root
*-- 5 error - maximum iterations exceeded
*-------------------------------------------------------------------------------
parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
n_Flag, xPass1, xPass2, xPass3
private nSplits, fBracket, fFary, fNeary, nIters
private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
store 0 to nSplits, nIters
fBracket = abs ( fNearx - fFarx )
fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 )
fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
if sign( fNeary ) = sign( fFary )
n_Flag = 4
return float(0)
endif
fMaxabs = max( abs( fNeary ), abs( fFary ) )
n_Flag = 0
* Main iteration loop
do while .t.
if abs( fFary ) < abs( fNeary )
* Interchange fNearx and fFarx so that
* fNearx is closer to a solution--
* abs( fNeary ) <= abs( fFary )
fOldx = fNearx
fOldy = fNeary
fNearx = fFarx
fNeary = fFary
fFarx = fOldx
fFary = fOldy
endif
fDiffx = fFarx - fNearx
fAbsdiff = abs( fDiffx )
* Test whether interval is too small to continue
if fAbsdiff <= 2 * fAbserr
if abs( fNeary ) > fMaxabs
* Yes, but we are out of bounds
n_Flag = 3
fNearx = float(0)
else
* Yes, and we have a solution!
n_Flag = 1
endif
exit
endif
* Save the last approximation to x and y
fOldx = fNearx
fOldy = fNeary
* Check if reduction in the size of
* bracketing interval is satisfactory.
* If not, bisect until it is.
nSplits = nSplits + 1
if nSplits >= 4
if 4 * fAbsdiff >= fBracket
fNearx = fNearx + fDiffx / 2
else
nSplits = 0
fBracket = fAbsdiff / 2
* Calculate secant
fSecant = ( fNearx - fFarx ) * fNeary ;
/ ( fFary - fNeary )
* But not less than error allowed
if abs( fSecant ) < fAbserr
fNearx = fnearx + fAbserr * sign( fDiffx )
else
fNearx = fNearx + fSecant
endif
endif
endif
* Evaluate the function at the new approximation
fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
* If it's exactly zero, we win! Run with it
if fNeary = 0.00
n_Flag = 2
exit
endif
* Else adjust iteration count and quit if too
* many iterations with no solution
nIters = nIters + 1
if nIters > nMaxiter
n_Flag = 5
fNearx = float( 0 )
exit
endif
* And finally keep as the new fFarx that one
* of the previous approximations, fFarx and
* fOldx, at which the function has a sign opposite
* to that at the new approximation, fNearx.
if sign( fNeary ) = sign( fFary )
fFarx = fOldx
fFary = fOldy
endif
enddo
RETURN fNearx
*-- EoF: Zeroin()
FUNCTION ArrayRows
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Number of Rows in an array
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: ArrayRows("<aArray>")
*-- Example.....: n = ArrayRows("aTest")
*-- Returns.....: numeric
*-- Parameters..: aArray = Name of array
*-------------------------------------------------------------------------------
parameters aArray
private nHi, nLo, nTrial, nDims
nLo = 1
nHi = 1170
if type( "&aArray[ 1, 1 ]" ) = "U"
nDims = 1
else
nDims = 2
endif
do while .T.
nTrial = int( ( nHi + nLo ) / 2 )
if nHi < nLo
exit
endif
if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
nHi = nTrial - 1
else
nLo = nTrial + 1
endif
enddo
RETURN nTrial
*-- EoF: ArrayRows()
*-------------------------------------------------------------------------------
*-- EoP: FINANCE.PRG
*-------------------------------------------------------------------------------