home *** CD-ROM | disk | FTP | other *** search
/ Merciful 3 / Merciful_Release_3.bin / software / e / excalcv1.2reg.lha / ExCalcV1.2 / Source / ExMathLib0.mod < prev    next >
Text File  |  1995-10-07  |  8KB  |  352 lines
  1. MODULE ExMathLib0;
  2.  
  3. IMPORT LR := LongRealConversions, LM := MathIEEEDoubTrans,
  4.        X := ExNumbers;
  5.  
  6. VAR
  7.   ToRadians : X.ExNumType;
  8.   ToDegrees : X.ExNumType;
  9.   Fact500   : X.ExNumType;
  10.   Fact1000  : X.ExNumType;
  11.   Fact2000  : X.ExNumType;
  12.   Fact3000  : X.ExNumType;
  13.  
  14.  
  15. PROCEDURE ExNumToLongReal*(x : X.ExNumType) : LONGREAL;
  16. VAR
  17.   Num : LONGREAL;
  18.   Str : ARRAY 81 OF CHAR;
  19. BEGIN
  20.   (* Convert ExNum into LONGREAL via a string *)
  21.   X.ExNumToStr(x, 0, 0, Str);
  22.   IF LR.StringToReal(Str, Num) THEN
  23.     RETURN Num;
  24.   ELSE
  25.     RETURN 0.0D;
  26.   END;
  27. END ExNumToLongReal;
  28.  
  29.  
  30. PROCEDURE LongRealToExNum*(x : LONGREAL; VAR Result : X.ExNumType);
  31. VAR
  32.   Str : ARRAY 81 OF CHAR;
  33. BEGIN
  34.   (* Convert LONGREAL into an ExNum via a string *)
  35.   IF LR.RealToString(x, Str, 1, 52, TRUE) THEN
  36.     X.StrToExNum(Str, Result);
  37.   ELSE
  38.     Result := X.Ex0;
  39.   END;
  40. END LongRealToExNum;
  41.  
  42.  
  43. PROCEDURE xtoi*(VAR Result : X.ExNumType; x : X.ExNumType; i : LONGINT);
  44. (* From Knuth, slightly altered : p442, The Art Of Computer Programming, Vol 2 *)
  45. VAR
  46.   Y : X.ExNumType;
  47.   negative : BOOLEAN;
  48. BEGIN
  49.   Y := X.Ex1;
  50.   negative := i < 0;
  51.   i := ABS(i);
  52.   LOOP
  53.     IF ODD(i) THEN X.ExMult(Y, Y, x) END;
  54.     i := i DIV 2;
  55.     IF i = 0 THEN EXIT END;
  56.     X.ExMult(x, x, x);
  57.   END;
  58.   IF negative THEN
  59.     X.ExDiv(Result, X.Ex1, Y);
  60.   ELSE
  61.     Result := Y;
  62.   END;
  63. END xtoi;
  64.  
  65.  
  66. PROCEDURE Root *(VAR Result : X.ExNumType;
  67.                     x      : X.ExNumType;
  68.                     i      : LONGINT);
  69. (* Use iterative solution of a general root equation *)
  70. VAR
  71.   y, yp, f, g, t : X.ExNumType;
  72.   iteration : INTEGER;
  73.   root : LONGREAL;
  74.   negate : BOOLEAN;
  75. BEGIN
  76.   IF ((x.Sign = X.negative) & ~ODD(i)) OR (i < 2) THEN
  77.     X.ExStatus := X.IllegalNumber;
  78.     Result := X.Ex0;
  79.   ELSIF X.IsZero(x) THEN
  80.     Result := x;
  81.   ELSE
  82.     (* handle negative roots *)
  83.     IF x.Sign = X.negative THEN X.ExAbs(x); negate := TRUE
  84.     ELSE negate := FALSE
  85.     END;
  86.  
  87.     (* estimate of the ith root *)
  88.     root := 1.0D / i;
  89.     LongRealToExNum(LM.Pow(root,ExNumToLongReal(x)), yp);
  90.     X.ExNumb(i, 0, 0, f);    (* i *)
  91.     X.ExNumb(i-1, 0, 0, g);  (* i - 1 *)
  92.  
  93.     (* calculate the root *)
  94.     iteration := 4;
  95.     LOOP
  96.       (* y := 1/i * (yp * (i-1) + x / yp^(i-1)) *)
  97.       xtoi(t, yp, i-1);       (* yp**(i-1) *)
  98.       X.ExMult(y, t, yp);     (* yp**i *)
  99.       X.ExMult(y, y, g);      (* yp**i * (i-1) *)
  100.       X.ExAdd(y, y, x);       (* yp**i * (i-1) + x *)
  101.       X.ExMult(t, t, f);      (* yp**(i-1) * i *)
  102.       X.ExDiv(y, y, t);
  103.       IF (X.ExCompare(y, yp) = X.ExEqual) OR (iteration = 0) THEN EXIT END;
  104.       DEC(iteration);
  105.       yp := y;
  106.     END;
  107.  
  108.     (* adjust the number's sign *)
  109.     Result := y;
  110.     IF negate THEN X.ExChgSign(Result) END;
  111.   END;
  112. END Root;
  113.  
  114.  
  115. PROCEDURE powerof10(VAR Result : X.ExNumType; x : LONGINT);
  116. BEGIN
  117.   X.ExNumb(1, 0, SHORT(x), Result);
  118. END powerof10;
  119.  
  120.  
  121. PROCEDURE RadToDegX*(VAR radianAngle : X.ExNumType);
  122. (* Convert a radian measure into degrees *)
  123. BEGIN
  124.   X.ExMult(radianAngle, ToDegrees, radianAngle);
  125. END RadToDegX;
  126.  
  127.  
  128. PROCEDURE DegToRadX*(VAR radianAngle : X.ExNumType);
  129. (* Convert a degree measure into radians *)
  130. BEGIN
  131.   X.ExMult(radianAngle, ToRadians, radianAngle);
  132. END DegToRadX;
  133.  
  134.  
  135. PROCEDURE sqrtX*(VAR Result : X.ExNumType; x : X.ExNumType);
  136. BEGIN
  137.   Root(Result, x, 2);
  138. END sqrtX;
  139.  
  140.  
  141. PROCEDURE lnX*(VAR Result : X.ExNumType; x : X.ExNumType);
  142. BEGIN
  143.   LongRealToExNum(LM.Log(ExNumToLongReal(x)), Result);
  144. END lnX;
  145.  
  146.  
  147. PROCEDURE logX*(VAR Result : X.ExNumType; x : X.ExNumType);
  148. BEGIN
  149.   LongRealToExNum(LM.Log10(ExNumToLongReal(x)), Result);
  150. END logX;
  151.  
  152.  
  153. PROCEDURE factorial(VAR prevn, currentn : LONGINT;
  154.                     VAR PrevFact, Result : X.ExNumType);
  155. (* Implements an incremental factorial using a previously calculated value. *)
  156. VAR
  157.   i : LONGINT;
  158. BEGIN
  159.   FOR i := prevn+1 TO currentn DO
  160.     (* PrevFact := PrevFact * i; *)
  161.     X.ExNumb(i, 0, 0, Result);
  162.     X.ExMult(PrevFact, PrevFact, Result);
  163.   END;
  164.   prevn := currentn;
  165.   Result := PrevFact;
  166. END factorial;
  167.  
  168.  
  169. PROCEDURE factorialX*(VAR Result : X.ExNumType; n : LONGINT);
  170. CONST
  171.   MaxFactorial = 3249;
  172. VAR
  173.   fact : LONGINT;
  174.   prev : X.ExNumType;
  175. BEGIN
  176.   IF (n < 0) OR (n > MaxFactorial) THEN
  177.     X.ExStatus := X.IllegalNumber;
  178.     Result := X.Ex0;
  179.     RETURN;
  180.   END;
  181.   IF    n < 500  THEN prev := X.Ex1;      fact := 0
  182.   ELSIF n < 1000 THEN prev := Fact500;  fact := 500
  183.   ELSIF n < 2000 THEN prev := Fact1000; fact := 1000
  184.   ELSIF n < 3000 THEN prev := Fact2000; fact := 2000
  185.   ELSE                prev := Fact3000; fact := 3000
  186.   END;
  187.   factorial(fact, n, prev, Result);
  188. END factorialX;
  189.  
  190.  
  191. PROCEDURE expX*(VAR Result : X.ExNumType; x : X.ExNumType);
  192. VAR
  193.   xPower : LONGREAL;
  194. BEGIN
  195.   xPower := ExNumToLongReal(x);
  196.   X.ExFrac(x);
  197.   IF (ABS(xPower) < MAX(LONGINT)) & X.IsZero(x) THEN
  198.     xtoi(Result, X.e, ENTIER(xPower));
  199.   ELSE
  200.     LongRealToExNum(LM.Exp(xPower), Result);
  201.   END;
  202. END expX;
  203.  
  204.  
  205. PROCEDURE powerX*(VAR Result : X.ExNumType; x, y : X.ExNumType);
  206. VAR
  207.   yPower : LONGREAL;
  208. BEGIN
  209.   yPower := ExNumToLongReal(y);
  210.   X.ExFrac(y);
  211.   IF (ABS(yPower) < MAX(LONGINT)) & X.IsZero(y) THEN
  212.     xtoi(Result, x, ENTIER(yPower));
  213.   ELSE
  214.     LongRealToExNum(LM.Pow(yPower,ExNumToLongReal(x)),Result);
  215.   END;
  216. END powerX;
  217.  
  218.  
  219. PROCEDURE rootX*(VAR Result : X.ExNumType; x, y : X.ExNumType);
  220. VAR
  221.   yRoot : LONGREAL;
  222. BEGIN
  223.   yRoot := ExNumToLongReal(y);
  224.   X.ExFrac(y);
  225.   IF (ABS(yRoot) < MAX(LONGINT)) & X.IsZero(y) THEN
  226.     Root(Result, x, ENTIER(yRoot));
  227.   ELSE
  228.     yRoot := 1.0D / yRoot;
  229.     LongRealToExNum(LM.Pow(yRoot,ExNumToLongReal(x)),Result);
  230.   END;
  231. END rootX;
  232.  
  233.  
  234. PROCEDURE sinX*(VAR Result : X.ExNumType; x : X.ExNumType);
  235. BEGIN
  236.   LongRealToExNum(LM.Sin(ExNumToLongReal(x)), Result);
  237. END sinX;
  238.  
  239.  
  240. PROCEDURE cosX*(VAR Result : X.ExNumType; x : X.ExNumType);
  241. BEGIN
  242.   LongRealToExNum(LM.Cos(ExNumToLongReal(x)), Result);
  243. END cosX;
  244.  
  245.  
  246. PROCEDURE tanX*(VAR Result : X.ExNumType; x : X.ExNumType);
  247. BEGIN
  248.   LongRealToExNum(LM.Tan(ExNumToLongReal(x)), Result);
  249. END tanX;
  250.  
  251.  
  252. PROCEDURE arctanX*(VAR Result : X.ExNumType; x : X.ExNumType);
  253. BEGIN
  254.   LongRealToExNum(LM.Atan(ExNumToLongReal(x)), Result);
  255. END arctanX;
  256.  
  257.  
  258. PROCEDURE coshX*(VAR Result : X.ExNumType; x : X.ExNumType);
  259. BEGIN
  260.   LongRealToExNum(LM.Cosh(ExNumToLongReal(x)), Result);
  261. END coshX;
  262.  
  263.  
  264. PROCEDURE sinhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  265. BEGIN
  266.   LongRealToExNum(LM.Sinh(ExNumToLongReal(x)), Result);
  267. END sinhX;
  268.  
  269.  
  270. PROCEDURE tanhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  271. BEGIN
  272.   LongRealToExNum(LM.Tanh(ExNumToLongReal(x)), Result);
  273. END tanhX;
  274.  
  275.  
  276. PROCEDURE arccoshX*(VAR Result : X.ExNumType; x : X.ExNumType);
  277. VAR
  278.   Temp : X.ExNumType;
  279. BEGIN
  280.   (* Result = ln(x + sqrt(x*x - 1)) *)
  281.   X.ExMult(Temp, x, x);
  282.   X.ExSub(Temp, Temp, X.Ex1);
  283.   sqrtX(Temp, Temp);
  284.   X.ExAdd(Temp, x, Temp);
  285.   lnX(Result, Temp);
  286. END arccoshX;
  287.  
  288.  
  289. PROCEDURE arcsinhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  290. VAR
  291.   Temp : X.ExNumType;
  292. BEGIN
  293.   (* Result = ln(x + sqrt(x*x + 1)) *)
  294.   X.ExMult(Temp, x, x);
  295.   X.ExAdd(Temp, Temp, X.Ex1);
  296.   sqrtX(Temp, Temp);
  297.   X.ExAdd(Temp, x, Temp);
  298.   lnX(Result, Temp);
  299. END arcsinhX;
  300.  
  301.  
  302. PROCEDURE arctanhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  303. VAR
  304.   Temp, Temp2 : X.ExNumType;
  305. BEGIN
  306.   (* Result = ln((1 + x) / (1 - x)) / 2 *)
  307.   X.ExAdd(Temp, X.Ex1, x);
  308.   X.ExSub(Temp2, X.Ex1, x);
  309.   X.ExDiv(Temp, Temp, Temp2);
  310.   lnX(Result, Temp);
  311.   X.ExNumb(0, 5, 0, Temp);
  312.   X.ExMult(Result, Result, Temp);
  313. END arctanhX;
  314.  
  315.  
  316. PROCEDURE arcsinX*(VAR Result : X.ExNumType; x : X.ExNumType);
  317. BEGIN
  318.   LongRealToExNum(LM.Asin(ExNumToLongReal(x)), Result);
  319. END arcsinX;
  320.  
  321.  
  322. PROCEDURE arccosX*(VAR Result : X.ExNumType; x : X.ExNumType);
  323. BEGIN
  324.   (* Replacement algorithm *)
  325.   LongRealToExNum(LM.Acos(ExNumToLongReal(x)), Result);
  326. END arccosX;
  327.  
  328.  
  329. BEGIN
  330.   (* Initialize a few internal conversion constants *)
  331.   X.StrToExNum(
  332.   "5.729577951308232087679815481410517033240547246656420E+1",
  333.   ToDegrees);
  334.   X.StrToExNum(
  335.   "1.745329251994329576923690768488612713442871888541727E-2",
  336.   ToRadians);
  337.  
  338.   (* Speed up very large factorials *)
  339.   X.StrToExNum(
  340.   "1.220136825991110068701238785423046926253574342803193E+1134",
  341.   Fact500);
  342.   X.StrToExNum(
  343.   "4.023872600770937735437024339230039857193748642107146E+2567",
  344.   Fact1000);
  345.   X.StrToExNum(
  346.   "3.316275092450633241175393380576324038281117208105780E+5735",
  347.   Fact2000);
  348.   X.StrToExNum(
  349.   "4.149359603437854085556867093086612170951119194931810E+9130",
  350.   Fact3000);
  351. END ExMathLib0.
  352.