<![CDATA[size : 6768
uploaded_on : Sat Jun 20 00:00:00 1998
modified_on : Wed Dec 8 14:03:36 1999
title : Trig functions/Arithmetic expression evaluator
org_filename : ExtMath.pas
author : PasWiz
authoremail :
description : New trig functions and an arithmetic expression evaluator
keywords :
tested : Borland Pascal 7.0
submitted_by : The CKB Crew
submitted_by_email : ckb@netalive.org
uploaded_by : nobody
modified_by : nobody
owner : nobody
lang : pas
file-type : text/plain
category : pascal-alg-maths
__END_OF_HEADER__
{Extended math:
This unit contains procedures and functions that implement extensions to
Pascal's built-in math (new trig functions, et al) and an arithmetic
expression evaluator. The latter is loosely based on EXPR.C from Dr.
Dobb's Journal, Sept 1985, p.25.
}
UNIT ExtMath;
INTERFACE
FUNCTION ArcCos (Number: Real): Real;
FUNCTION ArcCosH (Number: Real): Real;
FUNCTION ArcCot (Number: Real): Real;
FUNCTION ArcCotH (Number: Real): Real;
FUNCTION ArcCsc (Number: Real): Real;
FUNCTION ArcCscH (Number: Real): Real;
FUNCTION ArcSec (Number: Real): Real;
FUNCTION ArcSecH (Number: Real): Real;
FUNCTION ArcSin (Number: Real): Real;
FUNCTION ArcSinH (Number: Real): Real;
FUNCTION ArcTanH (Number: Real): Real;
FUNCTION Ceil (Number: Real): Real;
FUNCTION CosH (Number: Real): Real;
FUNCTION Cot (Number: Real): Real;
FUNCTION CotH (Number: Real): Real;
FUNCTION Csc (Number: Real): Real;
FUNCTION CscH (Number: Real): Real;
FUNCTION Deg2Rad (Number: Real): Real;
FUNCTION e: Real;
FUNCTION Erf (Number: Real): Real;
FUNCTION Fact (Number: Integer): Real;
FUNCTION Floor (Number: Real): Real;
FUNCTION Log (Number: Real): Real;
FUNCTION Rad2Deg (Number: Real): Real;
FUNCTION Raise (Number: Real; Power: Integer): Real;
FUNCTION Sec (Number: Real): Real;
FUNCTION SecH (Number: Real): Real;
FUNCTION SgnI (Number: Integer): Integer;
FUNCTION SgnR (Number: Real): Integer;
FUNCTION SinH (Number: Real): Real;
FUNCTION Tan (Number: Real): Real;
FUNCTION TanH (Number: Real): Real;
PROCEDURE Evaluate (Expr: String; VAR Result: Real; VAR ErrCode: Integer);
{ --------------------------------------------------------------------------- }
IMPLEMENTATION
{ forward declarations for the Evaluate procedure }
FUNCTION Eval (VAR Expr: String; VAR ErrCode: Integer): Real; FORWARD;
FUNCTION Factor (VAR Expr: String; VAR ErrCode: Integer): Real; FORWARD;
FUNCTION IsDigit (Expr: String): Boolean; FORWARD;
FUNCTION Locase (Ch: Char): Char; FORWARD;
FUNCTION ParensOk (Expr: String): Boolean; FORWARD;
FUNCTION Term (VAR Expr: String; VAR ErrCode: Integer): Real; FORWARD;
PROCEDURE AddParen (VAR Expr: String; Posn, WhichWay: Integer); FORWARD;
PROCEDURE FixPrecedence (VAR Expr: String); FORWARD;
{ ----- Ceiling ----- }
FUNCTION Ceil (Number: Real): Real;
BEGIN
IF Number = INT(Number) THEN
Ceil := Number
ELSE
Ceil := INT(Number) + 1.0;
END;
{ ----- Floor ----- }
FUNCTION Floor (Number: Real): Real;
BEGIN
IF Number = INT(Number) THEN
Floor := Number
ELSE
Floor := INT(Number) - 1.0;
END;
{ ----- Inverse cosine ----- }
FUNCTION ArcCos (Number: Real): Real;
BEGIN
IF (Number < -1.0) OR (Number > 1.0) THEN { error }
ArcCos := 99999.0
ELSE
ArcCos := PI / 2.0 - ArcSin(Number);
END;
{ ----- Inverse hyperbolic cosine ----- }
FUNCTION ArcCosH (Number: Real): Real;
BEGIN
ArcCosH := Log(Number + SQRT(SQR(Number) - 1.0));
END;
{ ----- Inverse cotangent ----- }
FUNCTION ArcCot (Number: Real): Real;
BEGIN
ArcCot := -ARCTAN(Number) + PI / 2.0;
END;
{ ----- Inverse hyperbolic cotangent ----- }
FUNCTION ArcCotH (Number: Real): Real;
BEGIN
ArcCotH := LN((Number + 1.0) / (Number - 1.0)) / 2.0;
END;
{ ----- Inverse cosecant ----- }
FUNCTION ArcCsc (Number: Real): Real;
BEGIN
ArcCsc := ARCTAN(1.0 / SQRT(1.0 - SQR(Number)))
+ (SgnR(Number) - 1.0) * (PI / 2.0);
END;
{ ----- Inverse hyperbolic cosecant ----- }
FUNCTION ArcCscH (Number: Real): Real;
BEGIN
ArcCscH := LN((SgnR(Number) * SQRT(SQR(Number) + 1.0) + 1.0) / Number);
END;
{ ----- Inverse secant ----- }
FUNCTION ArcSec (Number: Real): Real;
BEGIN
ArcSec := ARCTAN(Number / SQRT(1.0 - SQR(Number)))
+ (SgnR(Number) - 1.0) * (PI / 2.0);
END;
{ ----- Inverse hyperbolic secant ----- }
FUNCTION ArcSecH (Number: Real): Real;
BEGIN
ArcSecH := LN((SQRT(1.0 - SQR(Number)) + 1.0) / Number);
END;
{ ----- Inverse sine ----- }
FUNCTION ArcSin (Number: Real): Real;
VAR
Negate: Boolean;
tmp: Real;
BEGIN
IF Number < 0.0 THEN BEGIN
Number := -Number;
Negate := TRUE;
END
ELSE
Negate := FALSE;
IF Number > 1.0 THEN BEGIN
tmp := 99999.0;
Negate := FALSE;
END
ELSE BEGIN
tmp := SQRT(1.0 - SQR(Number));
IF Number > 0.7 THEN
tmp := PI / 2.0 - ARCTAN(tmp / Number)
ELSE
tmp := ARCTAN(Number / tmp);
END;
IF Negate THEN
ArcSin := -tmp
ELSE
ArcSin := tmp;
END;
{ ----- Inverse hyperbolic sine ----- }
FUNCTION ArcSinH (Number: Real): Real;
BEGIN
ArcSinH := Log(Number + SQRT(SQR(Number) + 1.0));
END;
{ ----- Inverse hyperbolic tangent ----- }
FUNCTION ArcTanH (Number: Real): Real;
BEGIN
ArcTanH := Log((1.0 + Number) / (1.0 - Number)) / 2.0;
END;
{ ----- Convert degrees to radians ----- }
FUNCTION Deg2Rad (Number: Real): Real;
BEGIN
Deg2Rad := Number * PI / 180.0;
END;
{ ----- e (base of the natural logarithms) ----- }
FUNCTION e: Real;
BEGIN
e := 2.7182818284590452353602874713526624977572470936999595749669676;
END;
{ ----- Hyperbolic cosine ----- }
FUNCTION CosH (Number: Real): Real;
BEGIN
IF Number < 0.0 THEN
Number := - Number;
IF Number > 21.0 THEN
CosH := Exp(Number) / 2.0
ELSE
CosH := (Exp(Number) + Exp(-Number)) / 2.0;
END;
{ ----- Cotangent ----- }
FUNCTION Cot (Number: Real): Real;
BEGIN
Cot := 1.0 / Tan(Number);
END;
{ ----- Hyperbolic cotangent ----- }
FUNCTION CotH (Number: Real): Real;
VAR
tmp: REAL;
BEGIN
tmp := EXP(-Number);
CotH := tmp / (EXP(Number) - tmp) * 2.0 + 1.0;
END;
{ ----- Cosecant ----- }
FUNCTION Csc (Number: Real): Real;
BEGIN
Csc := 1.0 / Sin(Number);
END;
{ ----- Hyperbolic cosecant ----- }
FUNCTION CscH (Number: Real): Real;
BEGIN
CscH := 2.0 / (EXP(Number) - EXP(-Number));
END;
{ ----- Error Function ----- }
FUNCTION Erf (Number: Real): Real;
VAR
J, N: Integer;
S: Real;
BEGIN
N := Trunc(14.0 * Number + 3.0);
S := 1.0 / (2.0 * N - 1.0);
FOR J := N - 1 DOWNTO 1 DO
S := 1.0 / (2.0 * J - 1.0) - SQR(Number) / J * S;
Erf := Number / 0.8862269254527581 * S;
END;
{ ----- Factorial ----- }
FUNCTION Fact (Number: Integer): Real;
VAR
Result: Real;
tmp: Integer;
BEGIN
Result := 1.0;
FOR tmp := 2 TO Number DO
Result := Result * tmp;
Fact := Result;
END;
{ ----- Logarithm (base 10) ----- }
FUNCTION Log (Number: Real): Real;
BEGIN
Log := Ln(Number) / Ln(10.0);
END;
{ ----- Convert radians to degrees ----- }
FUNCTION Rad2Deg (Number: Real): Real;
BEGIN
Rad2Deg := Number * 180.0 / PI;
END;
{ ----- Raise a number to a power (a feature oddly lacking in Pascal). }
FUNCTION Raise (Number: Real; Power: Integer): Real;
VAR
tmp: Integer;
Result: Real;
BEGIN
Result := 1.
]]>