home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BCDFIN.ZIP / BCDFIN.INC
Encoding:
Text File  |  1985-07-04  |  3.4 KB  |  86 lines
  1.    (* BCDFIN.INC -- transcendental functions needed for financial *)
  2.    (*               calculations in TURBOBCD                      *)
  3.    (*                                                             *)
  4.    (*   ln1:    real; -- returns ln of 1+argument                 *)
  5.    (*   eton:   real; -- returns e raised to its argument         *)
  6.    (*   sqroot: real --  returns square root of its argument      *)
  7.    (*                                                             *)
  8.    (*   ln1 and eton are from Abramowitz and Stegun, Handbook of  *)
  9.    (*   Mathematical Functions, Dover, 1965                       *)
  10.    (*   sqroot uses binary search                                 *)
  11.    (*                                                             *)
  12.    (*    Blaise away,                                             *)
  13.    (*                        Bob Wooster, CIS 72415,1602          *)
  14.    (*                        June 1985                            *)
  15.  
  16.    FUNCTION ln1(x : Real) : Real;
  17.          { calculate ln(1+x) for 0<=x<=1 }
  18.       VAR temp : Real;
  19.       BEGIN {  ln1 }
  20.          IF (x < 0) OR (x > 1) THEN ln1 := 0.0 ELSE BEGIN
  21.             ln1 :=
  22.             +0.9999964239*x
  23.             -0.4998741238*x*x
  24.             +0.3317990258*x*x*x
  25.             -0.2407338084*x*x*x*x
  26.             +0.1676540711*x*x*x*x*x
  27.             -0.0953293897*x*x*x*x*x*x
  28.             +0.0360884937*x*x*x*x*x*x*x
  29.             -0.0064565442*x*x*x*x*x*x*x*x;
  30.          END; {else}
  31.       END; { ln1 }
  32.  
  33.    FUNCTION factorial(r : Real) : Real;
  34.       BEGIN { function factorial(r: real) }
  35.          IF r <= 1.0 THEN factorial := 1.0
  36.          ELSE factorial := r*factorial(r-1.0);
  37.       END; { function factorial(r: real) }
  38.  
  39.    FUNCTION ipower(r : Real; n : Integer) : Real;
  40.       function ipower1(r: real; n:integer): real; {this one's recursive}
  41.       begin   { ipower1 }
  42.          if n = 1 then ipower1 := r
  43.          else ipower1 := r*ipower1(r, n-1);
  44.       end;    { ipower1 }
  45.  
  46.    var negative: boolean; temp : real;
  47.       BEGIN { function ipower(r: real; n: integer): real }
  48.          negative := n < 0;
  49.          if negative then n := n*(1);
  50.          if n = 0 then temp := 1
  51.          else IF n = 1 THEN temp := r
  52.          ELSE temp := r*ipower1(r, n-1);
  53.          if negative then temp := 1.0/temp;
  54.          ipower := temp;
  55.       END; { function ipower(r: real; n: integer): real }
  56.  
  57.    FUNCTION nexp(r : Real) : Real;
  58.          { calculate e^r }
  59.       VAR i : Integer; t : Real;
  60.       BEGIN { function nexp(r: real) }
  61.          t := 1.0;
  62.          FOR i := 1 TO 20 DO t := t+(ipower(r, i)/factorial(i));
  63.          nexp := t;
  64.       END; { function nexp(r: real) }
  65.  
  66.    FUNCTION sqroot(x : Real) : Real;
  67.          { find square root by binary search }
  68.       VAR guess, high, low, oldguess, err : Real;
  69.       BEGIN { sqroot }
  70.          guess := x/2.0; low := 0.01*x; high := x;
  71.          REPEAT
  72.             oldguess := guess;
  73.             IF guess*guess < x THEN BEGIN
  74.                low := guess; guess := (high+guess)/2;
  75.             END {if}
  76.             ELSE BEGIN
  77.                high := guess; guess := (low+guess)/2;
  78.             END; {else}
  79.             err := abs(guess-oldguess);
  80.          UNTIL err < 0.00000001;
  81.          sqroot := guess;
  82.       END; { sqroot }
  83.  
  84. (* end of file BCDFIN.PAS *)
  85.  
  86.