home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / dblib201.zip / FINANCE.PRG < prev    next >
Text File  |  1993-02-23  |  46KB  |  1,099 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FINANCE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 02/23/1993
  5. *-- Notes.....: These finance functions are for use with interest rates and 
  6. *--             such. See the file README.TXT for details about the use of this
  7. *--             library file.
  8. *--
  9. *--             NOTES ABOUT THESE ROUTINES (the ones written by Jay Parsons)
  10. *--             The functions that use (1+nRate)^nPeriods require that the
  11. *--             rate be stated in the same terms as the compounding period.
  12. *--             That is, for monthly compounding the nRate should be the annual
  13. *--             rate / 12, and the nPeriods the number of months, and so forth.
  14. *--
  15. *--             If the situation involves continuous compounding, state the
  16. *--             rate as the exponent of the annual rate, less 1, and state the
  17. *--             periods in years.  Accordingly, to find the value in 30 months
  18. *--             of a $1000 investment continuously compounded at 6%, use:
  19. *--                 FuturVal(1000,exp(.06)-1,30/12)
  20. *--
  21. *--             These functions (except NPV(), which sums a series of equal
  22. *-              or unequal cash flows), are designed for use with a single
  23. *--             "investment", one payment or receipt.  If the problem involves
  24. *--             a series of equal payments or receipts like a mortgage loan,
  25. *--             a Holiday Club or an annuity, the fv() and pv() functions
  26. *--             built in to dBASE IV should be used instead where possible.
  27. *-------------------------------------------------------------------------------
  28.  
  29. FUNCTION Discount
  30. *-------------------------------------------------------------------------------
  31. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  32. *-- Date........: 03/01/1992
  33. *-- Notes.......: Compute the present value of an amount to be received at the
  34. *--               end of a number of periods given a periodic interest rate.
  35. *-- Written for.: dBASE IV, 1.1
  36. *-- Rev. History: 03/01/1992 -- Original Release
  37. *-- Calls.......: None
  38. *-- Called by...: Any
  39. *-- Usage.......: Discount(<nFuturVal>,<nRate>,<nPeriods>)
  40. *-- Example.....: ?Discount(1000,.08,6)
  41. *-- Returns.....: Numeric
  42. *-- Parameters..: nFuturVal = the amount to be received/paid in the future
  43. *--               nRate     = the periodic rate of interest
  44. *--               nPeriods  = the number of periods
  45. *-------------------------------------------------------------------------------
  46.  
  47.     parameters nFuturVal, nRate, nPeriods
  48.     
  49. RETURN nFuturVal / ( 1 + nRate ) ^ nPeriods
  50. *-- EoF: Discount()
  51.  
  52. FUNCTION FuturVal
  53. *-------------------------------------------------------------------------------
  54. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  55. *-- Date........: 03/01/1992
  56. *-- Notes.......: Compute the future value of an initial amount at compound
  57. *--               interest received at a given periodic rate for a number of
  58. *--               periods.
  59. *-- Written for.: dBASE IV, 1.0
  60. *-- Rev. History: 03/01/1992 -- Original Release
  61. *-- Calls.......: None
  62. *-- Called by...: Any
  63. *-- Usage.......: FuturVal(<nPresVal>,<nRate>,<nPeriods>)
  64. *-- Example.....: ?FuturVal(10000,.06,48)
  65. *-- Returns.....: Numeric
  66. *-- Parameters..: nPresVal = Present Value
  67. *--               nRate    = Periodic interest rate
  68. *--               nPeriods = Number of periods to calculate for
  69. *-------------------------------------------------------------------------------
  70.  
  71.     parameters nPresVal, nRate, nPeriods
  72.     
  73. RETURN nPresVal * ( 1 + nRate ) ^ nPeriods
  74. *-- EoF: FuturVal()
  75.  
  76. FUNCTION Rate
  77. *-------------------------------------------------------------------------------
  78. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  79. *-- Date........: 03/01/1992
  80. *-- Notes.......: Compute rate of periodic interest needed to produce a future
  81. *--               value from a present value in a given number of periods.  If
  82. *--               the periods are not years, you'll probably want to multiply
  83. *--               the rate returned by the number of periods in a year to 
  84. *--               obtain the equivalent annual rate.
  85. *-- Written for.: dBASE IV, 1.1
  86. *-- Rev. History: 03/01/1992 -- Original Release
  87. *-- Calls.......: None
  88. *-- Called by...: Any
  89. *-- Usage.......: Rate(<nFutVal>,<nPresVal>,<nPeriods>)
  90. *-- Example.....: ?Rate(50000,10000,48)
  91. *-- Returns.....: Numeric
  92. *-- Parameters..: nFutVal  = Future Value
  93. *--               nPresVal = Present Value
  94. *--               nPeriods = Number of periods to calculate for
  95. *-------------------------------------------------------------------------------
  96.  
  97.     parameters nFutVal, nPresVal, nPeriods
  98.     
  99. RETURN ( nFutVal / nPresVal ) ^ ( 1 / nPeriods ) - 1
  100. *-- EoF: Rate()
  101.  
  102. FUNCTION ContRate
  103. *-------------------------------------------------------------------------------
  104. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  105. *-- Date........: 03/01/1992
  106. *-- Notes.......: Rate if compounding is continuous.  Periods must be years.
  107. *-- Written for.: dBASE IV, 1.1
  108. *-- Rev. History: 03/01/1992 -- Original Release
  109. *-- Calls.......: RATE()               Function in FINANCE.PRG
  110. *-- Called by...: Any
  111. *-- Usage.......: ContRate(<nFutVal>,<nPresVal>,<nYears>)
  112. *-- Example.....: ?ContRate(50000,10000,4)
  113. *-- Returns.....: Numeric
  114. *-- Parameters..: nFutVal  = Future Value
  115. *--               nPresVal = Present Value
  116. *--               nYears   = Number of years to calculate for
  117. *-------------------------------------------------------------------------------
  118.  
  119.     parameters nFutVal, nPresVal, nYears
  120.     
  121. RETURN log( 1 + Rate( nFutval, nPresval, nYears ) )
  122. *-- EoF: ContRate()
  123.  
  124. FUNCTION NPV
  125. *-------------------------------------------------------------------------------
  126. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  127. *-- Date........: 03/01/1992
  128. *-- Notes.......: Net present value of array aCashflow[ nPeriods ]
  129. *--               Calculates npv given assumed rate and # periods.
  130. *--               See "Other inputs" below for instructions/details ...
  131. *-- Written for.: dBASE IV, 1.1
  132. *-- Rev. History: 03/01/1992 -- Original Release
  133. *-- Calls.......: None
  134. *-- Called by...: Any
  135. *-- Usage.......: NPV(<nRate>,<nPeriods>)
  136. *-- Example.....: ? NPV( .06, 6 )
  137. *-- Returns.....: Float = value of the project at given rate
  138. *-- Parameters..: nRate    = Interest Rate
  139. *--             : nPeriods = Number of Periods to calculate for
  140. *-- Other inputs: Requires the array aCashflow[ ] set up before calling.
  141. *--             : Each of its elements [n] holds the cash flow at the
  142. *--             : beginning of period n, with a negative amount indicating
  143. *--             : a cash outflow.  Elements of value 0 must be included for
  144. *--             : all periods with no cash flow, and all periods must be of
  145. *--             : equal length.
  146. *--             :  If the project is expected to require an immediate outlay
  147. *--             : of $6,000 and to return $2,000 at the end of each of the
  148. *--             : first five years thereafter, the array will be:
  149. *--             :       aCashflow[1] = -6000
  150. *--             :       aCashflow[2] =  2000
  151. *--             :       aCashflow[3] =  2000
  152. *--             :           * * *
  153. *--             :       aCashflow[6] =  2000
  154. *--             :
  155. *--             :  If the cash flows are at the end of the periods, rather
  156. *--             : than at the beginning, assign 0 to aCashFlow[1], then
  157. *--             : assign cash flows successively. aCashFlow[2] will then
  158. *--             : represent the cash flow at the end of period 1, rather
  159. *--             : than at the beginning of period 2, which is the same thing.
  160. *--             :
  161. *--             :  Rewriting the function to have array name passed as a 
  162. *--             : parameter is possible, but will slow down execution to an 
  163. *--             : extent that will be very noticeable if this function is being
  164. *--             : repeatedly executed, as by Zeroin() to find an Internal Rate
  165. *--             : of Return.
  166. *-------------------------------------------------------------------------------
  167.  
  168.     parameters nRate, nPeriods
  169.     private nDiscount, nFactor, nPeriod, nNpv
  170.     nPeriod = 1
  171.     nNpv = aCashflow[ 1 ]
  172.     nDiscount = float( 1 )
  173.     nFactor = 1 / ( 1 + nRate )
  174.     do while nPeriod < nPeriods
  175.         nPeriod = nPeriod + 1
  176.         nDiscount = nDiscount * nFactor
  177.         nNpv = nNpv + aCashflow[ nPeriod ] * nDiscount
  178.     enddo
  179.     
  180. RETURN nNpv
  181. *-- EoF: NPV()
  182.  
  183. FUNCTION Irr
  184. *-------------------------------------------------------------------------------
  185. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  186. *--             : Based on code by Tony Lima (CIS: 72331,3724), 1990.
  187. *-- Date........: 4/13/1992
  188. *-- Notes.......: Finds internal rate of return using Zeroin().
  189. *--             : An internal rate of return is an interest rate at
  190. *--             : which the net present value of a series of cash flows
  191. *--             : is zero.  In the normal case of an investment, where
  192. *--             : cash flows out at first, then comes back in later periods,
  193. *--             : the IRR gives the interest rate for an equally-good deal, and
  194. *--             : investments with higher IRR should be considered first.
  195. *--             :
  196. *--             : As this function uses the Npv() function to evaluate the
  197. *--             : cash flows at each assumed rate, and Npv() requires for
  198. *--             : speed that the cash flows be placed in the array aCashflow[],
  199. *--             : the cash flows must be placed there before calling this
  200. *--             : function.  The number of rows in aCashflow[] is a parameter
  201. *--             : passed through by Zeroin() to Npv().
  202. *--             :
  203. *-- Written for.: dBASE IV Version 1.5
  204. *-- Rev. History: Original function 1990.
  205. *--             : Modified to match Zeroin(), Npv(), 4/13/1992
  206. *-- Calls       : Zeroin()          Function in STATS.PRG
  207. *--             : Arrayrows()       Function in ARRAYS.PRG
  208. *-- Called by...: Any
  209. *-- Usage.......: ? Irr( <fX1>, <fX2>, n_Flag )
  210. *-- Example.....: nRate = Irr( 11, 0, 200, n_Flag )
  211. *-- Returns     : a float value representing Irr, if n_Flag < 3.
  212. *-- Parameters..: fX1, lowest plausible rate of return from this project.
  213. *--             : fX2, highest plausible rate of return, ditto.
  214. *--             : n_Flag, an integer to signal success ( < 3 ) or failure.
  215. *-- Other input : Requires advance setup of array to be called by Npv,
  216. *--             : as furnished "aCashflow[]", to hold cash flows.
  217. *-- Side effects: Uses and alters a global numeric variable, here called
  218. *--             : "n_Flag", to report error conditions resulting in value
  219. *--             : returned being meaningless.
  220. *-------------------------------------------------------------------------------
  221.    PARAMETERS fX1, fX2, n_Flag
  222.  
  223. RETURN Zeroin( "Npv", fX1, fX2, float( 1 / 10 ^ 6 ), 100, ;
  224.          n_Flag, arrayrows( "aCashflow" ) )
  225. *-- EoF: Irr()
  226.  
  227. FUNCTION Irr2 && {version 1.01}
  228. *-------------------------------------------------------------------------------
  229. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  230. *-- Date........: 01/25/1993
  231. *-- Notes.......: Returns internal rate of return on an investment from
  232. *--               evenly-spaced periodic cashflows. The UDF simultaneously
  233. *--               accumulates the periodic Net Present Values of the
  234. *--               individual cashflows along with the first derivative of
  235. *--               the function. After the summation is completed for each
  236. *--               guess, the guess is adjusted by subtracting the ratio
  237. *--               of the function to its derivative.
  238. *-- Written for.: dBASEIV, version 1.5, tested on build xx71
  239. *-- Rev. History: 01/25/1993 -- Original
  240. *--               01/28/1993 - 1.01 -- to add missing private variables. To
  241. *--               count iterations without sign change in PV. Move
  242. *--               division by nRatio outside inner loop.
  243. *-- Calls.......: None
  244. *-- Called by...: Any
  245. *-- Usage.......: Irr2(<nN>, <cFlow>, <lSw>, <nGuess>)
  246. *-- Example.....: Rate = Irr2(6, "Cash", Switch, .01)
  247. *-- Returns.....: Internal Rate of Return.
  248. *-- Parameters..: nN     = number of cashflows in model
  249. *--               cFlow  = name of the array holding the cashflows
  250. *--               lSw    = name of a logical variable to be switched to
  251. *--                        indicate valid IRR returned (.t.).
  252. *--               nGuess = optional guess for initialing search.
  253. *-------------------------------------------------------------------------------
  254.    parameters nN, cFlow, lSw, nGuess
  255.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  256.    private nSignChng, nDiscount, nRatio, nSumPV, nCurrPV, nSumDeriv, nOldPV
  257.    private nIters, lSw1
  258.    store 0 to nI, nPosVal, nNegVal, nIters
  259.    store .t. to lSw
  260.    store .f. to lSw1
  261.    declare nCashFlow[nN]
  262.  
  263.     *--  Transfer cashflows to a private array and separate negatives from
  264.     *--  positives
  265.    do while nI < nN
  266.        nI = nI+1
  267.        store &cFlow[nI] to nCashFlow[nI], nCurVal
  268.        if nCurVal < 0
  269.            nNegVal = nNegVal + nCurVal
  270.        else
  271.            nPosVal = nPosVal + nCurVal
  272.        endif
  273.    enddo
  274.    if nNegVal = 0 .or. nPosVal = 0
  275.        wait "Must have at least one positive and one negative value"
  276.    endif
  277.  
  278.     *-- Use initializing guess if provided, otherwise calculate from
  279.     *-- weighted average returns.
  280.         
  281.    if pcount() = 4
  282.       nIRR = nGuess
  283.    else
  284.        nIRR = ((-nPosVal/nNegVal)-1)/nN
  285.    endif
  286.     
  287.     *-- Housekeeping summary accumulators, etc., before entering loop
  288.    store 1 to nNuDelta, nOlDelta
  289.    store 0 to nSignChng, nBigChange
  290.  
  291.     *--  Loop until estimated rate indicated accuracy
  292.    do while abs(nNuDelta) > .000001
  293.        store 0 to nI, nSumPV, nSumDeriv
  294.     
  295.         *-- Set up cumulative denominator to calculate incremental NPV
  296.        nDiscount = 1
  297.        nRatio = 1 + nIRR
  298.        do while nI < nN
  299.            nI = nI+1
  300.            nDiscount = nDiscount/nRatio
  301.         
  302.             *-- Calculate incremental PV and add to sum
  303.            nCurrPV = nDiscount * nCashFlow[nI]
  304.            nSumPV = nSumPV + nCurrPV
  305.         
  306.             *-- Add incremental first derivative to derivative sum
  307.            nSumDeriv = nSumDeriv - nI * nCurrPV
  308.        enddo
  309.     
  310.         *-- count iterations and test for sign change of future value
  311.        if .not. lSw1 .and. nIters > 0
  312.            lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
  313.        endif
  314.        nIters = nIters + 1
  315.        nOldPV = nSumPV
  316.  
  317.  
  318.         *-- Calculate indicated change in IRR
  319.        nNuDelta = nRatio * nSumPV/nSumDeriv
  320.     
  321.         *-- Test for big changes in adjusted IRR, limit to 10 times
  322.         *-- current guess for IRR and count big changes.
  323.        if abs(nNuDelta/nIRR) > 10
  324.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  325.            nBigChange = nBigChange + 1
  326.        endif
  327.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  328.     
  329.         *-- Count reversals in adjustments to limit hunting
  330.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  331.        nOlDelta = nNuDelta
  332.     
  333.         *-- Test for hunting, too many bigchanges or too large a solution
  334.         *-- and set external switch if abnormal exit is used.
  335.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  336.           (nIters > 9 .and. .not. lSw1)
  337.            store .f. to lSw
  338.            exit
  339.        endif
  340.    enddo
  341.  
  342. RETURN nIRR
  343. *-- EoF: Irr2()
  344.  
  345. FUNCTION Mirr  && {version 1.0}
  346. *-------------------------------------------------------------------------------
  347. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  348. *-- Date........: 01/27/1993
  349. *-- Notes.......: Used to calculate the Modified Internal Rate of Return
  350. *--               for evenly-spaced periodic cashflows. The modifications
  351. *--               assume that more realistic investment models should 
  352. *--               account for the cost of borrowing or the lower 'safe'
  353. *--               rate for keeping reserve funds to cover outlays and the
  354. *--               fact that reinvestments will be made at some other rate 
  355. *--               than the IRR itself. This model calculates the answer
  356. *--               directly, therefore more rapidly than the iterative
  357. *--               approach used by IRR. 
  358. *-- Written for.: dBASEIV,  version 1.5, tested on build xx71
  359. *-- Rev. History: 01/27/1993 -- Original Release
  360. *-- Calls.......: None
  361. *-- Called by...: Any
  362. *-- Usage.......: Mirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  363. *-- Example.....: Rate = Mirr(6, "Cash", .1, .14)
  364. *-- Returns.....: Modified Internal Rate of Return per period.
  365. *-- Parameters..: nN     = number of cashflows in model
  366. *--               cFlow  = name of the array holding the cashflows
  367. *--               nRrate = Reinvestment rate for positive cashflows. 
  368. *--               nFrate = 'Safe' rate expected on reserve funds to 
  369. *--                         cover disbursements.
  370. *-------------------------------------------------------------------------------
  371.    parameters nN, cFlow, nRrate, nFrate
  372.    private nI, nNegVal, nPosVal, nCurVal
  373.    store 0 to nI, nNegVal, nPosVal
  374.  
  375.     *-- Pass through array once computing present value of negative
  376.     *-- cashflows at 'safe' rate and present value of positive values
  377.     *-- at the reinvestment rate.
  378.    do while nI < nN
  379.        nI = nI+1
  380.        nCurVal = &cFlow[nI]
  381.        nCurVal = nCurVal*(1+iif(nCurVal<0,nFrate,nRrate))^-(nI-1)
  382.        if nCurVal < 0
  383.            nNegVal = nNegVal + nCurVal
  384.        else
  385.            nPosVal = nPosVal + nCurVal
  386.        endif
  387.    enddo
  388.    if abs(nNegVal) = 0 .or. nPosVal = 0
  389.        wait " There must be at least one negative and one positive value! "
  390.        return 0
  391.    endif
  392.  
  393.     *-- Calculate the rate of return required to yield a future value
  394.     *-- of the positive values reinvested at nRrate from the present
  395.     *-- value of the negative values invested at the 'safe' rate.
  396.  
  397. RETURN ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
  398. *-- EoF: Mirr()
  399.  
  400. FUNCTION Xmirr  && {version 1.01}
  401. *-------------------------------------------------------------------------------
  402. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  403. *-- Date........: 01/27/1993
  404. *-- Notes.......: Used to calculate the Modified Internal Rate of Return
  405. *--               from cashflows on random dates. Except for the need to 
  406. *--               supply both the dates of transactions and the cashflows
  407. *--               in an 'nN' by 2 array, the other inputs are the same as 
  408. *--               in Mirr(). Dates may be in random order except for the
  409. *--               first date. The first date in the array establishes 
  410. *--               the date to which present value applies. Enter 'Safe'
  411. *--               rate for reserves and 'Reinvestment' rate for positive 
  412. *--               cashflows as annual rates, e.g., .075 for 7.5%.
  413. *-- Written for.: dBASEIV, version 1.5, tested on build xx71
  414. *-- Rev. History: 01/27/1993 -- 1.01 - to allow entry of 'Safe' reserve rate
  415. *--                 and 'Reinvestment' rate as annual rates rather than 
  416. *--                 rates. Also, to return the 'effective' rate of interest
  417. *--                 when compounded daily, rather than the 'nominal' rate.   
  418. *-- Calls.......: None
  419. *-- Called by...: Any
  420. *-- Usage.......: Xmirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  421. *-- Example.....: Rate = Xmirr(5, "Cash", .14, .1)
  422. *-- Returns.....: Annualized Effective Modified Internal Rate of Return 
  423. *--               based on daily compounded interest.   
  424. *-- Parameters..: nN     = number of cashflows in model
  425. *--               cFlow  = name of 'nN' by 2 array holding the dates (col 1)
  426. *--                         and cashflow amounts (col 2). 
  427. *--               nRrate = Reinvestment rate for positive cashflows. 
  428. *--               nFrate = 'Safe' rate expected on reserve funds to 
  429. *--                         cover disbursements.
  430. *-------------------------------------------------------------------------------
  431.    parameters nN, cFlow, nRrate, nFrate
  432.    private nI, nCurVal, nNegVal, nPosVal, dPDate
  433.    private dMaxDate, dCurDate, nCurN, nMirr
  434.    store 0 to nI, nNegVal, nPosVal
  435.    store (1+nRrate)^(1/365)-1 to nRrate
  436.    store (1+nFrate)^(1/365)-1 to nFrate
  437.    store &cFlow[1,1] to dPDate
  438.    dMaxDate = dPDate
  439.  
  440.    do while nI < nN
  441.        nI = nI+1
  442.        nCurVal = &cFlow[nI,2]
  443.        dCurDate = &cFlow[nI,1]
  444.        dMaxDate = max(dCurDate,dMaxDate)
  445.        nCurN = dCurDate-dPDate
  446.        nCurVal = nCurVal/(1+iif(nCurVal<0,nFrate,nRrate))^nCurN
  447.        if nCurVal < 0
  448.            nNegVal = nNegVal + nCurVal
  449.        else
  450.            nPosVal = nPosVal + nCurVal
  451.        endif
  452.    enddo
  453.    if nNegVal = 0 .or. nPosVal = 0
  454.        wait " There must be at least one negative and one positive value! "
  455.        return 0
  456.    endif
  457.    nN = dMaxDate - dPDate
  458.    nMirr = ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
  459.  
  460. RETURN (1+nMirr)^365-1
  461. *-- EoF: Xmirr()
  462.  
  463. FUNCTION Xirr   && {version 1.01}
  464. *-------------------------------------------------------------------------------
  465. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  466. *-- Date........: 01/25/1993
  467. *-- Notes.......: Used to calculate the Internal Rate of Return from
  468. *--               cashflows on random dates. Except for the need to 
  469. *--               supply both the dates of transactions and the cashflows
  470. *--               in an 'nN' by 2 array, the other inputs are the same as 
  471. *--               in Irr(). Dates may be in random order except for the
  472. *--               first date. The first date in the array establishes 
  473. *--               the date to which present value applies.
  474. *-- Written for.: dBASEIV, version 1.5, tested on build xx71
  475. *-- Rev. History: 01/25/1993 -- Original
  476. *--               01/28/1993 - 1.01 -- to return 'effective' rate of interest
  477. *--               when compounded daily rather than the 'nominal' rate.
  478. *--               Also to count iterations without a sign change in PV. 
  479. *--               Move division by nRatio outside inner loop.
  480. *-- Calls.......: None
  481. *-- Called by...: Any
  482. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  483. *-- Example.....: Rate = Irr(5, "Cash", "Switch", .01)
  484. *-- Returns.....: Effective Internal Rate of Return.
  485. *-- Parameters..: nN     = number of cashflows in model
  486. *--               cFlow  = name of the 'nN' by 2 array holding the 
  487. *--                        dates (col 1) and cashflows (col 2). Dates
  488. *--                        may be entered in any order except for the 
  489. *--                        date, which is the date to which present
  490. *--                        value applies.
  491. *--               lSw    = name of a logical variable to be switched to
  492. *--                        indicate valid IRR returned (.t.).
  493. *--               nGuess = optional guess for initializing search.
  494. *-------------------------------------------------------------------------------
  495.    parameters nN, cFlow, lSw, nGuess
  496.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  497.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrPV, nSumDeriv
  498.    private nSumPV, dCurDate, nIters, lSw1
  499.    store 0 to nI, nPosVal, nNegVal, nIters
  500.    Store .t. to lSw
  501.    declare nCashFlow[nN,2]
  502.    store &cFlow[1,1] to dMaxDate, dPDate
  503.    store .f. to lSw1
  504.  
  505.     *-- Transfer cashflows to a private array and separate negatives from
  506.     *-- positives. Find last date. 
  507.    do while nI < nN
  508.        nI = nI+1
  509.        store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
  510.        store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
  511.        store max(dCurDate,dMaxDate) to dMaxDate
  512.        if nCurVal < 0
  513.            nNegVal = nNegVal + nCurVal
  514.        else
  515.            nPosVal = nPosVal + nCurVal
  516.        endif
  517.    enddo
  518.    if nNegVal = 0 .or. nPosVal = 0
  519.        wait "Must have at least one positive and one negative value"
  520.    endif
  521.  
  522.     *-- Use initializing guess if provided, otherwise calculate from
  523.     *-- weighted average returns.
  524.    if pcount() = 4
  525.       nIRR = nGuess
  526.    else
  527.         nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
  528.                (dMaxDate-dPDate)
  529.    endif
  530.  
  531.     *-- Housekeeping summary accumulators, etc., before entering loop
  532.    store 1 to nNuDelta, nOlDelta
  533.    store 0 to nSignChng, nBigChange
  534.  
  535.     *-- Loop until estimated rate indicated accuracy
  536.    do while abs(nNuDelta) > .000001
  537.        store 0 to nI, nSumPV, nSumDeriv
  538.        store 1 + nIrr to nRatio
  539.        do while nI < nN
  540.            nI = nI+1
  541.          
  542.             *-- Calculate incremental PV and add to sum
  543.            nCurrPV =  nCashFlow[nI,2] / nRatio^(nCashFlow[nI,1] - dPDate)
  544.            nSumPV = nSumPV + nCurrPV
  545.                 
  546.             *-- Add incremental first derivative to derivative sum
  547.            nSumDeriv = nSumDeriv - (nCashFlow[nI,1] - dPDate) * nCurrPV
  548.        enddo
  549.  
  550.         *-- count iterations and test for sign change of future value
  551.        if .not. lSw1 .and. nIters > 0
  552.            lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
  553.        endif
  554.        nIters = nIters + 1
  555.        nOldPV = nSumPV
  556.     
  557.         *-- Calculate indicated change in IRR
  558.        nNuDelta = nRatio * nSumPV/nSumDeriv
  559.     
  560.         *-- Test for big changes in adjusted IRR, limit to 10 times
  561.         *-- current guess for IRR and count big changes.
  562.        if abs(nNuDelta/nIRR) > 10
  563.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  564.            nBigChange = nBigChange + 1
  565.        endif
  566.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  567.     
  568.         *-- Count reversals in adjustments to limit hunting
  569.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  570.        nOlDelta = nNuDelta
  571.     
  572.         *-- Test for hunting, too many bigchanges or too large a solution
  573.         *-- and set external switch if abnormal exit is used.
  574.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  575.             (nIters > 9 .and. .not. lSw1)
  576.            store .f. to lSw
  577.            exit
  578.        endif
  579.    enddo
  580.  
  581. RETURN (1+nIrr)^365 -1
  582. *-- EoF: Xirr()
  583.  
  584. FUNCTION FVirr  && {version 1.01}
  585. *-------------------------------------------------------------------------------
  586. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  587. *-- Date........: 01/28/1993
  588. *-- Notes.......: Returns same roots as Irr(), but averages 20% faster. 
  589. *--               Irr() searches for the roots of NPV (Net Present Value),
  590. *--               while FVirr() searches for the same roots of NFV (Net
  591. *--               Future Value), both with respect to the rate of return.
  592. *--               The user may wish to use this UDF in place of Irr() and
  593. *--               use Irr() as an alternate to help locate more multiple
  594. *--               solutions. The reason this UDF is 'usually' faster is due
  595. *--               to the fact that the NFV curve is 'usually' steeper as
  596. *--               it crosses the zero axis.
  597. *-- Written for.: dBASEIV, version 1.5, tested on build xx71
  598. *-- Rev. History: 01/28/1993 -- Original
  599. *--               01/28/1993 -- 1.01 - Modified Irr() to use Net Future Value
  600. *--               curve instead of Net Present Value curve.
  601. *-- Calls.......: None
  602. *-- Called by...: Any
  603. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  604. *-- Example.....: Rate = Irr(6, "Cash", Switch, .01)
  605. *-- Returns.....: Internal Rate of Return.
  606. *-- Parameters..: nN     = number of cashflows in model
  607. *--               cFlow  = name of the array holding the cashflows
  608. *--               lSw    = name of a logical variable to be switched to
  609. *--                        indicate valid IRR returned (.t.).
  610. *--               nGuess = optional guess for initialing search.
  611. *-------------------------------------------------------------------------------
  612.  
  613.    parameters nN, cFlow, lSw, nGuess
  614.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  615.    private nSignChng, nDiscount, nRatio, nSumFV, nCurrFV, nSumDeriv, nOldFV
  616.    private nIters, lSw1
  617.    store 0 to nI, nPosVal, nNegVal, nIters
  618.    store .t. to lSw
  619.    store .f. to lSw1
  620.    declare nCashFlow[nN]
  621.  
  622.     *-- Transfer cashflows to a private array and separate negatives from
  623.     *-- positives
  624.    do while nI < nN
  625.        nI = nI+1
  626.        store &cFlow[nI] to nCashFlow[nI], nCurVal
  627.        if nCurVal < 0
  628.            nNegVal = nNegVal + nCurVal
  629.        else
  630.            nPosVal = nPosVal + nCurVal
  631.        endif
  632.    enddo
  633.    if nNegVal = 0 .or. nPosVal = 0
  634.        wait "Must have at least one positive and one negative value"
  635.    endif
  636.  
  637.     *-- Use initializing guess if provided, otherwise calculate from
  638.     *-- weighted average returns.
  639.    if pcount() = 4
  640.       nIRR = nGuess
  641.    else
  642.        nIRR = ((-nPosVal/nNegVal)-1)/nN
  643.    endif
  644.     
  645.     *-- Housekeeping summary accumulators, etc., before entering loop
  646.    store 1 to nNuDelta, nOlDelta
  647.    store 0 to nSignChng, nBigChange
  648.  
  649.     *-- Loop until estimated rate indicated accuracy
  650.    do while abs(nNuDelta) > .000001
  651.        store 0 to nI, nSumFV, nSumDeriv
  652.     
  653.         *-- Set up cumulative denominator to calculate incremental NFV   
  654.        nRatio = 1 + nIRR
  655.        nDiscount = nRatio^nN
  656.        do while nI < nN
  657.            nI = nI+1
  658.            nDiscount = nDiscount/nRatio
  659.                 
  660.             *-- Calculate incremental FV and add to sum
  661.            nCurrFV = nDiscount * nCashFlow[nI]
  662.            nSumFV = nSumFV + nCurrFV
  663.         
  664.             *-- Add incremental first derivative to derivative sum
  665.            nSumDeriv = nSumDeriv - nI * nCurrFV
  666.        enddo
  667.     
  668.         *-- count iterations and test for sign change of future value
  669.        if .not. lSw1 .and. nIters > 0
  670.            lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
  671.        endif
  672.        nIters = nIters + 1
  673.        nOldFV = nSumFV
  674.  
  675.         *-- Calculate indicated change in IRR
  676.        nNuDelta = nRatio * nSumFV/nSumDeriv
  677.     
  678.         *-- Test for big changes in adjusted IRR, limit to 10 times
  679.         *-- current guess for IRR and count big changes.
  680.        if abs(nNuDelta/nIRR) > 10
  681.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  682.            nBigChange = nBigChange + 1
  683.        endif
  684.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  685.     
  686.         *-- Count reversals in adjustments to limit hunting
  687.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  688.        nOlDelta = nNuDelta
  689.             
  690.         *-- Test for hunting, too many bigchanges or too large a solution
  691.         *-- and set external switch if abnormal exit is used.
  692.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  693.              (nIters > 9 .and. .not. lSw1)
  694.            store .f. to lSw
  695.            exit
  696.        endif
  697.    enddo
  698.  
  699. RETURN nIRR
  700. *-- EoF: FVirr()
  701.  
  702. FUNCTION FVxirr  && {version 1.01}
  703. *-------------------------------------------------------------------------------
  704. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  705. *-- Date........: 01/28/1993
  706. *-- Notes.......: Same as Xirr() except that the Net Future Value (NFV)
  707. *--               function is used instead of the Net Present Value (NPV)
  708. *--               function. The roots are the same, but this function is
  709. *--               usually faster for the same reasons that FVirr() is
  710. *--               faster than Irr(). As in Xirr(), all dates except the 
  711. *--               first date in the array may be in random order. The first 
  712. *--               date in the nN by 2 array along with the maximum date
  713. *--               establishes the range of the investment analysis. 
  714. *-- Written for.: dBASEIV, version 1.5, tested on build xx71
  715. *-- Rev. History: 01/28/1993
  716. *--               01/28/1993 -- 1.01 - Modified Xirr() to find roots of the
  717. *--                 Net Future Value curve.
  718. *-- Calls.......: None
  719. *-- Called by...: Any
  720. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  721. *-- Example.....: Rate = Irr(5, "Cash", Switch, .01)
  722. *-- Returns.....: Effective Internal Rate of Return.
  723. *-- Parameters..: nN     = number of cashflows in model
  724. *--               cFlow  = name of the 'nN' by 2 array holding the 
  725. *--                        dates (col 1) and cashflows (col 2). Dates
  726. *--                        may be entered in any order except for the 
  727. *--                        date, which is the date to which present
  728. *--                        value applies.
  729. *--               lSw    = name of a logical variable to be switched to
  730. *--                        indicate valid IRR returned (.t.).
  731. *--               nGuess = optional guess for initializing search.
  732. *-------------------------------------------------------------------------------
  733.    parameters nN, cFlow, lSw, nGuess
  734.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  735.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrFV, nSumDeriv
  736.    private nSumFV, dCurDate, lSw1, nIters
  737.    store 0 to nI, nPosVal, nNegVal, nIters
  738.    Store .t. to lSw
  739.    declare nCashFlow[nN,2]
  740.    store &cFlow[1,1] to dMaxDate, dPDate
  741.  
  742.     *-- Transfer cashflows to a private array and separate negatives from
  743.     *-- positives. Find last date. 
  744.     
  745.    do while nI < nN
  746.        nI = nI+1
  747.        store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
  748.        store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
  749.        store max(dCurDate,dMaxDate) to dMaxDate
  750.        if nCurVal < 0
  751.            nNegVal = nNegVal + nCurVal
  752.        else
  753.            nPosVal = nPosVal + nCurVal
  754.        endif
  755.    enddo
  756.    if nNegVal = 0 .or. nPosVal = 0
  757.        wait "Must have at least one positive and one negative value"
  758.    endif
  759.  
  760.     *-- Use initializing guess if provided, otherwise calculate from
  761.     *-- weighted average returns.
  762.    if pcount() = 4
  763.       nIRR = nGuess
  764.    else
  765.        nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
  766.                 (dMaxDate-dPDate)
  767.    endif
  768.  
  769.     *-- Housekeeping summary accumulators, etc., before entering loop
  770.    store 1 to nNuDelta, nOlDelta
  771.    store 0 to nSignChng, nBigChange
  772.    store .f. to lSw1
  773.  
  774.     *-- Loop until estimated rate indicated accuracy
  775.    do while abs(nNuDelta) > .000001
  776.        store 0 to nI, nSumFV, nSumDeriv
  777.        store 1 + nIrr to nRatio
  778.        do while nI < nN
  779.            nI = nI+1
  780.         
  781.             *-- Calculate incremental FV and add to sum
  782.            nCurrFV =  nCashFlow[nI,2] * nRatio^(dMaxDate - nCashFlow[nI,1])
  783.            nSumFV = nSumFV + nCurrFV
  784.                 
  785.             *-- Add incremental first derivative to derivative sum
  786.            nSumDeriv = nSumDeriv + (dMaxDate - nCashFlow[nI,1]) * nCurrFV
  787.        enddo
  788.     
  789.         *-- count iterations and test for sign change of future value
  790.        if .not. lSw1 .and. nIters > 0
  791.            lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
  792.        endif
  793.        nIters = nIters + 1
  794.        nOldFV = nSumFV
  795.  
  796.         *-- Calculate indicated change in IRR
  797.        nNuDelta = nRatio * nSumFV/nSumDeriv
  798.  
  799.         *-- Test for big changes in adjusted IRR, limit to 10 times
  800.         *-- current guess for IRR and count big changes.
  801.        if abs(nNuDelta/nIRR) > 10
  802.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  803.            nBigChange = nBigChange + 1
  804.        endif
  805.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  806.     
  807.         *-- Count reversals in adjustments to limit hunting
  808.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  809.        nOlDelta = nNuDelta
  810.  
  811.         *-- Test for hunting, too many bigchanges or too large a solution
  812.         *-- and set external switch if abnormal exit is used.
  813.         if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  814.               (nIters > 9 .and. .not. lSw1)
  815.            store .f. to lSw
  816.            exit
  817.        endif
  818.    enddo
  819.  
  820. RETURN (1+nIrr)^365 -1
  821. *-- EoF: FVxirr()
  822.  
  823. *-------------------------------------------------------------------------------
  824. *-- Note: The following functions are here as a courtesy, as they are used in at
  825. *-- least one of the functions above.
  826. *-------------------------------------------------------------------------------
  827.  
  828. FUNCTION Zeroin
  829. *-------------------------------------------------------------------------------
  830. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  831. *-- Date........: 04/13/1992
  832. *-- Notes.......: Finds a zero of a continuous function.
  833. *--             : In substance, what this function does is close in on a
  834. *--             : solution to a function that cannot otherwise be solved.
  835. *--             : Assuming Y = f(X), if Y1 and Y2, the values of the function
  836. *--             : for X1 and X2, have different signs, there must be at least
  837. *--             : one value of X between X1 and X2 for which Y = 0, if the
  838. *--             : function is continuous.  This function closes in on such a
  839. *--             : value of X by a trial-and-error process.
  840. *--             :
  841. *--             : This function is very slow, so a maximum number of iterations
  842. *--             : is passed as a parameter.  If the number of iterations is
  843. *--             : exceeded, the function will fail to find a root.  If this
  844. *--             : occurs, pick different original "X" values, increase the
  845. *--             : number of iterations or increase the errors allowed.  Once
  846. *--             : an approximate root is found, you can use values of X close
  847. *--             : on either side and reduce the error allowed to find an
  848. *--             : improved solution.  Also, of course, the signs of Y must be
  849. *--             : different for the starting X values for the function to
  850. *--             : proceed at all.
  851. *--             :
  852. *--             : NOTE ESPECIALLY - There is NO guarantee that a root returned
  853. *--             : by this function is the only one, or the most meaningful.
  854. *--             : It depends on the function that this function calls, but if
  855. *--             : that function has several roots, any of them may be returned.
  856. *--             : This can easily happen with such called functions as net
  857. *--             : present value where the cash flows alternate from positive
  858. *--             : to negative and back, and in many other "real life" cases.
  859. *--             : See the discussion of @IRR in the documentation of a good
  860. *--             : spreadsheet program such as Quattro Pro for further
  861. *--             : information.
  862. *--             :
  863. *--             : The method used by this function is a "secant and bisect"
  864. *--             : search.  The "secant" is the line connecting two X,Y
  865. *--             : points on a graph using standard Cartesian coordinates.
  866. *--             : Where the secant crosses the X axis is the best guess for
  867. *--             : the value of X that will have Y = 0, and will be correct
  868. *--             : if the function is linear between the two points.  The
  869. *--             : basic strategy is to calculate Y at that value of X, then
  870. *--             : keep the new X and that one of the old X values that had
  871. *--             : a Y-value of opposite sign, and reiterate to close in.
  872. *--             :
  873. *--             : If the function is a simple curve with most of the change
  874. *--             : in Y close to one of the X-values, as often occurs if the
  875. *--             : initial values of X are poorly chosen, repeated secants
  876. *--             : will do little to find a Y-value close to zero and will
  877. *--             : reduce the difference in X-values only slightly.  In this
  878. *--             : case the function shifts to choosing the new X halfway
  879. *--             : between the old ones, bisecting the difference and always
  880. *--             : reducing the bracket by half, for a while.
  881. *--             :
  882. *--             : While this function finds a "zero", it may be used to
  883. *--             : find an X corresponding to any other value of Y.  Suppose
  884. *--             : the function of X is FUNCTION Blackbox( X ) and it is
  885. *--             : desired to find a value of X for which f(X) = 7.  The trick
  886. *--             : is to interpose a function between Zeroin() and Blackbox()
  887. *--             : that will return a 0 to Zeroin() whenever Blackbox() returns
  888. *--             : 7.  By calling that function, Zeroin() finds a value of
  889. *--             : X for which Blackbox( X ) = 7, as required:
  890. *--             :    Result = Zeroin( "Temp", <other parameters omitted> )
  891. *--             :
  892. *--             :    FUNCTION Temp
  893. *--             :    parameters nQ
  894. *--             :    RETURN Blackbox( nQ ) - 7
  895. *--             :
  896. *-- Written for.: dBASE IV Version 1.5
  897. *-- Rev. History: Original function 1990.
  898. *--             : Modified to take optional parameters, 4/13/1992
  899. *-- Calls       : The function whose name is first parameter.
  900. *-- Called by...: Any
  901. *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ;
  902. *--             :  <nMaxiter>, <n_Flag> ;
  903. *--             :  [, xPass1 [, xPass2 [, xPass3 ] ] ] )
  904. *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
  905. *-- Returns     : a float value representing a root, if n_Flag < 3.
  906. *-- Parameters..: cFunction, the name of the function to solve for a root.
  907. *--               fX1, one of the X-values between which the root is sought.
  908. *--               fX2, the second of these values.
  909. *--               Note: These MUST be chosen so the f( X ) values for the two
  910. *--               of them have opposite signs (they must bracket the result).
  911. *--               fAbserror, the absolute error allowed in the result.
  912. *--               nMaxiter, the maximum number of times to iterate.
  913. *--               n_Flag, an integer to signal success ( < 3 ) or failure.
  914. *--               xPass1 . . . 3, arguments to be passed through to cFunction.
  915. *--               The parameter "n_Flag" should be passed as a variable so it
  916. *--               may be accessed on return.  The limit of 9 literal parameters
  917. *--               may require passing others as variables.  The "xPass"
  918. *--               parameters are optional and the fact there are three of them
  919. *--               is arbitrary; they exist to hold whatever parameters may be
  920. *--               needed by the function cFunction being called aside from
  921. *--               the value of X for which it is being evaluated.  Add more
  922. *--               and change the 3 "&cFunc." lines below if you need more.
  923. *-- Side effects: Uses and alters a global numeric variable, here called
  924. *--               "n_Flag", to report error conditions resulting in value
  925. *--               returned being meaningless.  Possible n_Flag values are:
  926. *--                     1       success - root found within error allowed
  927. *--                     2       success - root was found exactly
  928. *--                     3       error   - function value not converging
  929. *--                     4       error   - original values do not bracket a root
  930. *--                     5       error   - maximum iterations exceeded
  931. *-------------------------------------------------------------------------------
  932.    parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
  933.               n_Flag, xPass1, xPass2, xPass3
  934.    private nSplits, fBracket, fFary, fNeary, nIters
  935.    private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
  936.  
  937.    store 0 to nSplits, nIters
  938.    fBracket = abs ( fNearx - fFarx )
  939.    fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 )
  940.    fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  941.  
  942.    if sign( fNeary ) = sign( fFary )
  943.       n_Flag = 4
  944.       return float(0)
  945.    endif
  946.  
  947.    fMaxabs = max( abs( fNeary ), abs( fFary ) )
  948.    n_Flag = 0
  949.  
  950.    * Main iteration loop
  951.  
  952.    do while .t.
  953.  
  954.       if abs( fFary ) < abs( fNeary )
  955.  
  956.          * Interchange fNearx and fFarx so that
  957.          * fNearx is closer to a solution--
  958.          * abs( fNeary ) <= abs( fFary )
  959.  
  960.          fOldx  = fNearx
  961.          fOldy  = fNeary
  962.          fNearx = fFarx
  963.          fNeary = fFary
  964.          fFarx  = fOldx
  965.          fFary  = fOldy
  966.       endif
  967.  
  968.       fDiffx = fFarx - fNearx
  969.       fAbsdiff = abs( fDiffx )
  970.  
  971.       * Test whether interval is too small to continue
  972.  
  973.       if fAbsdiff <= 2 * fAbserr
  974.          if abs( fNeary ) > fMaxabs
  975.  
  976.             * Yes, but we are out of bounds
  977.  
  978.             n_Flag = 3
  979.             fNearx = float(0)
  980.          else
  981.  
  982.             * Yes, and we have a solution!
  983.  
  984.             n_Flag = 1
  985.          endif
  986.          exit
  987.       endif
  988.  
  989.       * Save the last approximation to x and y
  990.  
  991.       fOldx = fNearx
  992.       fOldy = fNeary
  993.  
  994.       * Check if reduction in the size of
  995.       * bracketing interval is satisfactory.
  996.       * If not, bisect until it is.
  997.  
  998.       nSplits = nSplits + 1
  999.       if nSplits >= 4
  1000.          if 4 * fAbsdiff >= fBracket
  1001.             fNearx = fNearx + fDiffx / 2
  1002.          else
  1003.             nSplits = 0
  1004.             fBracket = fAbsdiff / 2
  1005.  
  1006.             * Calculate secant
  1007.  
  1008.             fSecant = ( fNearx - fFarx ) * fNeary ;
  1009.                                / ( fFary - fNeary )
  1010.  
  1011.             * But not less than error allowed
  1012.  
  1013.             if abs( fSecant ) < fAbserr
  1014.                fNearx = fnearx + fAbserr * sign( fDiffx )
  1015.             else
  1016.                fNearx = fNearx + fSecant
  1017.             endif
  1018.          endif
  1019.       endif
  1020.  
  1021.       * Evaluate the function at the new approximation
  1022.  
  1023.       fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  1024.  
  1025.       * If it's exactly zero, we win!  Run with it
  1026.  
  1027.       if fNeary = 0.00
  1028.          n_Flag = 2
  1029.          exit
  1030.       endif
  1031.  
  1032.       * Else adjust iteration count and quit if too
  1033.       * many iterations with no solution
  1034.  
  1035.       nIters = nIters + 1
  1036.       if nIters > nMaxiter
  1037.          n_Flag = 5
  1038.          fNearx = float( 0 )
  1039.          exit
  1040.       endif
  1041.  
  1042.       * And finally keep as the new fFarx that one
  1043.       * of the previous approximations, fFarx and
  1044.       * fOldx, at which the function has a sign opposite
  1045.       * to that at the new approximation, fNearx.
  1046.  
  1047.       if sign( fNeary ) = sign( fFary )
  1048.          fFarx = fOldx
  1049.          fFary = fOldy
  1050.       endif
  1051.    enddo
  1052.  
  1053. RETURN fNearx
  1054. *-- EoF: Zeroin()
  1055.  
  1056. FUNCTION ArrayRows
  1057. *-------------------------------------------------------------------------------
  1058. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1059. *-- Date........: 03/01/1992
  1060. *-- Notes.......: Number of Rows in an array
  1061. *-- Written for.: dBASE IV, 1.1
  1062. *-- Rev. History: 03/01/1992 -- Original Release
  1063. *-- Calls.......: None
  1064. *-- Called by...: Any
  1065. *-- Usage.......: ArrayRows("<aArray>")
  1066. *-- Example.....: n = ArrayRows("aTest")
  1067. *-- Returns.....: numeric
  1068. *-- Parameters..: aArray      = Name of array 
  1069. *-------------------------------------------------------------------------------
  1070.  
  1071.     parameters aArray
  1072.     private nHi, nLo, nTrial, nDims
  1073.     nLo = 1
  1074.     nHi = 1170
  1075.     if type( "&aArray[ 1, 1 ]" ) = "U"
  1076.       nDims = 1
  1077.     else
  1078.      nDims = 2
  1079.     endif
  1080.     do while .T.
  1081.      nTrial = int( ( nHi + nLo ) / 2 )
  1082.       if nHi < nLo
  1083.         exit
  1084.       endif
  1085.      if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
  1086.        nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
  1087.         nHi = nTrial - 1
  1088.       else
  1089.         nLo = nTrial + 1
  1090.       endif
  1091.     enddo
  1092.     
  1093. RETURN nTrial
  1094. *-- EoF: ArrayRows()
  1095.  
  1096. *-------------------------------------------------------------------------------
  1097. *-- EoP: FINANCE.PRG
  1098. *-------------------------------------------------------------------------------
  1099.