home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / duflp / finance.prg < prev    next >
Text File  |  1992-07-01  |  22KB  |  504 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FINANCE.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  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
  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 (JPARSONS)
  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: None
  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 (JPARSONS)
  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: None
  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 (JPARSONS)
  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: None
  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 (JPARSONS)
  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: None
  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 (TONYLIMA) and Jay Parsons (JPARSONS)
  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: None
  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 (Jparsons)
  186. *--             : Based on code by Tony Lima (Tonylima), 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. *-------------------------------------------------------------------------------
  228. *-- Note: The following functions are here as a courtesy, as they are used in at
  229. *-- least one of the functions above.
  230. *-------------------------------------------------------------------------------
  231.  
  232. FUNCTION Zeroin
  233. *-------------------------------------------------------------------------------
  234. *-- Programmer..: Tony Lima (Tonylima) and Jay Parsons (Jparsons)
  235. *-- Date........: 4/13/1992
  236. *-- Notes.......: Finds a zero of a continuous function.
  237. *--             : In substance, what this function does is close in on a
  238. *--             : solution to a function that cannot otherwise be solved.
  239. *--             : Assuming Y = f(X), if Y1 and Y2, the values of the function
  240. *--             : for X1 and X2, have different signs, there must be at least
  241. *--             : one value of X between X1 and X2 for which Y = 0, if the
  242. *--             : function is continuous.  This function closes in on such a
  243. *--             : value of X by a trial-and-error process.
  244. *--             :
  245. *--             : This function is very slow, so a maximum number of iterations
  246. *--             : is passed as a parameter.  If the number of iterations is
  247. *--             : exceeded, the function will fail to find a root.  If this
  248. *--             : occurs, pick different original "X" values, increase the
  249. *--             : number of iterations or increase the errors allowed.  Once
  250. *--             : an approximate root is found, you can use values of X close
  251. *--             : on either side and reduce the error allowed to find an
  252. *--             : improved solution.  Also, of course, the signs of Y must be
  253. *--             : different for the starting X values for the function to
  254. *--             : proceed at all.
  255. *--             :
  256. *--             : NOTE ESPECIALLY - There is NO guarantee that a root returned
  257. *--             : by this function is the only one, or the most meaningful.
  258. *--             : It depends on the function that this function calls, but if
  259. *--             : that function has several roots, any of them may be returned.
  260. *--             : This can easily happen with such called functions as net
  261. *--             : present value where the cash flows alternate from positive
  262. *--             : to negative and back, and in many other "real life" cases.
  263. *--             : See the discussion of @IRR in the documentation of a good
  264. *--             : spreadsheet program such as Quattro Pro for further
  265. *--             : information.
  266. *--             :
  267. *--             : The method used by this function is a "secant and bisect"
  268. *--             : search.  The "secant" is the line connecting two X,Y
  269. *--             : points on a graph using standard Cartesian coordinates.
  270. *--             : Where the secant crosses the X axis is the best guess for
  271. *--             : the value of X that will have Y = 0, and will be correct
  272. *--             : if the function is linear between the two points.  The
  273. *--             : basic strategy is to calculate Y at that value of X, then
  274. *--             : keep the new X and that one of the old X values that had
  275. *--             : a Y-value of opposite sign, and reiterate to close in.
  276. *--             :
  277. *--             : If the function is a simple curve with most of the change
  278. *--             : in Y close to one of the X-values, as often occurs if the
  279. *--             : initial values of X are poorly chosen, repeated secants
  280. *--             : will do little to find a Y-value close to zero and will
  281. *--             : reduce the difference in X-values only slightly.  In this
  282. *--             : case the function shifts to choosing the new X halfway
  283. *--             : between the old ones, bisecting the difference and always
  284. *--             : reducing the bracket by half, for a while.
  285. *--             :
  286. *--             : While this function finds a "zero", it may be used to
  287. *--             : find an X corresponding to any other value of Y.  Suppose
  288. *--             : the function of X is FUNCTION Blackbox( X ) and it is
  289. *--             : desired to find a value of X for which f(X) = 7.  The trick
  290. *--             : is to interpose a function between Zeroin() and Blackbox()
  291. *--             : that will return a 0 to Zeroin() whenever Blackbox() returns
  292. *--             : 7.  By calling that function, Zeroin() finds a value of
  293. *--             : X for which Blackbox( X ) = 7, as required:
  294. *--             :    Result = Zeroin( "Temp", <other parameters omitted> )
  295. *--             :
  296. *--             :    FUNCTION Temp
  297. *--             :    parameters nQ
  298. *--             :    RETURN Blackbox( nQ ) - 7
  299. *--             :
  300. *-- Written for.: dBASE IV Version 1.5
  301. *-- Rev. History: Original function 1990.
  302. *--             : Modified to take optional parameters, 4/13/1992
  303. *-- Calls       : The function whose name is first parameter.
  304. *--             : NPV()             Function in FINANCE.PRG
  305. *-- Called by...: Any
  306. *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ;
  307. *--             :  <nMaxiter>, <n_Flag> ;
  308. *--             :  [, xPass1 [, xPass2 [, xPass3 ] ] ] )
  309. *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
  310. *-- Returns     : a float value representing a root, if n_Flag < 3.
  311. *-- Parameters..: cFunction, the name of the function to solve for a root.
  312. *--               fX1, one of the X-values between which the root is sought.
  313. *--               fX2, the second of these values.
  314. *--               Note: These MUST be chosen so the f( X ) values for the two
  315. *--               of them have opposite signs (they must bracket the result).
  316. *--               fAbserror, the absolute error allowed in the result.
  317. *--               nMaxiter, the maximum number of times to iterate.
  318. *--               n_Flag, an integer to signal success ( < 3 ) or failure.
  319. *--               xPass1 . . . 3, arguments to be passed through to cFunction.
  320. *--               The parameter "n_Flag" should be passed as a variable so it
  321. *--               may be accessed on return.  The limit of 9 literal parameters
  322. *--               may require passing others as variables.  The "xPass"
  323. *--               parameters are optional and the fact there are three of them
  324. *--               is arbitrary; they exist to hold whatever parameters may be
  325. *--               needed by the function cFunction being called aside from
  326. *--               the value of X for which it is being evaluated.  Add more
  327. *--               and change the 3 "&cFunc." lines below if you need more.
  328. *-- Side effects: Uses and alters a global numeric variable, here called
  329. *--               "n_Flag", to report error conditions resulting in value
  330. *--               returned being meaningless.  Possible n_Flag values are:
  331. *--                     1       success - root found within error allowed
  332. *--                     2       success - root was found exactly
  333. *--                     3       error   - function value not converging
  334. *--                     4       error   - original values do not bracket a root
  335. *--                     5       error   - maximum iterations exceeded
  336. *-------------------------------------------------------------------------------
  337.    parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
  338.               n_Flag, xPass1, xPass2, xPass3
  339.    private nSplits, fBracket, fFary, fNeary, nIters
  340.    private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
  341.  
  342.    store 0 to nSplits, nIters
  343.    fBracket = abs ( fNearx - fFarx )
  344.    fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 )
  345.    fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  346.  
  347.    if sign( fNeary ) = sign( fFary )
  348.       n_Flag = 4
  349.       return float(0)
  350.    endif
  351.  
  352.    fMaxabs = max( abs( fNeary ), abs( fFary ) )
  353.    n_Flag = 0
  354.  
  355.    * Main iteration loop
  356.  
  357.    do while .t.
  358.  
  359.       if abs( fFary ) < abs( fNeary )
  360.  
  361.          * Interchange fNearx and fFarx so that
  362.          * fNearx is closer to a solution--
  363.          * abs( fNeary ) <= abs( fFary )
  364.  
  365.          fOldx  = fNearx
  366.          fOldy  = fNeary
  367.          fNearx = fFarx
  368.          fNeary = fFary
  369.          fFarx  = fOldx
  370.          fFary  = fOldy
  371.       endif
  372.  
  373.       fDiffx = fFarx - fNearx
  374.       fAbsdiff = abs( fDiffx )
  375.  
  376.       * Test whether interval is too small to continue
  377.  
  378.       if fAbsdiff <= 2 * fAbserr
  379.          if abs( fNeary ) > fMaxabs
  380.  
  381.             * Yes, but we are out of bounds
  382.  
  383.             n_Flag = 3
  384.             fNearx = float(0)
  385.          else
  386.  
  387.             * Yes, and we have a solution!
  388.  
  389.             n_Flag = 1
  390.          endif
  391.          exit
  392.       endif
  393.  
  394.       * Save the last approximation to x and y
  395.  
  396.       fOldx = fNearx
  397.       fOldy = fNeary
  398.  
  399.       * Check if reduction in the size of
  400.       * bracketing interval is satisfactory.
  401.       * If not, bisect until it is.
  402.  
  403.       nSplits = nSplits + 1
  404.       if nSplits >= 4
  405.          if 4 * fAbsdiff >= fBracket
  406.             fNearx = fNearx + fDiffx / 2
  407.          else
  408.             nSplits = 0
  409.             fBracket = fAbsdiff / 2
  410.  
  411.             * Calculate secant
  412.  
  413.             fSecant = ( fNearx - fFarx ) * fNeary ;
  414.                                / ( fFary - fNeary )
  415.  
  416.             * But not less than error allowed
  417.  
  418.             if abs( fSecant ) < fAbserr
  419.                fNearx = fnearx + fAbserr * sign( fDiffx )
  420.             else
  421.                fNearx = fNearx + fSecant
  422.             endif
  423.          endif
  424.       endif
  425.  
  426.       * Evaluate the function at the new approximation
  427.  
  428.       fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  429.  
  430.       * If it's exactly zero, we win!  Run with it
  431.  
  432.       if fNeary = 0.00
  433.          n_Flag = 2
  434.          exit
  435.       endif
  436.  
  437.       * Else adjust iteration count and quit if too
  438.       * many iterations with no solution
  439.  
  440.       nIters = nIters + 1
  441.       if nIters > nMaxiter
  442.          n_Flag = 5
  443.          fNearx = float( 0 )
  444.          exit
  445.       endif
  446.  
  447.       * And finally keep as the new fFarx that one
  448.       * of the previous approximations, fFarx and
  449.       * fOldx, at which the function has a sign opposite
  450.       * to that at the new approximation, fNearx.
  451.  
  452.       if sign( fNeary ) = sign( fFary )
  453.          fFarx = fOldx
  454.          fFary = fOldy
  455.       endif
  456.    enddo
  457.  
  458. RETURN fNearx
  459. *-- EoF: Zeroin()
  460.  
  461. FUNCTION ArrayRows
  462. *-------------------------------------------------------------------------------
  463. *-- Programmer..: Jay Parsons (JPARSONS)
  464. *-- Date........: 03/01/1992
  465. *-- Notes.......: Number of Rows in an array
  466. *-- Written for.: dBASE IV, 1.1
  467. *-- Rev. History: None
  468. *-- Calls.......: None
  469. *-- Called by...: Any
  470. *-- Usage.......: ArrayRows("<aArray>")
  471. *-- Example.....: n = ArrayRows("aTest")
  472. *-- Returns.....: numeric
  473. *-- Parameters..: aArray      = Name of array 
  474. *-------------------------------------------------------------------------------
  475.  
  476.     parameters aArray
  477.     private nHi, nLo, nTrial, nDims
  478.     nLo = 1
  479.     nHi = 1170
  480.     if type( "&aArray[ 1, 1 ]" ) = "U"
  481.       nDims = 1
  482.     else
  483.      nDims = 2
  484.     endif
  485.     do while .T.
  486.      nTrial = int( ( nHi + nLo ) / 2 )
  487.       if nHi < nLo
  488.         exit
  489.       endif
  490.      if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
  491.        nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
  492.         nHi = nTrial - 1
  493.       else
  494.         nLo = nTrial + 1
  495.       endif
  496.     enddo
  497.     
  498. RETURN nTrial
  499. *-- EoF: ArrayRows()
  500.  
  501. *-------------------------------------------------------------------------------
  502. *-- EoP: FINANCE.PRG
  503. *-------------------------------------------------------------------------------
  504.