home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vmathu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-28  |  103.9 KB  |  5,512 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix Math Functions Unit (VMATH)
  5.    Version 0.11
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  --------  --------  --------------------------------------------------------
  15.  
  16.  mep       04/18/93  Added Integrate.
  17.  
  18.  mep       03/25/93  Fixed ArcSin, ArcCos, ArcCsc, ArcSec, ArcCot, and
  19.                        Factorial.
  20.                      Cleaned up code.
  21.  
  22.  mep       02/11/93  Cleaned up code for beta release
  23.  
  24.  jrt       02/08/93  Sync with beta 0.12
  25.  
  26.  mep       02/02/93  Changed hyberbolic function names to be more proper.
  27.                      Cleanup of code for release (with more notes).
  28.                      Added: DistanceXY, QuadraticPlus, QuadraticNeg,
  29.                        Factorial, Permu, Combo, DegToRad, GradToRad,
  30.                        DegToGrad, RadToDeg, RadToGrad, GradToDeg, GCF,
  31.                        LCM.
  32.  
  33.  lpg       01/13/92  Added: Sin2,Cos2
  34.                      Also wrote up quick Trig Info for header
  35.  
  36.  lpg       01/13/92  Renamed Clamp functions to Range
  37.  
  38.  jrt       12/07/92  Sync with beta 0.11 release
  39.  
  40.  jrt       11/21/92  Sync with beta 0.08
  41.  
  42.  lpg       11/08/92  Added more function:  all Hyp and Arc series.
  43.  
  44.  lpg       10/05/92  First logged revision.
  45.  
  46.  ════════════════════════════════════════════════════════════════════════════
  47. }
  48.  
  49. (*
  50.  
  51. [TEXT]
  52.  
  53. <Overview>
  54.  
  55. This unit implements a wide variety of higher-level math functions.
  56.  
  57.  
  58. Definitions of Terms
  59. --------------------
  60.  
  61. TRIGONOMETRY - The branch of mathematics that deals with the relations
  62.   between the sides and angles of pnae of spherical triangles, and the
  63.   calculations based upon them.  [<NL trigonometria, lit., "triangle
  64.   measuring"]
  65.  
  66. RADIAN - An angle at the center of a circle, subtending an arc of
  67.   the circle equal in length to the radius.  A length of the circle's
  68.   radius measured across a circle's circumference and measured in
  69.   angles from the circle's center. 1 Radian = 57.2958 degrees.
  70.   3.14159 Radians = 360 degrees.  [Radi(us) + an]
  71.  
  72. HYPOTENUSE - The side of a right triangle opposite the right angle.
  73.  
  74. QUADRANT - A quarter of a circle.  [ME<L quadrant-(s. of quadrans)
  75.   4th part]
  76.  
  77. e (base of the natural logarithms) is approximately 2.718;
  78.  
  79. π (pi) is approximately 3.14159
  80.  
  81. Θ = Angle Theta (General reference angle)
  82.  
  83. ∞ = Infinity
  84.  
  85. │x│ = Absolute value of x
  86.  
  87. √x = Square root of x
  88.  
  89. x^n = x raised to the n power
  90.  
  91. ln(x) = Natural logarithm of x
  92.  
  93.  
  94.  
  95.  
  96. GRAPHS OF THE UNIT CIRCLE
  97. =========================
  98.  
  99.  
  100. I. QUADRANT SYSTEM
  101. ------------------
  102.  
  103.     R = Radius of Circle (here 1 unit)
  104.  
  105.                      +Y
  106.                       .
  107.                       .
  108.                       .(0,1)
  109.                  .....*......
  110.                ..     .      .. B
  111.               .       .        +
  112. Quadrant 2   .        .       /|.   Quadrant 1
  113.             .         .      / | .
  114.            .          .     /  |  .
  115.           .           .  R /   |   .
  116.           .           .   /   a|   .
  117.          .            .  / c   |    .
  118.          .            . /      |    .
  119.    (-1,0).           A./   b   |C   .(1,0)
  120. -X ......*............+--------+....*..... +X
  121.          .       (0,0).             .
  122.          .      Origin.             .
  123.          .            .             .
  124.           .           .            .
  125.           .           .            .
  126.            .          .           .
  127.             .         .          .
  128. Quadrant 3   .        .         .   Quadrant 4
  129.               .       .        .
  130.                ..     .     ..
  131.                  .....*.....
  132.                       .(0,-1)
  133.                       .
  134.                       .
  135.                      -Y
  136.  
  137.  
  138.  
  139. II. RADIANS AND DEGREES
  140. -----------------------
  141.  
  142.                 π/2
  143.           2π/3        π/3
  144.              ....*....
  145.     3π/4  ..*         *..   π/4
  146.          .               .
  147.         *        90       *
  148.        .    120  .   60    .
  149.       .          .          .
  150. 5π/6 .   135     .     45    . π/6
  151.      *           .           *
  152.     .  150       .        30  .
  153.     .            .            .
  154.     .            .            .
  155.     .            .            .
  156.  π  * 180 .......+......... 0 *  0
  157.     .            .            .
  158.     .            .            .
  159.     .            .            .
  160.     .  210       .       330  .
  161.      *           .           *
  162. 7π/6 .           .           . 11π/6
  163.       .  225     .     315  .
  164.        .         .         .
  165.         *   240     300   *
  166.          .      270      .
  167.     5π/4  ..           ..  7π/4
  168.             *....*....*
  169.  
  170.           4π/3       5π/3
  171.                 3π/2
  172.  
  173.  
  174.  
  175. III. CIRCULAR FUNCTION DEFINITIONS
  176. ----------------------------------
  177.  
  178.                 Y
  179.                 .
  180.                 .
  181.  
  182.             .........
  183.     (x,y)...         ...
  184.         .       .       .
  185.        *        .        .
  186.       .|\       .         .
  187.      . | \  r   .          .
  188.     .  |  \     .           .        Where Θ is any angle:
  189.     .  |   \                .
  190.    .  y|    \   __           .        sin Θ = y / r
  191.    .   |     \ /  \          .
  192.    .   |      \  Θ \         .        cos Θ = x / r
  193.    .   |       \   |         .
  194. .. . ..---------+ .......... . ..X    tan Θ = y / x
  195.    .       x                 .
  196.    .            .            .        csc Θ = r / y
  197.    .            .            .
  198.    .            .            .        sec Θ = r / x
  199.     .           .           .
  200.     .           .           .         cot Θ = x / y
  201.      .          .          .
  202.       .         .         .
  203.        .        .        .
  204.         .       .       .
  205.          ..           ..
  206.            ...........
  207.  
  208.                 .
  209.                 .
  210.  
  211.  
  212. IV. SINE/COSINE RELATIONSHIPS
  213. -----------------------------
  214.  
  215.   On unit circles, (x, y) = (cos, sin)
  216.  
  217.  
  218.                         (0, 1)
  219.  
  220.                            .
  221.             (-1/2, √3/2)   .   (1/2, √3/2)
  222.  
  223.                        ....*....
  224.     (-√2/2, √2/2)   ..*         *..  (√2/2, √2/2)
  225.                    .       .       .
  226.                   *        .        *
  227.                  .         .         .
  228.   (√3/2, 1/2)   .          .          .  (√3/2, 1/2)
  229.                .           .           .
  230.                *           .           *
  231.               .     II     .     I      .
  232.               .            .            .
  233.               .            .            .
  234.               .            .            .
  235. (-1, 0) ..... * ...........+........... * ..... (1, 0)
  236.               .            .            .
  237.               .            .            .
  238.               .            .            .
  239.               .            .            .
  240.                *    III    .     IV    *
  241.                .           .           .
  242.   (-√3/2, -1/2) .          .          .  (√3/2, -1/2)
  243.                  .         .         .
  244.                   *        .        *
  245.                    .       .       .
  246.     (-√2/2, -√2/2)  ..           ..  (√2/2, -√2/2)
  247.                       *....*....*
  248.  
  249.             (-1/2, -√3/2)  .  (1/2, -√3/2)
  250.                            .
  251.  
  252.                         (0, -1)
  253.  
  254.  
  255.  
  256.   In quadrant I,   ALL trig. functions are positive.
  257.   In quadrant II,  only SIN and CSC are positive.
  258.   In quadrant III, only TAN and COT are positive.
  259.   In quadrant IV,  only COS and SEC are positive.
  260.  
  261.  
  262.  
  263.  
  264.  
  265. Definition of the Six Trigonometric Functions
  266. ---------------------------------------------
  267. (Right triangle definitions, where 0 < Θ < π/2)
  268.  
  269.           e
  270.          s +    sin Θ = Opp / Hyp
  271.         u /|O
  272.        n / |p   cos Θ = Adj / Hyp
  273.       e /  |p
  274.      t /   |o   tan Θ = Opp / Adj
  275.     o /    |s
  276.    p /     |i   csc Θ = 1 / sin Θ = Hyp / Opp
  277.   y /      |t
  278.  H / Θ     |e   sec Θ = 1 / cos Θ = Hyp / Adj
  279.   +--------+
  280.    Adjacent     cot Θ = 1 / tan Θ = Adj / Opp
  281.  
  282.  
  283.  
  284. Definition of Inverse Trigonometric Functions
  285. ---------------------------------------------
  286.  
  287. Function                     Domain         Range
  288. --------------------------   ------------   ----------------
  289.  
  290. y = arcsin x iff sin y = x   -1 <= x <= 1   -π/2 <= y <= π/2
  291.  
  292. y = arccos x iff cos y = x   -1 <= x <= 1   0 <= y <= π
  293.  
  294. y = arctan x iff tan y = x   -∞ < x < ∞     -π/2 < y < π/2
  295.  
  296. y = arccot x iff cot y = x   -∞ < x < ∞     0 < y < π
  297.  
  298. y = arcsec x iff sec y = x   │x│ >= 1       0 <= y <= π, y <> π/2
  299.  
  300. y = arccsc x iff csc y = x   │x│ >= 1       -π/2 <= y <= π/2, y <> 0
  301.  
  302.  
  303.  
  304. Definition of the Hyberbolic Functions
  305. --------------------------------------
  306.  
  307. Function                   Domain               Range
  308. -------------------------  ------------------   ------------------
  309.  
  310. sinh x = (e^x - e^-x) / 2  -∞ < x < ∞           -∞ < y < ∞
  311.  
  312. cosh x = (e^x + e^-x) / 2  -∞ < x < ∞           -1 <= y < ∞
  313.  
  314. tanh x = sinh x / cosh x   -∞ < x < ∞           -1 < y < 1
  315.  
  316. csch x = 1 / sinh x,       -∞ < x < ∞, x <> 0   -∞ < y < ∞, y <> 0
  317.  
  318. sech x = 1 / cosh x        -∞ < x < ∞           0 < y <= 1
  319.  
  320. coth x = 1 / tanh x,       -∞ < x < ∞, x <> 0   -∞ < y < -1,
  321.                                                  1 < y < ∞
  322.  
  323.  
  324.  
  325. Definition of the Inverse Hyperbolic Functions
  326. ----------------------------------------------
  327.  
  328. Function                                      Domain       Range
  329. -------------------------------------------   ----------   ---------
  330.  
  331. arcsinh x = ln( x + √(x^2 + 1) )              -∞ < x < ∞   -∞ < y < ∞
  332.  
  333. arccosh x = ln( x + √(x^2 - 1) )              1 <= x < ∞   ∞ <= y < ∞
  334.  
  335. arctanh x = (1/2) * ln( (1 + x) / (1 - x) )   │x│ < 1      ∞ <= y < ∞
  336.  
  337. arccoth x = (1/2) * ln( (x + 1) / (x - 1) )   │x│ > 1      -∞ < y < ∞, y <> 0
  338.  
  339. arcsech x = ln( (1 + √(1 - x^2)) / x )        0 < x <= 1   0 <= y < ∞
  340.  
  341. arccsch x = ln( (1 + √(1 + x^2)) / │x│ )      x > 0        -∞ < y < ∞, y <> 0
  342.  
  343.           = ln( (-1 + √(1 + x^2)) / │x│ )     x < 0
  344.  
  345.  
  346. *)
  347.  
  348. {────────────────────────────────────────────────────────────────────────────}
  349.  
  350. Unit VMathu;
  351.  
  352.  
  353. INTERFACE
  354.  
  355.  
  356.   {------------------------------------}
  357.   { Constants and type definitions     }
  358.   {------------------------------------}
  359.  
  360. Const
  361.  
  362.   cINFINITY  = 9.9999999999E+37;  {or 5.5E11, also 65000 for INTEGER}
  363.   cOVERFLOW  = 9.9999999999E+37;
  364.   cUNDERFLOW = 1.0E-37;
  365.   cTolerance = 0.00000001;        {for math error tolerances}
  366.  
  367. Type
  368.  
  369.   {----------------------------------------------}
  370.   { For procedures requiring a user-defined f(x) }
  371.   {----------------------------------------------}
  372.  
  373.   FXFunc = Function( X : REAL ) : REAL;
  374.   PXFunc = ^FXFunc;
  375.  
  376.   {--------------}
  377.   { Linear Array }
  378.   {--------------}
  379.  
  380.   TArrayR = Array[1..1] of REAL;
  381.   PArrayR = ^TArrayR;
  382.  
  383.   TArrayRA = Array[1..100] of REAL;
  384.   PArrayRA = ^TArrayRA;
  385.  
  386.   {-------------------------------------------}
  387.   { Coordinate Array - Maps over Linear Array }
  388.   {-------------------------------------------}
  389.  
  390.   TRec2R = RECORD
  391.  
  392.     X : REAL;
  393.     Y : REAL;
  394.  
  395.   END;
  396.  
  397.   TArray2R = Array[1..1] of TRec2R;
  398.   PArray2R = ^TArray2R;
  399.  
  400.   TArray2RA = Array[1..100] of TRec2R;
  401.   PArray2RA = ^TArray2RA;
  402.  
  403. {────────────────────────────────────────────────────────────────────────────}
  404.  
  405. Function  HMStoDegrees(      Degs      : WORD;
  406.                              Mins      : WORD;
  407.                              Secs      : REAL         ) : REAL;
  408.  
  409. Procedure DegreesToHMS(      Degrees   : REAL;
  410.                          Var Degs      : INTEGER;
  411.                          Var Min       : INTEGER;
  412.                          Var Sec       : REAL         );
  413.  
  414. Function  DegToRad(          Deg       : REAL         ) : REAL;
  415.  
  416. Function  GradToRad(         Grad      : REAL         ) : REAL;
  417.  
  418. Function  DegToGrad(         Deg       : REAL         ) : REAL;
  419.  
  420. Function  RadToDeg(          Rad       : REAL         ) : REAL;
  421.  
  422. Function  RadToGrad(         Rad       : REAL         ) : REAL;
  423.  
  424. Function  GradToDeg(         Grad      : REAL         ) : REAL;
  425.  
  426. {----------------}
  427. { Trig Functions }
  428. {----------------}
  429.  
  430. Function  Quad(              Radians   : REAL         ) : INTEGER;
  431.  
  432. Function  Quad2(             X, Y      : REAL         ) : INTEGER;
  433.  
  434. Function  Sin2(              X, Y      : REAL         ) : REAL;
  435.  
  436. Function  Cos2(              X, Y      : REAL         ) : REAL;
  437.  
  438. Function  Tan(               X         : REAL         ) : REAL;
  439.  
  440. Function  Tan2(              X, Y      : REAL         ) : REAL;
  441.  
  442. Function  Cot(               X         : REAL         ) : REAL;
  443.  
  444. Function  Cot2(              X, Y      : REAL         ) : REAL;
  445.  
  446. Function  Csc(               X         : REAL         ) : REAL;
  447.  
  448. Function  Sec(               X         : REAL         ) : REAL;
  449.  
  450. Function  Sinh(              X         : REAL         ) : REAL;  {NOT TESTED}
  451.  
  452. Function  Cosh(              X         : REAL         ) : REAL;
  453.  
  454. Function  Tanh(              X         : REAL         ) : REAL;
  455.  
  456. Function  Csch(              X         : REAL         ) : REAL;  {NOT TESTED}
  457.  
  458. Function  Sech(              X         : REAL         ) : REAL;  {NOT TESTED}
  459.  
  460. Function  Coth(              X         : REAL         ) : REAL;  {NOT TESTED}
  461.  
  462. Function  ArcSin(            X         : REAL         ) : REAL;
  463.  
  464. Function  ArcSin2(           X         : REAL;
  465.                              Quadrant  : INTEGER      ) : REAL;
  466.  
  467. Function  ArcCos(            X         : REAL         ) : REAL;
  468.  
  469. Function  ArcCos2(           X         : REAL;
  470.                              Quadrant  : INTEGER      ) : REAL;
  471.  
  472. Function  ArcTan1(           X         : REAL         ) : REAL;
  473.  
  474. Function  ArcTan2(           X, Y      : REAL         ) : REAL;
  475.  
  476. Function  ArcCsc(            X         : REAL         ) : REAL; {NOT TESTED}
  477.  
  478. Function  ArcSec(            X         : REAL         ) : REAL;  {NOT TESTED}
  479.  
  480. Function  ArcCot(            X         : REAL         ) : REAL;  {NOT TESTED}
  481.  
  482. Function  ArcSinh(           X         : REAL         ) : REAL;
  483.  
  484. Function  ArcCosh(           X         : REAL         ) : REAL;
  485.  
  486. Function  ArcTanh(           X         : REAL         ) : REAL;
  487.  
  488. Function  ArcCsch(           X         : REAL         ) : REAL;
  489.  
  490. Function  ArcSech(           X         : REAL         ) : REAL;
  491.  
  492. Function  ArcCoth(           X         : REAL         ) : REAL;
  493.  
  494. {----------------------}
  495. { Basic Math Functions }
  496. {----------------------}
  497.  
  498. Function  Power(             Num       : LONGINT;
  499.                              Exponent  : LONGINT      ) : LONGINT;
  500.  
  501. Function  PowerR(            Num       : REAL;
  502.                              Exponent  : REAL         ) : REAL;
  503.  
  504. Function  Root(              Num       : LONGINT;
  505.                              RootVal   : LONGINT      ) : LONGINT;
  506.  
  507. Function  RootR(             Num       : REAL;
  508.                              RootVal   : REAL         ) : REAL;
  509.  
  510. Function  Log(               Num       : REAL;
  511.                              Base      : REAL         ) : REAL;
  512.  
  513. Function  FastHyp(           XDist     : REAL;
  514.                              YDist     : REAL         ) : REAL;
  515.  
  516. Function  FastHypR(          XDist     : REAL;
  517.                              YDist     : REAL         ) : REAL;
  518.  
  519. Function  Hypot(             XDist     : REAL;
  520.                              YDist     : REAL         ) : REAL;
  521.  
  522. Function  FastDist(          X1        : LONGINT;
  523.                              Y1        : LONGINT;
  524.                              X2        : LONGINT;
  525.                              Y2        : LONGINT      ) : LONGINT;
  526.  
  527. Function  DistanceXY(        X1        : REAL;
  528.                              Y1        : REAL;
  529.                              X2        : REAL;
  530.                              Y2        : REAL         ) : REAL;
  531.  
  532. Function  Percent(           Part      : LONGINT;
  533.                              Whole     : LONGINT      ) : REAL;
  534.  
  535. Function  Min(               A         : LONGINT;
  536.                              B         : LONGINT      ) : LONGINT;
  537.  
  538. Function  MinR(              A         : REAL;
  539.                              B         : REAL         ) : REAL;
  540.  
  541. Function  Max(               A         : LONGINT;
  542.                              B         : LONGINT      ) : LONGINT;
  543.  
  544. Function  MaxR(              A         : REAL;
  545.                              B         : REAL         ) : REAL;
  546.  
  547. Function  Range(             Num       : LONGINT;
  548.                              Low       : LONGINT;
  549.                              High      : LONGINT      ) : LONGINT;
  550.  
  551. Function  RangeR(            Num       : REAL;
  552.                              Low       : REAL;
  553.                              High      : REAL         ) : REAL;
  554.  
  555. Function  Floor(             Num       : LONGINT;
  556.                              Low       : LONGINT      ) : LONGINT;
  557.  
  558. Function  FloorR(            Num       : REAL;
  559.                              Low       : REAL         ) : REAL;
  560.  
  561. Function  Ceiling(           Num       : LONGINT;
  562.                              High      : LONGINT      ) : LONGINT;
  563.  
  564. Function  CeilingR(          Num       : REAL;
  565.                              High      : REAL         ) : REAL;
  566.  
  567. Function  Sign(              Num       : LONGINT      ) : INTEGER;
  568.  
  569. Function  SignR(             Num       : REAL         ) : INTEGER;
  570.  
  571.  
  572. {-----------------------}
  573. { Higher Math Functions }
  574. {-----------------------}
  575.  
  576. Function  QuadraticPlus(     A         : LONGINT;
  577.                              B         : LONGINT;
  578.                              C         : LONGINT      ) : REAL;
  579.  
  580. Function  QuadraticNeg(      A         : LONGINT;
  581.                              B         : LONGINT;
  582.                              C         : LONGINT      ) : REAL;
  583.  
  584. Function  Factorial(         N         : BYTE         ) : REAL;
  585.  
  586. Function  Permu(             N         : BYTE;
  587.                              R         : BYTE         ) : REAL;
  588.  
  589. Function  Combo(             N         : BYTE;
  590.                              R         : BYTE         ) : REAL;
  591.  
  592. Function  Prime(             N         : LONGINT      ) : BOOLEAN;
  593.  
  594. Function  GCF(               A         : LONGINT;
  595.                              B         : LONGINT      ) : LONGINT;
  596.  
  597. Function  LCM(               A         : LONGINT;
  598.                              B         : LONGINT      ) : LONGINT;
  599.  
  600. Procedure LoadArrayR(    VAR Arr       : PArrayR;
  601.                              Idx       : WORD;
  602.                              R         : REAL         );
  603.  
  604. Procedure LoadArrayRXY(  VAR Arr       : PArray2R;
  605.                              Idx       : WORD;
  606.                              X         : REAL;
  607.                              Y         : REAL         );
  608.  
  609. Procedure MeanStdDev(        Arr       : PArrayR;
  610.                              Cnt       : INTEGER;
  611.                          VAR Mean      : REAL;
  612.                          VAR StdDev    : REAL         );
  613.  
  614. Function  Sigma(             Arr       : PArrayR;
  615.                              Cnt       : INTEGER      ) : REAL;
  616.  
  617. Procedure LeastSqr(          Arr       : PArray2R;
  618.                              Cnt       : INTEGER;
  619.                          VAR YInt      : REAL;
  620.                          VAR Slope     : REAL         );
  621.  
  622. Function  Integrate(         A         : REAL;
  623.                              B         : REAL;
  624.                              Func      : PXFunc;
  625.                              N         : WORD;
  626.                              MaxErr    : REAL         ) : REAL;
  627.  
  628.   {------------------------------}
  629.   { Begin implementation of code }
  630.   {------------------------------}
  631.  
  632. IMPLEMENTATION
  633.  
  634. Const
  635.  
  636.   PI_1   = PI * 0.5;    {  90 Degrees - End of 1st Quadrant }
  637.   PI_2   = PI;          { 180 Degrees - End of 2nd Quadrant }
  638.   PI_3   = PI * 1.5;    { 270 Degrees - End of 3rd Quadrant }
  639.   PI_4   = PI * 2.0;    { 360 Degrees - End of 4th Quadrant }
  640.  
  641.  
  642. Var
  643.  Ra,Rb : REAL;  {TESTING VALUES}
  644.  
  645. {────────────────────────────────────────────────────────────────────────────}
  646.  
  647. (*-
  648.  
  649. [FUNCTION]
  650.  
  651. Function HMStoDegrees(       Degs      : WORD;
  652.                              Mins      : WORD;
  653.                              Secs      : REAL         ) : REAL;
  654.  
  655. [PARAMETERS]
  656.  
  657. Degs        Arc Degrees
  658. Mins        Arc Minutes
  659. Secs        Arc Seconds
  660.  
  661. [RETURNS]
  662.  
  663. Floating point decimal degrees
  664.  
  665. [DESCRIPTION]
  666.  
  667. Converts arc degrees, minutes and seconds into a floating point
  668. degree value.
  669.  
  670. [SEE-ALSO]
  671.  
  672. DegreesToHMS
  673.  
  674. [EXAMPLE]
  675.  
  676. BEGIN
  677.  
  678.   WriteLn( HMStoDegrees( 59, 30, 0 ):8:4 );
  679.  
  680. END;
  681.  
  682. -*)
  683.  
  684.  
  685. Function HMStoDegrees(       Degs      : WORD;
  686.                              Mins      : WORD;
  687.                              Secs      : REAL         ) : REAL;
  688.  
  689. BEGIN
  690.  
  691.   HMStoDegrees := Degs + ( Mins DIV 60 ) + ( Secs / 3600.0 );
  692.  
  693. END;
  694.  
  695. {────────────────────────────────────────────────────────────────────────────}
  696.  
  697. (*-
  698.  
  699. [FUNCTION]
  700.  
  701. Procedure DegreesToHMS(      Degrees   : REAL;
  702.                          Var Degs      : INTEGER;
  703.                          Var Min       : INTEGER;
  704.                          Var Sec       : REAL         );
  705.  
  706. [PARAMETERS]
  707.  
  708. Degrees     Floating Point Angle in Degrees
  709. Degs        VAR Returned Arc Degrees
  710. Min         VAR Returned Arc Minutes
  711. Sec         VAR Returned Arc Seconds
  712.  
  713. [RETURNS]
  714.  
  715. (Function : None)
  716. (VAR      : [Degs] Arc Degrees)
  717. (VAR      : [Min ] Arc Minutes)
  718. (VAR      : [Sec ] Arc Seconds)
  719.  
  720. [DESCRIPTION]
  721.  
  722. Converts a Floating Point Angle in Degrees into the Component
  723. Parts of Arc (Degrees, Minutes and Seconds)
  724.  
  725. [SEE-ALSO]
  726.  
  727. [EXAMPLE]
  728.  
  729. VAR
  730.   D,M,S : REAL;
  731.  
  732. BEGIN
  733.  
  734.   DegreesToHMS( 45.6137, D,M,S );
  735.  
  736.   WriteLn( 'Deg = ',Deg:2:0 );
  737.   WriteLn( 'Min = ',Min:2:0 );
  738.   WriteLn( 'Sec = ',Sec:5:2 );
  739.  
  740. END;
  741.  
  742. -*)
  743.  
  744. Procedure DegreesToHMS(      Degrees   : REAL;
  745.                          Var Degs      : INTEGER;
  746.                          Var Min       : INTEGER;
  747.                          Var Sec       : REAL         );
  748.  
  749. BEGIN
  750.  
  751.   Degs := Trunc( Degrees );
  752.   Min  := Trunc( Degrees * 60.0 ) MOD 60;
  753.   Sec  := Frac( Degrees * 60.0 ) * 60.0;
  754.  
  755. END;  { DegreesToHMS }
  756.  
  757. {────────────────────────────────────────────────────────────────────────────}
  758.  
  759. (*-
  760.  
  761. [FUNCTION]
  762.  
  763. Function DegToRad(           Deg       : REAL         ) : REAL;
  764.  
  765. [PARAMETERS]
  766.  
  767. Deg         Floating Point Angle in Degrees
  768.  
  769. [RETURNS]
  770.  
  771. Angle in Radians
  772.  
  773. [DESCRIPTION]
  774.  
  775. Converts Arc Degrees to Radians.
  776.  
  777. [SEE-ALSO]
  778.  
  779. DegToGrad
  780. RadToDeg
  781. RadToGrad
  782. GradToDeg
  783. GradToRad
  784.  
  785. [EXAMPLE]
  786.  
  787. VAR
  788.   Rad : REAL;
  789.  
  790. BEGIN
  791.  
  792.   Rad := DegToRad(   0.0 );  { Rad = 0.0000 }
  793.   Rad := DegToRad(  30.0 );  { Rad = 0.5236 }
  794.   Rad := DegToRad(  45.0 );  { Rad = 0.7854 }
  795.   Rad := DegToRad(  90.0 );  { Rad = 1.5708 }
  796.   Rad := DegToRad( 180.0 );  { Rad = 3.1416 }
  797.   Rad := DegToRad( 360.0 );  { Rad = 6.2832 }
  798.  
  799. END;
  800.  
  801. -*)
  802.  
  803. Function DegToRad(           Deg       : REAL         ) : REAL;
  804.  
  805. BEGIN
  806.  
  807.   DegToRad := Deg * Pi / 180;
  808.  
  809. END; { DegToRad }
  810.  
  811. {────────────────────────────────────────────────────────────────────────────}
  812.  
  813. (*-
  814.  
  815. [FUNCTION]
  816.  
  817. Function DegToGrad(          Deg       : REAL         ) : REAL;
  818.  
  819. [PARAMETERS]
  820.  
  821. Deg         Angle in Degrees
  822.  
  823. [RETURNS]
  824.  
  825. Angle in Gradients
  826.  
  827. [DESCRIPTION]
  828.  
  829. Converts Arc Degrees to Gradients
  830.  
  831. [SEE-ALSO]
  832.  
  833. DegToRad
  834. RadToDeg
  835. RadToGrad
  836. GradToDeg
  837. GradToRad
  838.  
  839. [EXAMPLE]
  840.  
  841. VAR
  842.   Grad : REAL;
  843.  
  844. BEGIN
  845.  
  846.   Grad := DegToGrad(   0.0 );  { Grad =   0.0000 }
  847.   Grad := DegToGrad(  30.0 );  { Grad =  33.3333 }
  848.   Grad := DegToGrad(  45.0 );  { Grad =  50.0000 }
  849.   Grad := DegToGrad(  90.0 );  { Grad = 100.0000 }
  850.   Grad := DegToGrad( 180.0 );  { Grad = 200.0000 }
  851.   Grad := DegToGrad( 360.0 );  { Grad = 400.0000 }
  852.  
  853. END;
  854.  
  855. -*)
  856.  
  857. Function DegToGrad(          Deg       : REAL         ) : REAL;
  858.  
  859. BEGIN
  860.  
  861.   DegToGrad := Deg / 0.9;
  862.  
  863. END; { DegToGrad }
  864.  
  865. {────────────────────────────────────────────────────────────────────────────}
  866.  
  867. (*-
  868.  
  869. [FUNCTION]
  870.  
  871. Function RadToDeg(           Rad       : REAL         ) : REAL;
  872.  
  873. [PARAMETERS]
  874.  
  875. Rad         Angle in Radians
  876.  
  877. [RETURNS]
  878.  
  879. Angle in Degrees
  880.  
  881. [DESCRIPTION]
  882.  
  883. Converts Arc Radians to Degrees
  884.  
  885. [SEE-ALSO]
  886.  
  887. DegToRad
  888. DegToGrad
  889. RadToGrad
  890. GradToDeg
  891. GradToRad
  892.  
  893. [EXAMPLE]
  894.  
  895. VAR
  896.   Deg : REAL;
  897.  
  898. BEGIN
  899.  
  900.   Deg := RadToDeg( 0.0    );  { Deg =   0.0000 }
  901.   Deg := RadToDeg( PI/6.0 );  { Deg =  30.0000 }
  902.   Deg := RadToDeg( PI*0.25);  { Deg =  45.0000 }
  903.   Deg := RadToDeg( PI*0.5 );  { Deg =  90.0000 }
  904.   Deg := RadToDeg( PI     );  { Deg = 180.0000 }
  905.   Deg := RadToDeg( PI*2.0 );  { Deg = 360.0000 }
  906.  
  907. END;
  908.  
  909. -*)
  910.  
  911. Function RadToDeg(           Rad       : REAL         ) : REAL;
  912.  
  913. BEGIN
  914.  
  915.   RadToDeg := Rad * 180/Pi;
  916.  
  917. END; { RadToDeg }
  918.  
  919. {────────────────────────────────────────────────────────────────────────────}
  920.  
  921. (*-
  922.  
  923. [FUNCTION]
  924.  
  925. Function RadToGrad(          Rad       : REAL         ) : REAL;
  926.  
  927. [PARAMETERS]
  928.  
  929. Rad         Angle in Radians
  930.  
  931. [RETURNS]
  932.  
  933. Angle in Gradients
  934.  
  935. [DESCRIPTION]
  936.  
  937. Converts Arc Radians to Gradients
  938.  
  939. [SEE-ALSO]
  940.  
  941. DegToRad
  942. DegToGrad
  943. RadToDeg
  944. GradToDeg
  945. GradToRad
  946.  
  947. [EXAMPLE]
  948.  
  949. VAR
  950.   Grad : REAL;
  951.  
  952. BEGIN
  953.  
  954.   Grad := RadToGrad( 0.0    );  { Grad =   0.0000 }
  955.   Grad := RadToGrad( PI/6.0 );  { Grad =  33.3333 }
  956.   Grad := RadToGrad( PI*0.25);  { Grad =  50.0000 }
  957.   Grad := RadToGrad( PI*0.5 );  { Grad = 100.0000 }
  958.   Grad := RadToGrad( PI     );  { Grad = 200.0000 }
  959.   Grad := RadToGrad( 2.0*PI );  { Grad = 400.0000 }
  960.  
  961. END;
  962.  
  963. -*)
  964.  
  965. Function RadToGrad(          Rad       : REAL         ) : REAL;
  966.  
  967. BEGIN
  968.  
  969.   RadToGrad := Rad * 200/Pi;
  970.  
  971. END; { RadToGrad }
  972.  
  973. {────────────────────────────────────────────────────────────────────────────}
  974.  
  975. (*-
  976.  
  977. [FUNCTION]
  978.  
  979. Function GradToDeg(          Grad      : REAL         ) : REAL;
  980.  
  981. [PARAMETERS]
  982.  
  983. Grad        Angle in Gradients
  984.  
  985. [RETURNS]
  986.  
  987. Arc Degrees
  988.  
  989. [DESCRIPTION]
  990.  
  991. Converts Arc Gradients to Degrees
  992.  
  993. [SEE-ALSO]
  994.  
  995. DegToRad
  996. DegToGrad
  997. RadToDeg
  998. RadToGrad
  999. GradToRad
  1000.  
  1001. [EXAMPLE]
  1002.  
  1003. VAR
  1004.   Deg : REAL;
  1005.  
  1006. BEGIN
  1007.  
  1008.   Deg := GradToDeg(   0.0 );  { Deg =   0.0000 }
  1009.   Deg := GradToDeg(  30.0d);  { Deg =  30.0000 }
  1010.   Deg := GradToDeg(  50.0 );  { Deg =  45.0000 }
  1011.   Deg := GradToDeg( 100.0 );  { Deg =  90.0000 }
  1012.   Deg := GradToDeg( 200.0 );  { Deg = 180.0000 }
  1013.   Deg := GradToDeg( 400.0 );  { Deg = 360.0000 }
  1014.  
  1015. END;
  1016.  
  1017. -*)
  1018.  
  1019. Function GradToDeg(          Grad      : REAL         ) : REAL;
  1020.  
  1021. BEGIN
  1022.  
  1023.   GradToDeg := Grad * 0.9;
  1024.  
  1025. END; { GradToDeg }
  1026.  
  1027. {────────────────────────────────────────────────────────────────────────────}
  1028.  
  1029. (*-
  1030.  
  1031. [FUNCTION]
  1032.  
  1033. Function GradToRad(          Grad      : REAL         ) : REAL;
  1034.  
  1035. [PARAMETERS]
  1036.  
  1037. Grad        Angle in Gradients
  1038.  
  1039. [RETURNS]
  1040.  
  1041. Angle in Radians
  1042.  
  1043. [DESCRIPTION]
  1044.  
  1045. Converts Arc Gradients to Radians
  1046.  
  1047. [SEE-ALSO]
  1048.  
  1049. DegToRad
  1050. DegToGrad
  1051. RadToDeg
  1052. RadToGrad
  1053. GradToDeg
  1054.  
  1055. [EXAMPLE]
  1056.  
  1057. VAR
  1058.   Rad : REAL;
  1059.  
  1060. BEGIN
  1061.  
  1062.   Rad := GradToRad(   0.0000 );  { Rad = 0.0000 }
  1063.   Rad := GradToRad(  33.3333 );  { Rad = 0.5236 }
  1064.   Rad := GradToRad(  50.0000 );  { Rad = 0.7854 }
  1065.   Rad := GradToRad( 100.0000 );  { Rad = 1.5708 }
  1066.   Rad := GradToRad( 200.0000 );  { Rad = 3.1416 }
  1067.   Rad := GradToRad( 400.0000 );  { Rad = 6.2832 }
  1068.  
  1069. END;
  1070.  
  1071. -*)
  1072.  
  1073. Function GradToRad(          Grad      : REAL         ) : REAL;
  1074.  
  1075. BEGIN
  1076.  
  1077.   GradToRad := Grad * Pi/200;
  1078.  
  1079. END; { GradToRad }
  1080.  
  1081. {────────────────────────────────────────────────────────────────────────────}
  1082.  
  1083. (*-
  1084.  
  1085. [FUNCTION]
  1086.  
  1087. Function Quad(               Radians   : REAL         ) : INTEGER;
  1088.  
  1089. [PARAMETERS]
  1090.  
  1091. Radians     Angle in Radians
  1092.  
  1093. [RETURNS]
  1094.  
  1095. Quadrant in which the Radians is contained
  1096.  
  1097. [DESCRIPTION]
  1098.  
  1099. Determines which Quadrant is the Radian Angle falls in
  1100. There are 4 Quadrants as follows:
  1101.   Quadrant I   -   0 deg to  90 deg
  1102.   Quadrant II  -  91 deg to 180 deg
  1103.   Quadrant III - 181 deg to 270 deg
  1104.   Quadrant IV  - 271 deg to 359 deg
  1105.  
  1106. [SEE-ALSO]
  1107.  
  1108. Quad2
  1109.  
  1110. [EXAMPLE]
  1111.  
  1112. VAR
  1113.   Q : INTEGER;
  1114.  
  1115. BEGIN
  1116.  
  1117.   Q := Quad( DegToRad(   0.0 ) );  { Q = 1 }
  1118.   Q := Quad( DegToRad(  45.0 ) );  { Q = 1 }
  1119.   Q := Quad( DegToRad(  90.0 ) );  { Q = 1 }
  1120.   Q := Quad( DegToRad( 135.0 ) );  { Q = 2 }
  1121.   Q := Quad( DegToRad( 210.0 ) );  { Q = 3 }
  1122.   Q := Quad( DegToRad( 300.0 ) );  { Q = 4 }
  1123.  
  1124. END;
  1125.  
  1126. -*)
  1127.  
  1128. Function Quad(               Radians   : REAL         ) : INTEGER;
  1129.  
  1130. BEGIN
  1131.  
  1132.   While ( Radians > PI_4 ) Do
  1133.     Radians := Radians - PI_4;
  1134.  
  1135.   While ( Radians < 0.0 ) Do
  1136.     Radians := Radians + PI_4;
  1137.  
  1138.   If (Radians < PI_1) Then
  1139.     Quad := 1
  1140.   Else
  1141.   If (Radians < PI) Then
  1142.     Quad := 2
  1143.   Else
  1144.   If (Radians < PI_3) Then
  1145.     Quad := 3
  1146.   Else
  1147.     Quad := 4;
  1148.  
  1149. END;  { Quad }
  1150.  
  1151. {────────────────────────────────────────────────────────────────────────────}
  1152.  
  1153. (*-
  1154.  
  1155. [FUNCTION]
  1156.  
  1157. Function Quad2(              X, Y      : REAL         ) : INTEGER;
  1158.  
  1159. [PARAMETERS]
  1160.  
  1161. X           X Coordinate Value
  1162. Y           Y Coordinate Value
  1163.  
  1164. [RETURNS]
  1165.  
  1166. Returns the Quadrant corresponding to the X and Y Values.
  1167.  
  1168. [DESCRIPTION]
  1169.  
  1170. Determines which Quadrant corresponds to the Coordinate X,Y
  1171.  
  1172. [SEE-ALSO]
  1173.  
  1174. Quad
  1175.  
  1176. [EXAMPLE]
  1177.  
  1178. VAR
  1179.   Q : INTEGER;
  1180.  
  1181. BEGIN
  1182.  
  1183.   Q := Quad2(  1.0,  0.0 );  { Q = 1 }
  1184.   Q := Quad2(  1.0,  1.0 );  { Q = 1 }
  1185.   Q := Quad2(  0.0,  1.0 );  { Q = 1 }
  1186.   Q := Quad2( -1.0,  1.0 );  { Q = 2 }
  1187.   Q := Quad2( -1.0, -1.0 );  { Q = 3 }
  1188.   Q := Quad2(  1.0, -1.0 );  { Q = 4 }
  1189.  
  1190. END;
  1191.  
  1192. -*)
  1193.  
  1194. Function Quad2(              X, Y      : REAL         ) : INTEGER;
  1195.  
  1196. BEGIN
  1197.  
  1198.   If ( Y = Abs( Y ) ) Then   {+pos}
  1199.   BEGIN
  1200.  
  1201.     If ( X = Abs( X ) ) Then {+pos}
  1202.       Quad2 := 1
  1203.     Else
  1204.       Quad2 := 2;
  1205.  
  1206.   END
  1207.   Else
  1208.   BEGIN
  1209.  
  1210.     If ( X = Abs( X ) ) Then {+pos}
  1211.       Quad2 := 4
  1212.     Else
  1213.       Quad2 := 3;
  1214.  
  1215.   END;
  1216.  
  1217. END;  { Quad2 }
  1218.  
  1219. {────────────────────────────────────────────────────────────────────────────}
  1220.  
  1221. (*-
  1222.  
  1223. [FUNCTION]
  1224.  
  1225. Function Sin2(               X,Y       : REAL         ) : REAL;
  1226.  
  1227. [PARAMETERS]
  1228.  
  1229. X           X Coordinate Value
  1230. Y           Y Coordinate Value
  1231.  
  1232. [RETURNS]
  1233.  
  1234. Sine of the Angle created by Coordinate X,Y
  1235.  
  1236. [DESCRIPTION]
  1237.  
  1238. Determines and returns the Sine of the Angle computed from
  1239. the Coordinate X,Y
  1240.  
  1241. [SEE-ALSO]
  1242.  
  1243. Cos2   Sinh   ArcSin    ArcSinh
  1244. Tan    Cosh   ArcSin2   ArcCosh
  1245. Tan2   Tanh   ArcCos    ArcTanh
  1246. Cot           ArcCos2   ArcCsch
  1247. Cot2          ArcTan1   ArcSech
  1248. Csc           ArcTan2   ArcCoth
  1249. Sec           ArcCsc
  1250.               ArcSec
  1251.               ArcCot
  1252.  
  1253. [EXAMPLE]
  1254.  
  1255. VAR
  1256.   I : INTEGER;
  1257.  
  1258. BEGIN
  1259.  
  1260.   For i := 0 to 100 Do
  1261.     WriteLn( 'Sin2(1,',i,') = ',Sin2( 1.0, i ) :8:4 );
  1262.  
  1263. END;
  1264.  
  1265. -*)
  1266.  
  1267. Function Sin2(               X,Y       : REAL         ) : REAL;
  1268.  
  1269. BEGIN
  1270.  
  1271.   Sin2 := Y / ( Sqrt( Sqr(X) + Sqr(Y) ) );
  1272.  
  1273. END;  { Sin2 }
  1274.  
  1275. {────────────────────────────────────────────────────────────────────────────}
  1276.  
  1277. (*-
  1278.  
  1279. [FUNCTION]
  1280.  
  1281. Function Cos2(               X,Y       : REAL         ) : REAL;
  1282.  
  1283. [PARAMETERS]
  1284.  
  1285. X           X Coordinate Value
  1286. Y           Y Coordinate Value
  1287.  
  1288. [RETURNS]
  1289.  
  1290. CoSine of Angle created by Coordinate X,Y
  1291.  
  1292. [DESCRIPTION]
  1293.  
  1294. Determines and returns the CoSine of the Angle computed from
  1295. the Coordinate X,Y
  1296.  
  1297. [SEE-ALSO]
  1298.  
  1299. Sin2   Sinh   ArcSin    ArcSinh
  1300. Tan    Cosh   ArcSin2   ArcCosh
  1301. Tan2   Tanh   ArcCos    ArcTanh
  1302. Cot           ArcCos2   ArcCsch
  1303. Cot2          ArcTan1   ArcSech
  1304. Csc           ArcTan2   ArcCoth
  1305. Sec           ArcCsc
  1306.               ArcSec
  1307.               ArcCot
  1308.  
  1309. [EXAMPLE]
  1310.  
  1311. VAR
  1312.   I : INTEGER;
  1313.  
  1314. BEGIN
  1315.  
  1316.   For i := 0 to 100 Do
  1317.     WriteLn( 'Cos2(1,',i,') = ',Cos2( 1.0, i ) :8:4 );
  1318.  
  1319. END;
  1320.  
  1321. -*)
  1322.  
  1323. Function Cos2(               X,Y       : REAL         ) : REAL;
  1324.  
  1325. BEGIN
  1326.  
  1327.   Cos2 := X / ( Sqrt( Sqr(X) + Sqr(Y) ) );
  1328.  
  1329. END;  { Cos2 }
  1330.  
  1331. {────────────────────────────────────────────────────────────────────────────}
  1332.  
  1333. (*-
  1334.  
  1335. [FUNCTION]
  1336.  
  1337. Function Tan(                X         : REAL         ) : REAL;
  1338.  
  1339. [PARAMETERS]
  1340.  
  1341. X           Angle in Radians
  1342.  
  1343. [RETURNS]
  1344.  
  1345. Returns the Tangent of the Angle
  1346.  
  1347. [DESCRIPTION]
  1348.  
  1349. Computes and returns the Tangent of the given Angle.  Replaces
  1350. Std Pascal "Tan" as handles range checking and bounds.
  1351.  
  1352. [SEE-ALSO]
  1353.  
  1354. Sin2   Sinh   ArcSin    ArcSinh
  1355. Cos2   Cosh   ArcSin2   ArcCosh
  1356. Tan2   Tanh   ArcCos    ArcTanh
  1357. Cot           ArcCos2   ArcCsch
  1358. Cot2          ArcTan1   ArcSech
  1359. Csc           ArcTan2   ArcCoth
  1360. Sec           ArcCsc
  1361.               ArcSec
  1362.               ArcCot
  1363.  
  1364. [EXAMPLE]
  1365.  
  1366. VAR
  1367.   R : REAL;
  1368.   I : INTEGER;
  1369.  
  1370. BEGIN
  1371.  
  1372.   R := 0.0;
  1373.   For i := 0 to 100 Do
  1374.   BEGIN
  1375.  
  1376.     WriteLn( 'Tan(',R:0:0,') = ',Tan( R ) :8:4 );
  1377.     R := R + 1.0;
  1378.  
  1379.   END;  { For i }
  1380.  
  1381. END;
  1382.  
  1383. -*)
  1384.  
  1385. Function Tan(                X         : REAL         ) : REAL;
  1386.  
  1387. Var
  1388.  
  1389.   R2 : REAL;
  1390.  
  1391. BEGIN
  1392.  
  1393.   R2 := X;
  1394.  
  1395.   While ( R2 > PI_4 ) Do
  1396.     R2:= R2 - PI_4;
  1397.  
  1398.   While ( R2 < 0.0 ) Do
  1399.     R2 := R2 + PI_4;
  1400.  
  1401.   If ( Cos( R2 ) <  cTolerance ) And
  1402.      ( Cos( R2 ) > -cTolerance ) Then
  1403.     Tan := cINFINITY
  1404.   Else
  1405.     Tan := Sin( X ) / Cos( X );
  1406.  
  1407. END;  { Tan }
  1408.  
  1409. {────────────────────────────────────────────────────────────────────────────}
  1410.  
  1411. (*-
  1412.  
  1413. [FUNCTION]
  1414.  
  1415. Function Tan2(               X, Y      : REAL         ) : REAL;
  1416.  
  1417. [PARAMETERS]
  1418.  
  1419. X           X Coordinate Value
  1420. Y           Y Coordinate Value
  1421.  
  1422. [RETURNS]
  1423.  
  1424. Tangent of the Angle created by Coordinate X,Y
  1425.  
  1426. [DESCRIPTION]
  1427.  
  1428. Computes and returns the Tangent of the Angle computed from
  1429. the Coordinate X,Y
  1430.  
  1431. [SEE-ALSO]
  1432.  
  1433. Sin2   Sinh   ArcSin    ArcSinh
  1434. Cos2   Cosh   ArcSin2   ArcCosh
  1435. Tan    Tanh   ArcCos    ArcTanh
  1436. Cot           ArcCos2   ArcCsch
  1437. Cot2          ArcTan1   ArcSech
  1438. Csc           ArcTan2   ArcCoth
  1439. Sec           ArcCsc
  1440.               ArcSec
  1441.               ArcCot
  1442.  
  1443. [EXAMPLE]
  1444.  
  1445. VAR
  1446.   I : INTEGER;
  1447.  
  1448. BEGIN
  1449.  
  1450.   For i := 0 to 100 Do
  1451.     WriteLn( 'Tan2(1,',i,') = ',Tan2( 1.0, i ) :8:4 );
  1452.  
  1453. END;
  1454.  
  1455. -*)
  1456.  
  1457. Function Tan2(               X, Y      : REAL         ) : REAL;
  1458.  
  1459. BEGIN
  1460.  
  1461.   If ( X = 0.0 ) Then
  1462.   BEGIN
  1463.  
  1464.     CASE Quad2( Y, X ) OF
  1465.       1 : Tan2 :=  cINFINITY;
  1466.       2 : Tan2 := -cINFINITY;
  1467.       3 : Tan2 :=  cINFINITY;
  1468.       4 : Tan2 := -cINFINITY;
  1469.     END; {case quad}
  1470.  
  1471.   END
  1472.   Else
  1473.   BEGIN
  1474.  
  1475.     CASE Quad2( Y, X ) OF
  1476.       1 : Tan2 := Sin( Y / X ) / Cos( Y / X );
  1477.       2 : Tan2 := PI - Sin( Y / X ) / Cos( Y / X );
  1478.       3 : Tan2 := PI + Sin( Y / X ) / Cos( Y / X );
  1479.       4 : Tan2 := PI * 2.0 - Sin( Y / X ) / Cos( Y / X );
  1480.     END; {case quad}
  1481.  
  1482.   END;
  1483.  
  1484. END;  { Tan2 }
  1485.  
  1486. {────────────────────────────────────────────────────────────────────────────}
  1487.  
  1488. (*-
  1489.  
  1490. [FUNCTION]
  1491.  
  1492. Function Cot(                X         : REAL         ) : REAL;
  1493.  
  1494. [PARAMETERS]
  1495.  
  1496. X           Angle in Radians
  1497.  
  1498. [RETURNS]
  1499.  
  1500. CoTangent of the Angle
  1501.  
  1502. [DESCRIPTION]
  1503.  
  1504. Conputes and returns the CoTangent of a given Angle.
  1505.  
  1506. [SEE-ALSO]
  1507.  
  1508. Sin2   Sinh   ArcSin    ArcSinh
  1509. Cos2   Cosh   ArcSin2   ArcCosh
  1510. Tan    Tanh   ArcCos    ArcTanh
  1511. Tan2          ArcCos2   ArcCsch
  1512. Cot2          ArcTan1   ArcSech
  1513. Csc           ArcTan2   ArcCoth
  1514. Sec           ArcCsc
  1515.               ArcSec
  1516.               ArcCot
  1517.  
  1518. [EXAMPLE]
  1519.  
  1520. VAR
  1521.   I : INTEGER;
  1522.   R : REAL;
  1523.  
  1524. BEGIN
  1525.  
  1526.   R := 0.0;
  1527.   For i := 0 to 100 Do
  1528.   BEGIN
  1529.  
  1530.     WriteLn( 'Cot(',R:0:0,') = ',Cot( 1.0, i ) :8:4 );
  1531.     R := R + 1.0;
  1532.  
  1533.   END;  { For i }
  1534.  
  1535. END;
  1536.  
  1537. -*)
  1538.  
  1539. Function Cot(                X         : REAL         ) : REAL;
  1540.  
  1541. Var
  1542.  
  1543.   R2 : REAL;
  1544.  
  1545. BEGIN
  1546.  
  1547.   R2 := X;
  1548.  
  1549.   While ( R2 > PI_4 ) Do
  1550.     R2 := R2 - PI_4;
  1551.  
  1552.   While ( R2 < 0.0 ) Do
  1553.     R2 := R2 + PI_4;
  1554.  
  1555.   If ( Sin( R2 ) <  cTolerance ) And
  1556.      ( Sin( R2 ) > -cTolerance ) Then
  1557.     Cot := cINFINITY
  1558.   Else
  1559.     Cot := Cos( X ) / Sin( X );
  1560.  
  1561. END;  { Cot }
  1562.  
  1563. {────────────────────────────────────────────────────────────────────────────}
  1564.  
  1565. (*-
  1566.  
  1567. [FUNCTION]
  1568.  
  1569. Function Cot2(               X, Y      : REAL         ) : REAL;
  1570.  
  1571. [PARAMETERS]
  1572.  
  1573. X           X Coordinate Value
  1574. Y           Y Coordinate Value
  1575.  
  1576. [RETURNS]
  1577.  
  1578. CoTangent of Angle computed from Coordinate X,Y
  1579.  
  1580. [DESCRIPTION]
  1581.  
  1582. Computes and returns the CoTangent of an Angle computed from
  1583. the  Coordinate X,Y
  1584.  
  1585. [SEE-ALSO]
  1586.  
  1587. Sin2   Sinh   ArcSin    ArcSinh
  1588. Cos2   Cosh   ArcSin2   ArcCosh
  1589. Tan    Tanh   ArcCos    ArcTanh
  1590. Tan2          ArcCos2   ArcCsch
  1591. Cot           ArcTan1   ArcSech
  1592. Csc           ArcTan2   ArcCoth
  1593. Sec           ArcCsc
  1594.               ArcSec
  1595.               ArcCot
  1596.  
  1597. [EXAMPLE]
  1598.  
  1599. VAR
  1600.   I : INTEGER;
  1601.  
  1602. BEGIN
  1603.  
  1604.   For i := 0 to 100 Do
  1605.     WriteLn( 'Cot2(1,',i,') = ',Cot2( 1.0, i ) :8:4 );
  1606.  
  1607. END;
  1608.  
  1609. -*)
  1610.  
  1611. Function Cot2(               X, Y      : REAL         ) : REAL;
  1612.  
  1613. BEGIN
  1614.  
  1615.   If ( X <> 0.0 ) Then
  1616.     Cot2 := Cos( Y / X ) / Sin( Y / X )
  1617.   Else
  1618.     Cot2 := cINFINITY
  1619.  
  1620. END;  { Cot2 }
  1621.  
  1622. {────────────────────────────────────────────────────────────────────────────}
  1623.  
  1624. (*-
  1625.  
  1626. [FUNCTION]
  1627.  
  1628. Function Csc(                X         : REAL         ) : REAL;
  1629.  
  1630. [PARAMETERS]
  1631.  
  1632. X           Angle in Radians
  1633.  
  1634. [RETURNS]
  1635.  
  1636. CoSecant of Angle
  1637.  
  1638. [DESCRIPTION]
  1639.  
  1640. Computes and returns the CoSecant of a given Angle
  1641.  
  1642. [SEE-ALSO]
  1643.  
  1644. Sin2   Sinh   ArcSin    ArcSinh
  1645. Cos2   Cosh   ArcSin2   ArcCosh
  1646. Tan    Tanh   ArcCos    ArcTanh
  1647. Tan2          ArcCos2   ArcCsch
  1648. Cot           ArcTan1   ArcSech
  1649. Cot2          ArcTan2   ArcCoth
  1650. Sec           ArcCsc
  1651.               ArcSec
  1652.               ArcCot
  1653.  
  1654. [EXAMPLE]
  1655.  
  1656. VAR
  1657.   I : INTEGER;
  1658.   R : REAL;
  1659.  
  1660. BEGIN
  1661.  
  1662.   R := 0.0;
  1663.   For i := 0 to 100 Do
  1664.   BEGIN
  1665.  
  1666.     WriteLn( 'Csc(',R:0:0,') = ',Csc( R ) :8:4 );
  1667.     R := R + 1.0;
  1668.  
  1669.   END;  { For i }
  1670.  
  1671. END;
  1672.  
  1673. -*)
  1674.  
  1675. Function Csc(                X         : REAL         ) : REAL;
  1676.  
  1677. Var
  1678.  
  1679.   R2  : REAL;
  1680.  
  1681. BEGIN
  1682.  
  1683.   R2 := X;
  1684.  
  1685.   While ( R2 > PI_4 ) Do
  1686.     R2 := R2 - PI_4;
  1687.  
  1688.   While ( R2 < 0.0 ) Do
  1689.     R2 := R2 + PI_4;
  1690.  
  1691.   If ( Sin( R2 ) <  cTolerance ) And
  1692.      ( Sin( R2 ) > -cTolerance ) Then
  1693.     Csc := cINFINITY
  1694.   Else
  1695.     Csc := 1.0 / Sin( X );
  1696.  
  1697. END;  { Csc }
  1698.  
  1699. {────────────────────────────────────────────────────────────────────────────}
  1700.  
  1701. (*-
  1702.  
  1703. [FUNCTION]
  1704.  
  1705. Function Sec(                X         : REAL         ) : REAL;
  1706.  
  1707. [PARAMETERS]
  1708.  
  1709. X           Angle in Radians
  1710.  
  1711. [RETURNS]
  1712.  
  1713. Secant of Angle
  1714.  
  1715. [DESCRIPTION]
  1716.  
  1717. Computes and returns the Secant of a given Angle
  1718.  
  1719. [SEE-ALSO]
  1720.  
  1721. Sin2   Sinh   ArcSin    ArcSinh
  1722. Cos2   Cosh   ArcSin2   ArcCosh
  1723. Tan    Tanh   ArcCos    ArcTanh
  1724. Tan2          ArcCos2   ArcCsch
  1725. Cot           ArcTan1   ArcSech
  1726. Cot2          ArcTan2   ArcCoth
  1727. Csc           ArcCsc
  1728.               ArcSec
  1729.               ArcCot
  1730.  
  1731. [EXAMPLE]
  1732.  
  1733.  
  1734. VAR
  1735.   I : INTEGER;
  1736.   R : REAL;
  1737.  
  1738. BEGIN
  1739.  
  1740.   R := 0.0;
  1741.   For i := 0 to 100 Do
  1742.   BEGIN
  1743.  
  1744.     WriteLn( 'Sec(',R:0:0,') = ',Sec( R ) :8:4 );
  1745.     R := R + 1.0;
  1746.  
  1747.   END;  { For i }
  1748.  
  1749. END;
  1750.  
  1751. -*)
  1752.  
  1753. Function Sec(                X         : REAL         ) : REAL;
  1754.  
  1755. Var
  1756.  
  1757.   R2 : REAL;
  1758.  
  1759. BEGIN
  1760.  
  1761.   R2 := X;
  1762.  
  1763.   While ( R2 > PI_4 ) Do
  1764.     R2 := R2 - PI_4;
  1765.  
  1766.   While ( R2 < 0.0 ) Do
  1767.     R2 := R2 + PI_4;
  1768.  
  1769.   If ( Cos( R2 ) <  cTolerance ) And
  1770.      ( Cos( R2 ) > -cTolerance ) Then
  1771.     Sec := cINFINITY
  1772.   Else
  1773.     Sec := 1.0 / Cos( X );
  1774.  
  1775. END;  { Sec }
  1776.  
  1777. {────────────────────────────────────────────────────────────────────────────}
  1778.  
  1779. (*-
  1780.  
  1781. [FUNCTION]
  1782.  
  1783. Function Sinh(               X         : REAL         ) : REAL;  {NOT TESTED}
  1784.  
  1785. [PARAMETERS]
  1786.  
  1787. X           Angle in Radians
  1788.  
  1789. [RETURNS]
  1790.  
  1791. Hyperbolic Sine of Angle
  1792.  
  1793. [DESCRIPTION]
  1794.  
  1795. Computes and returns the Hyperbolic Sine of a given Angle
  1796.  
  1797. [SEE-ALSO]
  1798.  
  1799. Sin2   Cosh   ArcSin    ArcSinh
  1800. Cos2   Tanh   ArcSin2   ArcCosh
  1801. Tan           ArcCos    ArcTanh
  1802. Tan2          ArcCos2   ArcCsch
  1803. Cot           ArcTan1   ArcSech
  1804. Cot2          ArcTan2   ArcCoth
  1805. Csc           ArcCsc
  1806. Sec           ArcSec
  1807.               ArcCot
  1808.  
  1809. [EXAMPLE]
  1810.  
  1811. VAR
  1812.   I : INTEGER;
  1813.   R : REAL;
  1814.  
  1815. BEGIN
  1816.  
  1817.   R := 0.0;
  1818.   For i := 0 to 100 Do
  1819.   BEGIN
  1820.  
  1821.     WriteLn( 'Sinh(',R:0:0,') = ',Sinh( R ) :8:4 );
  1822.     R := R + 1.0;
  1823.  
  1824.   END;  { For i }
  1825.  
  1826. END;
  1827.  
  1828. -*)
  1829.  
  1830. Function Sinh(               X         : REAL         ) : REAL;
  1831.  
  1832. BEGIN
  1833.  
  1834.   Sinh := ( Exp(X) - Exp(-X) ) / 2;
  1835.  
  1836. END;  { Sinh }
  1837.  
  1838. {────────────────────────────────────────────────────────────────────────────}
  1839.  
  1840. (*-
  1841.  
  1842. [FUNCTION]
  1843.  
  1844. Function Cosh(               X         : REAL         ) : REAL;
  1845.  
  1846. [PARAMETERS]
  1847.  
  1848. X           Angle in Radians
  1849.  
  1850. [RETURNS]
  1851.  
  1852. Hyperbolic CoSine of Angle
  1853.  
  1854. [DESCRIPTION]
  1855.  
  1856. Computes and returns the Hyperbolic CoSine of a given Angle
  1857.  
  1858. [SEE-ALSO]
  1859.  
  1860. Sin2   Sinh   ArcSin    ArcSinh
  1861. Cos2   Tanh   ArcSin2   ArcCosh
  1862. Tan           ArcCos    ArcTanh
  1863. Tan2          ArcCos2   ArcCsch
  1864. Cot           ArcTan1   ArcSech
  1865. Cot2          ArcTan2   ArcCoth
  1866. Csc           ArcCsc
  1867. Sec           ArcSec
  1868.               ArcCot
  1869.  
  1870. [EXAMPLE]
  1871.  
  1872. VAR
  1873.   I : INTEGER;
  1874.   R : REAL;
  1875.  
  1876. BEGIN
  1877.  
  1878.   R := 0.0;
  1879.   For i := 0 to 100 Do
  1880.   BEGIN
  1881.  
  1882.     WriteLn( 'Cosh(',R:0:0,') = ',Cosh( R ) :8:4 );
  1883.     R := R + 1.0;
  1884.  
  1885.   END;  { For i }
  1886.  
  1887. END;
  1888.  
  1889. -*)
  1890.  
  1891. Function Cosh(               X         : REAL         ) : REAL;
  1892.  
  1893. BEGIN
  1894.  
  1895.   Cosh := ( Exp(X) + Exp(-X) ) / 2;
  1896.  
  1897. END;  { Cosh }
  1898.  
  1899. {────────────────────────────────────────────────────────────────────────────}
  1900.  
  1901. (*-
  1902.  
  1903. [FUNCTION]
  1904.  
  1905. Function Tanh(               X         : REAL         ) : REAL;
  1906.  
  1907. [PARAMETERS]
  1908.  
  1909. X           Angle in Radians
  1910.  
  1911. [RETURNS]
  1912.  
  1913. Hyperbolic Tangent of Angle
  1914.  
  1915. [DESCRIPTION]
  1916.  
  1917. Computes and returns the Hyperbolic Tangent of a given Angle
  1918.  
  1919. [SEE-ALSO]
  1920.  
  1921. Sin2   Sinh   ArcSin    ArcSinh
  1922. Cos2   Cosh   ArcSin2   ArcCosh
  1923. Tan           ArcCos    ArcTanh
  1924. Tan2          ArcCos2   ArcCsch
  1925. Cot           ArcTan1   ArcSech
  1926. Cot2          ArcTan2   ArcCoth
  1927. Csc           ArcCsc
  1928. Sec           ArcSec
  1929.               ArcCot
  1930.  
  1931. [EXAMPLE]
  1932.  
  1933. VAR
  1934.   I : INTEGER;
  1935.   R : REAL;
  1936.  
  1937. BEGIN
  1938.  
  1939.   R := 0.0;
  1940.   For i := 0 to 100 Do
  1941.   BEGIN
  1942.  
  1943.     WriteLn( 'Tanh(',R:0:0,') = ',Tanh( R ) :8:4 );
  1944.     R := R + 1.0;
  1945.  
  1946.   END;  { For i }
  1947.  
  1948. END;
  1949.  
  1950. -*)
  1951.  
  1952. Function Tanh(               X         : REAL         ) : REAL;
  1953.  
  1954. Var
  1955.  
  1956.   Q : REAL;
  1957.  
  1958. BEGIN
  1959.  
  1960.   Q := Exp(X) + Exp(-X);
  1961.  
  1962.   If ( Q <> 0.0 ) Then
  1963.     Tanh := ( Exp( X ) - Exp( -X ) ) / Q
  1964.   Else
  1965.     Tanh := cINFINITY;
  1966.  
  1967. END;  { Tanh }
  1968.  
  1969. {────────────────────────────────────────────────────────────────────────────}
  1970.  
  1971. (*-
  1972.  
  1973. [FUNCTION]
  1974.  
  1975. Function Csch(               X         : REAL         ) : REAL;  {NOT TESTED}
  1976.  
  1977. [PARAMETERS]
  1978.  
  1979. X           Angle in Radians
  1980.  
  1981. [RETURNS]
  1982.  
  1983. Hyperbolic Cosecant of Angle
  1984.  
  1985. [DESCRIPTION]
  1986.  
  1987. Computes and returns the Hyperbolic Cosecant of a given Angle
  1988.  
  1989. [SEE-ALSO]
  1990.  
  1991. Sin2   Cosh   ArcSin    ArcSinh
  1992. Cos2   Tanh   ArcSin2   ArcCosh
  1993. Tan           ArcCos    ArcTanh
  1994. Tan2          ArcCos2   ArcCsch
  1995. Cot           ArcTan1   ArcSech
  1996. Cot2          ArcTan2   ArcCoth
  1997. Csc           ArcCsc
  1998. Sec           ArcSec
  1999.               ArcCot
  2000.  
  2001. [EXAMPLE]
  2002.  
  2003. VAR
  2004.   I : INTEGER;
  2005.   R : REAL;
  2006.  
  2007. BEGIN
  2008.  
  2009.   R := 0.0;
  2010.   For i := 0 to 100 Do
  2011.   BEGIN
  2012.  
  2013.     WriteLn( 'Csch(',R:0:0,') = ',Csch( R ) :8:4 );
  2014.     R := R + 1.0;
  2015.  
  2016.   END;  { For i }
  2017.  
  2018. END;
  2019.  
  2020. -*)
  2021.  
  2022. Function Csch(               X         : REAL         ) : REAL;
  2023.  
  2024. BEGIN
  2025.  
  2026.   If X <> 0 Then
  2027.     Csch := 1 / Sinh( X );
  2028.  
  2029. END;  { Csch }
  2030.  
  2031. {────────────────────────────────────────────────────────────────────────────}
  2032.  
  2033. (*-
  2034.  
  2035. [FUNCTION]
  2036.  
  2037. Function Sech(                X         : REAL         ) : REAL;
  2038.  
  2039. [PARAMETERS]
  2040.  
  2041. X           Angle in Radians
  2042.  
  2043. [RETURNS]
  2044.  
  2045. Hyperbolic Secant of Angle
  2046.  
  2047. [DESCRIPTION]
  2048.  
  2049. Computes and returns the Hyperbolic Secant of a given Angle
  2050.  
  2051. [SEE-ALSO]
  2052.  
  2053. Sin2   Sinh   ArcSin    ArcSinh
  2054. Cos2   Tanh   ArcSin2   ArcCosh
  2055. Tan           ArcCos    ArcTanh
  2056. Tan2          ArcCos2   ArcCsch
  2057. Cot           ArcTan1   ArcSech
  2058. Cot2          ArcTan2   ArcCoth
  2059. Csc           ArcCsc
  2060. Sec           ArcSec
  2061.               ArcCot
  2062.  
  2063. [EXAMPLE]
  2064.  
  2065. VAR
  2066.   I : INTEGER;
  2067.   R : REAL;
  2068.  
  2069. BEGIN
  2070.  
  2071.   R := 0.0;
  2072.   For i := 0 to 100 Do
  2073.   BEGIN
  2074.  
  2075.     WriteLn( 'Sech(',R:0:0,') = ',Sech( R ) :8:4 );
  2076.     R := R + 1.0;
  2077.  
  2078.   END;  { For i }
  2079.  
  2080. END;
  2081.  
  2082. -*)
  2083.  
  2084. Function Sech(               X         : REAL         ) : REAL;
  2085.  
  2086. BEGIN
  2087.  
  2088.   Sech := 1 / Cosh( X );
  2089.  
  2090. END;  { Sech }
  2091.  
  2092. {────────────────────────────────────────────────────────────────────────────}
  2093.  
  2094. (*-
  2095.  
  2096. [FUNCTION]
  2097.  
  2098. Function Coth(               X         : REAL         ) : REAL;
  2099.  
  2100. [PARAMETERS]
  2101.  
  2102. X           Angle in Radians
  2103.  
  2104. [RETURNS]
  2105.  
  2106. Hyperbolic Cotangent of Angle
  2107.  
  2108. [DESCRIPTION]
  2109.  
  2110. Computes and returns the Hyperbolic Cotangent of a given Angle
  2111.  
  2112. [SEE-ALSO]
  2113.  
  2114. Sin2   Sinh   ArcSin    ArcSinh
  2115. Cos2   Cosh   ArcSin2   ArcCosh
  2116. Tan           ArcCos    ArcTanh
  2117. Tan2          ArcCos2   ArcCsch
  2118. Cot           ArcTan1   ArcSech
  2119. Cot2          ArcTan2   ArcCoth
  2120. Csc           ArcCsc
  2121. Sec           ArcSec
  2122.               ArcCot
  2123.  
  2124. [EXAMPLE]
  2125.  
  2126. VAR
  2127.   I : INTEGER;
  2128.   R : REAL;
  2129.  
  2130. BEGIN
  2131.  
  2132.   R := 0.0;
  2133.   For i := 0 to 100 Do
  2134.   BEGIN
  2135.  
  2136.     WriteLn( 'Coth(',R:0:0,') = ',Coth( R ) :8:4 );
  2137.     R := R + 1.0;
  2138.  
  2139.   END;  { For i }
  2140.  
  2141. END;
  2142.  
  2143. -*)
  2144.  
  2145. Function Coth(               X         : REAL         ) : REAL;
  2146.  
  2147. BEGIN
  2148.  
  2149.   If X <> 0 Then
  2150.     Coth := 1 / Tanh( X );
  2151.  
  2152. END;  { Coth }
  2153.  
  2154. {────────────────────────────────────────────────────────────────────────────}
  2155.  
  2156. (*-
  2157.  
  2158. [FUNCTION]
  2159.  
  2160. Function ArcSin(             X     : REAL         ) : REAL;
  2161.  
  2162. [PARAMETERS]
  2163.  
  2164. X       Sine Value
  2165.  
  2166. [RETURNS]
  2167.  
  2168. Angle in radians whose sine is X.
  2169.  
  2170. [DESCRIPTION]
  2171.  
  2172. Computes and returns the Inverse sine of a given value.
  2173. Positive sine values are assumed quadrant 1 and negative sine
  2174. values are assumed as quadrant 4 as there is no means to
  2175. compute an absolute angle based on the simple sine value.
  2176.  
  2177. NOTE: Sine Value is NOT Range Checked and MUST be in Bounds.
  2178.  
  2179. [SEE-ALSO]
  2180.  
  2181. Sin2   Sinh   ArcSin2   ArcSinh
  2182. Cos2   Cosh   ArcCos    ArcCosh
  2183. Tan    Tanh   ArcCos2   ArcTanh
  2184. Tan2          ArcTan1   ArcCsch
  2185. Cot           ArcTan2   ArcSech
  2186. Cot2          ArcCsc    ArcCoth
  2187. Csc           ArcSec
  2188. Sec           ArcCot
  2189.  
  2190. [EXAMPLE]
  2191.  
  2192. VAR
  2193.   I : INTEGER;
  2194.   R : REAL;
  2195.  
  2196. BEGIN
  2197.  
  2198.   R := 1.0;
  2199.   For i := 100 DownTo 0 Do
  2200.   BEGIN
  2201.  
  2202.     WriteLn( 'ArcSin(',R:0:0,') = ',ArcSin( R ) :8:4 );
  2203.     R := R - 0.01;
  2204.  
  2205.   END;  { For i }
  2206.  
  2207. END;
  2208.  
  2209. -*)
  2210.  
  2211. Function ArcSin(             X     : REAL         ) : REAL;
  2212.  
  2213. BEGIN
  2214.  
  2215.   If (X >= -1) AND (X <= 1) Then
  2216.     ArcSin := ArcTan( X / ( Sqrt( 1.0 - Sqr( X ) ) ) );
  2217.  
  2218. END;  { ArcSin }
  2219.  
  2220. {────────────────────────────────────────────────────────────────────────────}
  2221.  
  2222. (*-
  2223.  
  2224. [FUNCTION]
  2225.  
  2226. Function ArcSin2(            X     : REAL;
  2227.                              Quadrant  : INTEGER      ) : REAL;
  2228.  
  2229. [PARAMETERS]
  2230.  
  2231. X       Sine Value
  2232. Quadrant    Angular Quadrant Containing Sine Value
  2233.  
  2234. [RETURNS]
  2235.  
  2236. Arc Sine Angle of Sine X in Radians.
  2237.  
  2238. [DESCRIPTION]
  2239.  
  2240. Computes and returns the Arc Sine of a given Sine Value.
  2241. Using the input Quadrant, the Correct Absolute Sine Angle
  2242. is determined.
  2243.  
  2244. NOTE: Sine Value is NOT Range Checked and MUST be in Bounds.
  2245.  
  2246. [SEE-ALSO]
  2247.  
  2248. Sin2   Sinh   ArcSin    ArcSinh
  2249. Cos2   Cosh   ArcCos    ArcCosh
  2250. Tan    Tanh   ArcCos2   ArcTanh
  2251. Tan2          ArcTan1   ArcCsch
  2252. Cot           ArcTan2   ArcSech
  2253. Cot2          ArcCsc    ArcCoth
  2254. Csc           ArcSec
  2255. Sec           ArcCot
  2256.  
  2257. [EXAMPLE]
  2258.  
  2259. VAR
  2260.   I : INTEGER;
  2261.   R : REAL;
  2262.  
  2263. BEGIN
  2264.  
  2265.   R := 1.0;
  2266.   For i := 100 DownTo 0 Do
  2267.   BEGIN
  2268.  
  2269.     WriteLn( 'ArcSin2(',R:0:0,') [Quad=3] = ',ArcSin2( R, 3 ) :8:4 );
  2270.     R := R - 0.01;
  2271.  
  2272.   END;  { For i }
  2273.  
  2274. END;
  2275.  
  2276. -*)
  2277.  
  2278. Function ArcSin2(            X     : REAL;
  2279.                              Quadrant  : INTEGER      ) : REAL;
  2280.  
  2281. BEGIN
  2282.  
  2283.   CASE Quadrant OF
  2284.     1 : ArcSin2 := ArcTan( X / ( Sqrt( 1.0 - Sqr( X ) ) ) );
  2285.     2 : ArcSin2 := PI_2 - ArcTan( X / ( Sqrt( 1.0 - Sqr( X ) ) ) );
  2286.     3 : ArcSin2 := PI_2 - ArcTan( X / ( Sqrt( 1.0 - Sqr( X ) ) ) );
  2287.     4 : ArcSin2 := PI_4 - ArcTan( X / ( Sqrt( 1.0 - Sqr( X ) ) ) );
  2288.   END;
  2289.  
  2290. END;  { ArcSin2 }
  2291.  
  2292. {────────────────────────────────────────────────────────────────────────────}
  2293.  
  2294. (*-
  2295.  
  2296. [FUNCTION]
  2297.  
  2298. Function ArcCos(             X     : REAL         ) : REAL;
  2299.  
  2300. [PARAMETERS]
  2301.  
  2302. X       CoSine Value
  2303.  
  2304. [RETURNS]
  2305.  
  2306. Inverse cosine angle in radians.
  2307.  
  2308. [DESCRIPTION]
  2309.  
  2310. Computes and returns the Arc CoSine of a given CoSine Value.
  2311. Positive CoSine Values are assumed Quadrant 1 and negative
  2312. CoSine Values are assumed Quadrant 2 as there is no means to
  2313. compute Absolute Angle based upon Simple CoSine Value.
  2314.  
  2315. [SEE-ALSO]
  2316.  
  2317. Sin2   Sinh   ArcSin    ArcSinh
  2318. Cos2   Cosh   ArcSin2   ArcCosh
  2319. Tan    Tanh   ArcCos2   ArcTanh
  2320. Tan2          ArcTan1   ArcCsch
  2321. Cot           ArcTan2   ArcSech
  2322. Cot2          ArcCsc    ArcCoth
  2323. Csc           ArcSec
  2324. Sec           ArcCot
  2325.  
  2326. [EXAMPLE]
  2327.  
  2328. VAR
  2329.   I : INTEGER;
  2330.   R : REAL;
  2331.  
  2332. BEGIN
  2333.  
  2334.   R := 1.0;
  2335.   For i := 100 DownTo 0 Do
  2336.   BEGIN
  2337.  
  2338.     WriteLn( 'ArcCos(',R:0:0,') = ',ArcCos( R ) :8:4 );
  2339.     R := R - 0.01;
  2340.  
  2341.   END;  { For i }
  2342.  
  2343. END;
  2344.  
  2345. -*)
  2346.  
  2347. Function ArcCos(             X     : REAL         ) : REAL;
  2348.  
  2349. BEGIN
  2350.  
  2351.   If (X >= -1) AND (X <= 1) Then
  2352.     ArcCos := ArcTan( Sqrt(1.0 - Sqr(X)) / X );
  2353.  
  2354. END;  { ArcCos }
  2355.  
  2356. {────────────────────────────────────────────────────────────────────────────}
  2357.  
  2358. (*-
  2359.  
  2360. [FUNCTION]
  2361.  
  2362. Function ArcCos2(            X     : REAL;
  2363.                              Quadrant  : INTEGER      ) : REAL;
  2364.  
  2365. [PARAMETERS]
  2366.  
  2367. X       CoSine Value
  2368. Quadrant    Angular Quadrant Containing CoSine Value
  2369.  
  2370. [RETURNS]
  2371.  
  2372. Arc CoSine Angle of CoSine Value
  2373.  
  2374. [DESCRIPTION]
  2375.  
  2376. Computes and returns the Arc CoSine of a given CoSine Value.
  2377. Using the input Quadrant, the Correct Absolute CoSine Angle
  2378. is determined.
  2379.  
  2380. NOTE: Cosine Value is NOT Range Checked and MUST be in Bounds.
  2381.  
  2382. [SEE-ALSO]
  2383.  
  2384. Sin2   Sinh   ArcSin    ArcSinh
  2385. Cos2   Cosh   ArcSin2   ArcCosh
  2386. Tan    Tanh   ArcCos    ArcTanh
  2387. Tan2          ArcTan1   ArcCsch
  2388. Cot           ArcTan2   ArcSech
  2389. Cot2          ArcCsc    ArcCoth
  2390. Csc           ArcSec
  2391. Sec           ArcCot
  2392.  
  2393. [EXAMPLE]
  2394.  
  2395. VAR
  2396.   I : INTEGER;
  2397.   R : REAL;
  2398.  
  2399. BEGIN
  2400.  
  2401.   R := 1.0;
  2402.   For i := 100 DownTo 0 Do
  2403.   BEGIN
  2404.  
  2405.     WriteLn( 'ArcCos2(',R:0:0,') [Quad=3] = ',ArcCos2( R,3 ) :8:4 );
  2406.     R := R - 0.01;
  2407.  
  2408.   END;  { For i }
  2409.  
  2410. END;
  2411.  
  2412. -*)
  2413.  
  2414. Function ArcCos2(            X     : REAL;
  2415.                              Quadrant  : INTEGER      ) : REAL;
  2416.  
  2417.                                        {ROUNDING ERROR AT BOTTOM}
  2418.                                        { 2)  0- 90 DN TO  0 AS +90 }
  2419.                                        {    90-180 DN TO -1 AS 180 }
  2420.                                        {   180-270 UP     0 AS +90 }
  2421.                                        {   270-360 UP TO  0 AS   0 }
  2422.  
  2423. BEGIN
  2424.  
  2425.   CASE Quadrant OF
  2426.     1 : ArcCos2 := ArcTan( ( Sqrt( 1.0 - Sqr( X ) ) ) / X );
  2427.     2 : ArcCos2 := ArcTan( ( Sqrt( 1.0 - Sqr( X ) ) ) / X );
  2428.     3 : ArcCos2 := PI_4 - ArcTan( ( Sqrt( 1.0 - Sqr( X ) ) ) / X );
  2429.     4 : ArcCos2 := PI_4 - ArcTan( ( Sqrt( 1.0 - Sqr( X ) ) ) / X );
  2430.   END;
  2431.  
  2432. END;  { ArcCos2 }
  2433.  
  2434. {────────────────────────────────────────────────────────────────────────────}
  2435.  
  2436. (*-
  2437.  
  2438. [FUNCTION]
  2439.  
  2440. Function ArcTan1(            X     : REAL         ) : REAL;
  2441.  
  2442. [PARAMETERS]
  2443.  
  2444. X       Tangent Value
  2445.  
  2446. [RETURNS]
  2447.  
  2448. Arc Tangent Angle of Tangent X
  2449.  
  2450. [DESCRIPTION]
  2451.  
  2452. Computes and returns the Arc Tangent of a given Tangent Value.
  2453. Positive Tangent Values are assumed Quadrant 1 and negative
  2454. Tangent Values are assumed Quadrant 4 as there is no means to
  2455. compute Absolute Angle based upon Simple Tangent Value.
  2456.  
  2457. NOTE: Limiting Tangent Range is based upon the Constant cINFINITY.
  2458. Anything exceeds this in either direction is considered 90 degrees.
  2459.  
  2460. [SEE-ALSO]
  2461.  
  2462. Sin2   Sinh   ArcSin    ArcSinh
  2463. Cos2   Cosh   ArcSin2   ArcCosh
  2464. Tan    Tanh   ArcCos    ArcTanh
  2465. Tan2          ArcCos2   ArcCsch
  2466. Cot           ArcTan2   ArcSech
  2467. Cot2          ArcCsc    ArcCoth
  2468. Csc           ArcSec
  2469. Sec           ArcCot
  2470.  
  2471. [EXAMPLE]
  2472.  
  2473. VAR
  2474.   I : INTEGER;
  2475.   R : REAL;
  2476.  
  2477. BEGIN
  2478.  
  2479.   R := 1.0;
  2480.   For i := 100 DownTo 0 Do
  2481.   BEGIN
  2482.  
  2483.     WriteLn( 'ArcTan1(',R:0:0,') = ',ArcTan1( R ) :8:4 );
  2484.     R := R - 0.01;
  2485.  
  2486.   END;  { For i }
  2487.  
  2488. END;
  2489.  
  2490. -*)
  2491.  
  2492. Function ArcTan1(            X     : REAL         ) : REAL;
  2493.  
  2494. Var
  2495.  
  2496.   R2,
  2497.   AT   : REAL;
  2498.  
  2499. BEGIN
  2500.  
  2501.   R2 := X;
  2502.  
  2503.   If ( X >= cINFINITY ) Then
  2504.     AT := PI_1
  2505.   Else
  2506.   If ( X >= 0.0 ) Then
  2507.     AT := ArcTan( X )
  2508.   Else
  2509.     AT := PI + ArcTan( X );
  2510.  
  2511.   ArcTan1 := AT;
  2512.  
  2513. END;  { ArcTan1 }
  2514.  
  2515. {────────────────────────────────────────────────────────────────────────────}
  2516.  
  2517. (*-
  2518.  
  2519. [FUNCTION]
  2520.  
  2521. Function ArcTan2(            X, Y      : REAL         ) : REAL;
  2522.  
  2523. [PARAMETERS]
  2524.  
  2525. X           X Coordinate Value
  2526. Y           Y Coordinate Value
  2527.  
  2528. [RETURNS]
  2529.  
  2530. Arc Tangent Angle computed from Coordinate X,Y
  2531.  
  2532. [DESCRIPTION]
  2533.  
  2534. Determines and returns the ArcTangent Angle of a given Tangent
  2535. Value computed from the Coordinate X,Y
  2536.  
  2537.  
  2538. Borland Pascal has a problem with an Angle in the 4th Quadrant
  2539. when the argument becomes negative.  The Negative argument table
  2540. has not been uniformly prepared.  This function handles that
  2541. problem.
  2542.  
  2543. [SEE-ALSO]
  2544.  
  2545. Sin2   Sinh   ArcSin    ArcSinh
  2546. Cos2   Cosh   ArcSin2   ArcCosh
  2547. Tan    Tanh   ArcCos    ArcTanh
  2548. Tan2          ArcCos2   ArcCsch
  2549. Cot           ArcTan1   ArcSech
  2550. Cot2          ArcCsc    ArcCoth
  2551. Csc           ArcSec
  2552. Sec           ArcCot
  2553.  
  2554. [EXAMPLE]
  2555.  
  2556. VAR
  2557.   I : INTEGER;
  2558.  
  2559. BEGIN
  2560.  
  2561.   For i := 100 DownTo 0 Do
  2562.     WriteLn( 'ArcTan2(1,',i,') = ',ArcTan2( 1, i ) :8:4 );
  2563.  
  2564. END;
  2565.  
  2566. -*)
  2567.  
  2568. Function ArcTan2(            X, Y      : REAL         ) : REAL;
  2569.  
  2570. Var
  2571.  
  2572.   AT   : REAL;
  2573.  
  2574. BEGIN
  2575.  
  2576.   If ( X = 0.0 ) Then
  2577.   BEGIN
  2578.  
  2579.     CASE Quad2( X, Y ) OF
  2580.       1 : AT := PI;
  2581.       2 : AT := PI;
  2582.       3 : AT := PI_4;
  2583.       4 : AT := PI_4;
  2584.     END; {case quad}
  2585.  
  2586.   END
  2587.   Else
  2588.   BEGIN
  2589.  
  2590.     CASE Quad2( X, Y ) OF
  2591.       1 : AT := ArcTan( Y / X );
  2592.       2 : AT := PI   - ArcTan( Abs(Y / X) );  { BP ArcTan has problems }
  2593.       3 : AT := PI   + Arctan( Y / X );       { with negative Angles   }
  2594.       4 : AT := PI_4 - ArcTan( Abs(Y / X) );
  2595.     END; {case quad}
  2596.  
  2597.   END;
  2598.  
  2599.   ArcTan2 := AT;
  2600.  
  2601. END;  { ArcTan2 }
  2602.  
  2603. {────────────────────────────────────────────────────────────────────────────}
  2604.  
  2605. (*-
  2606.  
  2607. [FUNCTION]
  2608.  
  2609. Function ArcCsc(             X     : REAL         ) : REAL;
  2610.  
  2611. [PARAMETERS]
  2612.  
  2613. X       CoSecant Value
  2614.  
  2615. [RETURNS]
  2616.  
  2617. Inverse cosecant angle in radians.
  2618.  
  2619. [DESCRIPTION]
  2620.  
  2621. [SEE-ALSO]
  2622.  
  2623. Sin2   Sinh   ArcSin    ArcSinh
  2624. Cos2   Cosh   ArcSin2   ArcCosh
  2625. Tan    Tanh   ArcCos    ArcTanh
  2626. Tan2          ArcCos2   ArcCsch
  2627. Cot           ArcTan1   ArcSech
  2628. Cot2          ArcTan2   ArcCoth
  2629. Csc           ArcSec
  2630. Sec           ArcCot
  2631.  
  2632. [EXAMPLE]
  2633.  
  2634. VAR
  2635.   I : INTEGER;
  2636.   R : REAL;
  2637.  
  2638. BEGIN
  2639.  
  2640.   R := 1.0;
  2641.   For i := 100 DownTo 0 Do
  2642.   BEGIN
  2643.  
  2644.     WriteLn( 'ArcCsc(',R:0:0,') = ',ArcCsc( R ) :8:4 );
  2645.     R := R - 0.01;
  2646.  
  2647.   END;  { For i }
  2648.  
  2649. END;
  2650.  
  2651. -*)
  2652.  
  2653. Function ArcCsc(             X     : REAL         ) : REAL;  {INCOMPLETE}
  2654.  
  2655. BEGIN
  2656.  
  2657.   If ( Abs(X) >= 1 ) Then
  2658.     ArcCsc := ArcSin(1/X);
  2659.  
  2660. END;  { ArcCsc }
  2661.  
  2662. {────────────────────────────────────────────────────────────────────────────}
  2663.  
  2664. (*-
  2665.  
  2666. [FUNCTION]
  2667.  
  2668. Function ArcSec(             X     : REAL         ) : REAL;
  2669.  
  2670. [PARAMETERS]
  2671.  
  2672. X       Secant Value
  2673.  
  2674. [RETURNS]
  2675.  
  2676. Inverse secant angle in radians.
  2677.  
  2678. [DESCRIPTION]
  2679.  
  2680. [SEE-ALSO]
  2681.  
  2682. Sin2   Sinh   ArcSin    ArcSinh
  2683. Cos2   Cosh   ArcSin2   ArcCosh
  2684. Tan    Tanh   ArcCos    ArcTanh
  2685. Tan2          ArcCos2   ArcCsch
  2686. Cot           ArcTan1   ArcSech
  2687. Cot2          ArcTan2   ArcCoth
  2688. Csc           ArcCsc
  2689. Sec           ArcCot
  2690.  
  2691. [EXAMPLE]
  2692.  
  2693. VAR
  2694.   I : INTEGER;
  2695.   R : REAL;
  2696.  
  2697. BEGIN
  2698.  
  2699.   R := 1.0;
  2700.   For i := 100 DownTo 0 Do
  2701.   BEGIN
  2702.  
  2703.     WriteLn( 'ArcSec(',R:0:0,') = ',ArcSec( R ) :8:4 );
  2704.     R := R - 0.01;
  2705.  
  2706.   END;  { For i }
  2707.  
  2708. END;
  2709.  
  2710. -*)
  2711.  
  2712. Function ArcSec(             X     : REAL         ) : REAL;  {INCOMPLETE}
  2713.  
  2714. BEGIN
  2715.  
  2716.   If ( Abs(X) >= 1 ) Then
  2717.     ArcSec := ArcCos(1/X);
  2718.  
  2719. END;  { ArcSec }
  2720.  
  2721. {────────────────────────────────────────────────────────────────────────────}
  2722.  
  2723. (*-
  2724.  
  2725. [FUNCTION]
  2726.  
  2727. Function ArcCot(             X     : REAL         ) : REAL;
  2728.  
  2729. [PARAMETERS]
  2730.  
  2731. X       CoTangent Value
  2732.  
  2733. [RETURNS]
  2734.  
  2735. Inverse cotangent angle in radians.
  2736.  
  2737. [DESCRIPTION]
  2738.  
  2739.  
  2740. [SEE-ALSO]
  2741.  
  2742. Sin2   Sinh   ArcSin    ArcSinh
  2743. Cos2   Cosh   ArcSin2   ArcCosh
  2744. Tan    Tanh   ArcCos    ArcTanh
  2745. Tan2          ArcCos2   ArcCsch
  2746. Cot           ArcTan1   ArcSech
  2747. Cot2          ArcTan2   ArcCoth
  2748. Csc           ArcCsc
  2749. Sec           ArcSec
  2750.  
  2751. [EXAMPLE]
  2752.  
  2753. VAR
  2754.   I : INTEGER;
  2755.   R : REAL;
  2756.  
  2757. BEGIN
  2758.  
  2759.   R := 1.0;
  2760.   For i := 100 DownTo 0 Do
  2761.   BEGIN
  2762.  
  2763.     WriteLn( 'ArcCot(',R:0:0,') = ',ArcCot( R ) :8:4 );
  2764.     R := R - 0.01;
  2765.  
  2766.   END;  { For i }
  2767.  
  2768. END;
  2769.  
  2770. -*)
  2771.  
  2772. Function ArcCot(             X     : REAL         ) : REAL;  {INCOMPLETE}
  2773.  
  2774. BEGIN
  2775.  
  2776.   ArcCot := ArcTan(1/X);
  2777.  
  2778. END;  { ArcCot }
  2779.  
  2780. {────────────────────────────────────────────────────────────────────────────}
  2781.  
  2782. (*-
  2783.  
  2784. [FUNCTION]
  2785.  
  2786. Function ArcSinh(            X     : REAL         ) : REAL;
  2787.  
  2788. [PARAMETERS]
  2789.  
  2790. X       Hyperbolic Sine Value
  2791.  
  2792. [RETURNS]
  2793.  
  2794. Arc Hyperbolic Sine Angle
  2795.  
  2796. [DESCRIPTION]
  2797.  
  2798. Computes and returns the Arc Hyperbolic Sine Angle of a given
  2799. Hyperbolic Sine Angle.
  2800.  
  2801. NOTE: The Hyperbolic Sine Value is NOT Range Checked and MUST
  2802. be in Bounds.
  2803.  
  2804. [SEE-ALSO]
  2805.  
  2806. Sin2   Sinh   ArcSin    ArcCosh
  2807. Cos2   Cosh   ArcSin2   ArcTanh
  2808. Tan    Tanh   ArcCos    ArcCsch
  2809. Tan2          ArcCos2   ArcSech
  2810. Cot           ArcTan1   ArcCoth
  2811. Cot2          ArcTan2
  2812. Csc           ArcCsc
  2813. Sec           ArcSec
  2814.               ArcCot
  2815.  
  2816. [EXAMPLE]
  2817.  
  2818. VAR
  2819.   I : INTEGER;
  2820.   R : REAL;
  2821.  
  2822. BEGIN
  2823.  
  2824.   R := 1.0;
  2825.   For i := 100 DownTo 0 Do
  2826.   BEGIN
  2827.  
  2828.     WriteLn( 'ArcSinh(',R:0:0,') = ',ArcSinh( R ) :8:4 );
  2829.     R := R - 0.01;
  2830.  
  2831.   END;  { For i }
  2832.  
  2833. END;
  2834.  
  2835. -*)
  2836.  
  2837. Function ArcSinh(            X     : REAL         ) : REAL;
  2838.  
  2839. BEGIN
  2840.  
  2841.   ArcSinh := Ln( X + Sqrt(X*X + 1) );
  2842.  
  2843. END;  { ArcSinh }
  2844.  
  2845. {────────────────────────────────────────────────────────────────────────────}
  2846.  
  2847. (*-
  2848.  
  2849. [FUNCTION]
  2850.  
  2851. Function ArcCosh(            X     : REAL         ) : REAL;
  2852.  
  2853. [PARAMETERS]
  2854.  
  2855. X       Hyperbolic CoSine Value
  2856.  
  2857. [RETURNS]
  2858.  
  2859. Arc Hyperbolic CoSine Angle
  2860.  
  2861. [DESCRIPTION]
  2862.  
  2863. Computes and returns the Arc Hyperbolic CoSine Angle of a given
  2864. Hyperbolic CoSine Value.
  2865.  
  2866. NOTE: The Hyperbolic CoSine Value is NOT Range Checked and MUST
  2867. be in Bounds.
  2868.  
  2869. [SEE-ALSO]
  2870.  
  2871. Sin2   Sinh   ArcSin    ArcSinh
  2872. Cos2   Cosh   ArcSin2   ArcTanh
  2873. Tan    Tanh   ArcCos    ArcCsch
  2874. Tan2          ArcCos2   ArcSech
  2875. Cot           ArcTan1   ArcCoth
  2876. Cot2          ArcTan2
  2877. Csc           ArcCsc
  2878. Sec           ArcSec
  2879.               ArcCot
  2880.  
  2881. [EXAMPLE]
  2882.  
  2883. VAR
  2884.   I : INTEGER;
  2885.   R : REAL;
  2886.  
  2887. BEGIN
  2888.  
  2889.   R := 1.0;
  2890.   For i := 100 DownTo 0 Do
  2891.   BEGIN
  2892.  
  2893.     WriteLn( 'ArcCosh(',R:0:0,') = ',ArcCosh( R ) :8:4 );
  2894.     R := R - 0.01;
  2895.  
  2896.   END;  { For i }
  2897.  
  2898. END;
  2899.  
  2900. -*)
  2901.  
  2902. Function ArcCosh(            X     : REAL         ) : REAL;
  2903.  
  2904. BEGIN
  2905.  
  2906.   If (X >= 1) Then
  2907.     ArcCosh := Ln( X + Sqrt(X*X - 1) );
  2908.  
  2909. END;  { ArcCosh }
  2910.  
  2911. {────────────────────────────────────────────────────────────────────────────}
  2912.  
  2913. (*-
  2914.  
  2915. [FUNCTION]
  2916.  
  2917. Function ArcTanh(            X     : REAL         ) : REAL;
  2918.  
  2919. [PARAMETERS]
  2920.  
  2921. X       Hyperbolic Tangent Value
  2922.  
  2923. [RETURNS]
  2924.  
  2925. Arc Hyperbolic Tangent Angle
  2926.  
  2927. [DESCRIPTION]
  2928.  
  2929. Computes and returns the Arc Hyperbolic Tangent Angle of a given
  2930. Hyperbolic Tangent Value.
  2931.  
  2932. [SEE-ALSO]
  2933.  
  2934. Sin2   Sinh   ArcSin    ArcSinh
  2935. Cos2   Cosh   ArcSin2   ArcCosh
  2936. Tan    Tanh   ArcCos    ArcCsch
  2937. Tan2          ArcCos2   ArcSech
  2938. Cot           ArcTan1   ArcCoth
  2939. Cot2          ArcTan2
  2940. Csc           ArcCsc
  2941. Sec           ArcSec
  2942.               ArcCot
  2943.  
  2944. [EXAMPLE]
  2945.  
  2946. VAR
  2947.   I : INTEGER;
  2948.   R : REAL;
  2949.  
  2950. BEGIN
  2951.  
  2952.   R := 1.0;
  2953.   For i := 100 DownTo 0 Do
  2954.   BEGIN
  2955.  
  2956.     WriteLn( 'ArcTanh(',R:0:0,') = ',ArcTanh( R ) :8:4 );
  2957.     R := R - 0.01;
  2958.  
  2959.   END;  { For i }
  2960.  
  2961. END;
  2962.  
  2963. -*)
  2964.  
  2965. Function ArcTanh(            X     : REAL         ) : REAL;
  2966.  
  2967. BEGIN
  2968.  
  2969.   If Abs(X) < 1 Then
  2970.     ArcTanh := (1/2) * Ln( (1 + X) / (1 - X) );
  2971.  
  2972. END;  { ArcTanh }
  2973.  
  2974. {────────────────────────────────────────────────────────────────────────────}
  2975.  
  2976. (*-
  2977.  
  2978. [FUNCTION]
  2979.  
  2980. Function ArcCsch(            X     : REAL         ) : REAL;
  2981.  
  2982. [PARAMETERS]
  2983.  
  2984. X       Hyperbolic CoSecant Value
  2985.  
  2986. [RETURNS]
  2987.  
  2988. Arc Hyperbolic CoSecant Angle
  2989.  
  2990. [DESCRIPTION]
  2991.  
  2992. Computes and returns the Arc Hyperbolic CoSecant Angle of a given
  2993. Hyperbolic CoSecant Value.
  2994.  
  2995. NOTE: The Hyperbolic CoSecant Value is NOT Range Checked and MUST
  2996. be in Bounds.
  2997.  
  2998. [SEE-ALSO]
  2999.  
  3000. Sin2   Sinh   ArcSin    ArcSinh
  3001. Cos2   Cosh   ArcSin2   ArcCosh
  3002. Tan    Tanh   ArcCos    ArcTanh
  3003. Tan2          ArcCos2   ArcSech
  3004. Cot           ArcTan1   ArcCoth
  3005. Cot2          ArcTan2
  3006. Csc           ArcCsc
  3007. Sec           ArcSec
  3008.               ArcCot
  3009.  
  3010. [EXAMPLE]
  3011.  
  3012. VAR
  3013.   I : INTEGER;
  3014.   R : REAL;
  3015.  
  3016. BEGIN
  3017.  
  3018.   R := 1.0;
  3019.   For i := 100 DownTo 0 Do
  3020.   BEGIN
  3021.  
  3022.     WriteLn( 'ArcCsch(',R:0:0,') = ',ArcCsch( R ) :8:4 );
  3023.     R := R - 0.01;
  3024.  
  3025.   END;  { For i }
  3026.  
  3027. END;
  3028.  
  3029. -*)
  3030.  
  3031. Function ArcCsch(            X     : REAL         ) : REAL;
  3032.  
  3033. BEGIN
  3034.  
  3035.   If (X > 0) Then
  3036.     ArcCsch := Ln( (1 + Sqrt(1 + X*X)) / Abs(X) )
  3037.   Else
  3038.   If (X < 0) Then
  3039.     ArcCsch := Ln( (-1 + Sqrt(1 + X*X)) / Abs(X) );
  3040.  
  3041. END;  { ArcCsch }
  3042.  
  3043. {────────────────────────────────────────────────────────────────────────────}
  3044.  
  3045. (*-
  3046.  
  3047. [FUNCTION]
  3048.  
  3049. Function ArcSech(            X     : REAL         ) : REAL;
  3050.  
  3051. [PARAMETERS]
  3052.  
  3053. X       Hyperbolic Secant Value
  3054.  
  3055. [RETURNS]
  3056.  
  3057. Arc Hyperbolic Secant Angle
  3058.  
  3059. [DESCRIPTION]
  3060.  
  3061. Computes and returns the Arc Hyperbolic Secant Angle of a given
  3062. Hyperbolic Secant Value.
  3063.  
  3064. NOTE: The Hyperbolic Secant Value is NOT Range Checked and MUST
  3065. be in Bounds.
  3066.  
  3067. [SEE-ALSO]
  3068.  
  3069. Sin2   Sinh   ArcSin    ArcSinh
  3070. Cos2   Cosh   ArcSin2   ArcCosh
  3071. Tan    Tanh   ArcCos    ArcTanh
  3072. Tan2          ArcCos2   ArcCsch
  3073. Cot           ArcTan1   ArcCoth
  3074. Cot2          ArcTan2
  3075. Csc           ArcCsc
  3076. Sec           ArcSec
  3077.               ArcCot
  3078.  
  3079. [EXAMPLE]
  3080.  
  3081. VAR
  3082.   I : INTEGER;
  3083.   R : REAL;
  3084.  
  3085. BEGIN
  3086.  
  3087.   R := 1.0;
  3088.   For i := 100 DownTo 0 Do
  3089.   BEGIN
  3090.  
  3091.     WriteLn( 'ArcSech(',R:0:0,') = ',ArcSech( R ) :8:4 );
  3092.     R := R - 0.01;
  3093.  
  3094.   END;  { For i }
  3095.  
  3096. END;
  3097.  
  3098. -*)
  3099.  
  3100. Function ArcSech(            X     : REAL         ) : REAL;
  3101.  
  3102. BEGIN
  3103.  
  3104.   If (X > 0) AND (X <= 1) Then
  3105.     ArcSech := Ln( (1 + Sqrt(1 - X*X)) / X );
  3106.  
  3107. END;  { ArcSech }
  3108.  
  3109. {────────────────────────────────────────────────────────────────────────────}
  3110.  
  3111. (*-
  3112.  
  3113. [FUNCTION]
  3114.  
  3115. Function ArcCoth(            X     : REAL         ) : REAL;
  3116.  
  3117. [PARAMETERS]
  3118.  
  3119. X       Hyperbolic Tangent Value
  3120.  
  3121. [RETURNS]
  3122.  
  3123. Arc Hyperbolic Tangent Angle
  3124.  
  3125. [DESCRIPTION]
  3126.  
  3127. Computes and returns the Arc Hyperbolic Tangent Angle of a given
  3128. Hyperbolic Tangent Value.
  3129.  
  3130. [SEE-ALSO]
  3131.  
  3132. Sin2   Sinh   ArcSin    ArcSinh
  3133. Cos2   Cosh   ArcSin2   ArcCosh
  3134. Tan    Tanh   ArcCos    ArcTanh
  3135. Tan2          ArcCos2   ArcCsch
  3136. Cot           ArcTan1   ArcSech
  3137. Cot2          ArcTan2
  3138. Csc           ArcCsc
  3139. Sec           ArcSec
  3140.               ArcCot
  3141.  
  3142. [EXAMPLE]
  3143.  
  3144. VAR
  3145.   I : INTEGER;
  3146.   R : REAL;
  3147.  
  3148. BEGIN
  3149.  
  3150.   R := 1.0;
  3151.   For i := 100 DownTo 0 Do
  3152.   BEGIN
  3153.  
  3154.     WriteLn( 'ArcCoth(',R:0:0,') = ',ArcCoth( R ) :8:4 );
  3155.     R := R - 0.01;
  3156.  
  3157.   END;  { For i }
  3158.  
  3159. END;
  3160.  
  3161. -*)
  3162.  
  3163. Function ArcCoth(            X     : REAL         ) : REAL;
  3164.  
  3165. BEGIN
  3166.  
  3167.   If Abs(X) > 1 Then
  3168.     ArcCoth := (1/2) * Ln( (X + 1) / (X - 1) );
  3169.  
  3170. END;  { ArcCoth }
  3171.  
  3172. {────────────────────────────────────────────────────────────────────────────}
  3173.  
  3174. (*-
  3175.  
  3176. [FUNCTION]
  3177.  
  3178. Function Power(              Num       : LONGINT;
  3179.                              Exponent  : LONGINT      ) : LONGINT;
  3180.  
  3181. [PARAMETERS]
  3182.  
  3183. Num         Number to Raise to Power
  3184. Exponent    Power to Raise Value by
  3185.  
  3186. [RETURNS]
  3187.  
  3188. Number Raised by a given Power
  3189.  
  3190. [DESCRIPTION]
  3191.  
  3192. Determines the Number Raised to a given Power.  Return the result
  3193. as a Long Integer Value.
  3194.  
  3195. [SEE-ALSO]
  3196.  
  3197. PowerR
  3198. Root
  3199. RootR
  3200.  
  3201. [EXAMPLE]
  3202.  
  3203. VAR
  3204.   Answer : REAL;
  3205.  
  3206. BEGIN
  3207.  
  3208.   Answer := PowerR( 7, 2 );  { Answer = 49 }
  3209.  
  3210. END;
  3211.  
  3212. -*)
  3213.  
  3214.  
  3215. Function Power(              Num       : LONGINT;
  3216.                              Exponent  : LONGINT      ) : LONGINT;
  3217.  
  3218. Var
  3219.  
  3220.   R1,R2 : REAL;
  3221.  
  3222. BEGIN
  3223.  
  3224.   If ( Num > 0 ) Then
  3225.   BEGIN
  3226.  
  3227.     R1 := Num;
  3228.     R2 := Exponent;
  3229.     Power := Round( Exp( Ln( R1 ) *  R2 ) );
  3230.  
  3231.   END
  3232.   Else
  3233.     Power := 0;
  3234.  
  3235. END;  { Power }
  3236.  
  3237. {────────────────────────────────────────────────────────────────────────────}
  3238.  
  3239. (*-
  3240.  
  3241. [FUNCTION]
  3242.  
  3243. Function PowerR(             Num       : REAL;
  3244.                              Exponent  : REAL         ) : REAL;
  3245.  
  3246. [PARAMETERS]
  3247.  
  3248. Num         Number to Raise to a Power
  3249. Exponent    Power to Raise Number by
  3250.  
  3251. [RETURNS]
  3252.  
  3253. Number Raised by a given Power
  3254.  
  3255. [DESCRIPTION]
  3256.  
  3257. Determines the Number Raised by a given Power.  Returns the result
  3258. as a Floating Point Value.
  3259.  
  3260. [SEE-ALSO]
  3261.  
  3262. Power
  3263. Root
  3264. RootR
  3265.  
  3266. [EXAMPLE]
  3267.  
  3268. VAR
  3269.   Answer : REAL;
  3270.  
  3271. BEGIN
  3272.  
  3273.   Answer := PowerR( 7.0, 2.0 );  { Answer = 49.0 }
  3274.  
  3275. END;
  3276.  
  3277. -*)
  3278.  
  3279.  
  3280. Function PowerR(             Num       : REAL;
  3281.                              Exponent  : REAL         ) : REAL;
  3282. BEGIN
  3283.  
  3284.   If ( Num > 0.0 ) Then
  3285.   BEGIN
  3286.  
  3287.     If ( Exponent > 88 ) Then
  3288.       PowerR := cOVERFLOW
  3289.     Else
  3290.     If ( Exponent < -88 ) Then
  3291.       PowerR := cUNDERFLOW
  3292.     Else
  3293.       PowerR := Exp( Exponent * Ln( Num ) )
  3294.   END
  3295.   Else
  3296.     If ( Num = 0.0 ) And ( Exponent = 0.0 ) Then
  3297.       PowerR := 1.0
  3298.     Else
  3299.       PowerR := 0.0;
  3300.  
  3301. END;  { PowerR }
  3302.  
  3303. {────────────────────────────────────────────────────────────────────────────}
  3304.  
  3305. (*-
  3306.  
  3307. [FUNCTION]
  3308.  
  3309. Function Root(               Num       : LONGINT;
  3310.                              RootVal   : LONGINT      ) : LONGINT;
  3311.  
  3312. [PARAMETERS]
  3313.  
  3314. Num         Number to get a Root from  (Must be > 0 or RunTime Error!)
  3315. RootVal     Root to apply to Number (can be any real number)
  3316.  
  3317. [RETURNS]
  3318.  
  3319. The Root Value of a given Number
  3320.  
  3321. [DESCRIPTION]
  3322.  
  3323. Computes the Root Value of a given Number.  The result is returned
  3324. as a Long Integer Value.
  3325.  
  3326. NOTE: Be sure that "Num" is Zero (0) or greater as imaginary Roots
  3327. and use of other Complex Numbers will cause a Runtime Error in this
  3328. Function.
  3329.  
  3330. [SEE-ALSO]
  3331.  
  3332. Power
  3333. PowerR
  3334. RootR
  3335.  
  3336. [EXAMPLE]
  3337.  
  3338. VAR
  3339.   Answer : LONGINT;
  3340.  
  3341. BEGIN
  3342.  
  3343.   Answer := Root( 49, 2 );  { Answer = 7 }
  3344.  
  3345. END;
  3346.  
  3347. -*)
  3348.  
  3349.  
  3350. Function Root(               Num       : LONGINT;
  3351.                              RootVal   : LONGINT      ) : LONGINT;
  3352.  
  3353. Var
  3354.  
  3355.   R1,R2 : LONGINT;
  3356.  
  3357. BEGIN
  3358.  
  3359.   If ( Num > 0 ) Then
  3360.   BEGIN
  3361.  
  3362.     R1 := Num;
  3363.     R2 := RootVal;
  3364.     Root := Round( Exp( Ln( R1 ) * ( 1.0 / R2 ) ) );
  3365.  
  3366.   END
  3367.   Else
  3368.     Root := 0;
  3369.  
  3370. END;  { Root }
  3371.  
  3372. {────────────────────────────────────────────────────────────────────────────}
  3373.  
  3374. (*-
  3375.  
  3376. [FUNCTION]
  3377.  
  3378. Function RootR(              Num       : REAL;
  3379.                              RootVal   : REAL         ) : REAL;
  3380.  
  3381. [PARAMETERS]
  3382.  
  3383. Num         Number to get a Root from  (Must be > 0 or RunTime Error!)
  3384. RootVal     Root to apply to Number (can be any real number)
  3385.  
  3386. [RETURNS]
  3387.  
  3388. The Root Value of a given Number
  3389.  
  3390. [DESCRIPTION]
  3391.  
  3392. Computes the Root Value of a given Number.  The result is returned
  3393. as a Floating Point Value.
  3394.  
  3395. NOTE: Be sure that "Num" is Zero (0) or greater as imaginary Roots
  3396. and use of other Complex Numbers will cause a Runtime Error in this
  3397. Function.
  3398.  
  3399. [SEE-ALSO]
  3400.  
  3401. Power
  3402. PowerR
  3403. Root
  3404.  
  3405. [EXAMPLE]
  3406.  
  3407. VAR
  3408.   Answer : REAL;
  3409.  
  3410. BEGIN
  3411.  
  3412.   Answer := RootR( 49.0, 2.0 );  { Answer = 7.0 }
  3413.  
  3414. END;
  3415.  
  3416. -*)
  3417.  
  3418. Function RootR(              Num       : REAL;
  3419.                              RootVal   : REAL         ) : REAL;
  3420. BEGIN
  3421.  
  3422.   If ( Num > 0 ) Then
  3423.     RootR := Exp( Ln( Num ) * ( 1.0 / RootVal ) )
  3424.   Else
  3425.     RootR := 0;
  3426.  
  3427. END;  { RootR }
  3428.  
  3429. {────────────────────────────────────────────────────────────────────────────}
  3430.  
  3431. (*-
  3432.  
  3433. [FUNCTION]
  3434.  
  3435. Function Log(                Num       : REAL;
  3436.                              Base      : REAL         ) : REAL;
  3437.  
  3438. [PARAMETERS]
  3439.  
  3440. Num         Number to determine a Base of
  3441. Base        Base Value to use for Logarithm
  3442.  
  3443. [RETURNS]
  3444.  
  3445. Logarithm of a given Number.
  3446.  
  3447. [DESCRIPTION]
  3448.  
  3449. Computes a Logarithm of a given Number using a given Base.
  3450. To use "Natural" Logarithm use the Value from the Function E
  3451. as the Base.
  3452.  
  3453. The result is returned as a Floating Point Value.
  3454.  
  3455. [SEE-ALSO]
  3456.  
  3457. [EXAMPLE]
  3458.  
  3459. VAR
  3460.   Answer : REAL;
  3461.  
  3462. BEGIN
  3463.  
  3464.   Answer := Log( 32, 2 );  { Answer = 5.0 }
  3465.  
  3466. END;
  3467.  
  3468. -*)
  3469.  
  3470. Function Log(                Num       : REAL;
  3471.                              Base      : REAL         ) : REAL;
  3472. BEGIN
  3473.  
  3474.   If ( Num < 0.0 ) Then
  3475.     Log := cUNDERFLOW
  3476.   Else
  3477.   If ( Base < 1.0 ) Then
  3478.     Log := cOVERFLOW
  3479.   Else
  3480.     Log := Ln( Num ) / Ln( Base );
  3481.  
  3482. END;  { Log }
  3483.  
  3484. {────────────────────────────────────────────────────────────────────────────}
  3485.  
  3486. (*-
  3487.  
  3488. [Function]
  3489.  
  3490. Function FastHyp(            XDist     : REAL;
  3491.                              YDist     : REAL        ) : REAL;
  3492.  
  3493. [PARAMETERS]
  3494.  
  3495. XDist       X Distance between Points
  3496. YDist       Y Distance between Points
  3497.  
  3498. [RETURNS]
  3499.  
  3500. The Hypotenuse of the X and Y Distances
  3501.  
  3502. [DESCRIPTION]
  3503.  
  3504. Computes and returns the Hypotenuse of the X and Y Distances
  3505. from another Point.  The main advantage of this routine is that
  3506. is does all the routines as simple Math functions thereby
  3507. reducing the computation time.
  3508.  
  3509. This method is useful in providing accept/reject distance tests
  3510. in 2D graphics.  These are commonly used in providing "Gravity
  3511. Fields" or other proximity tests for circle or ellipse selection.
  3512. This form is commony employed in libraries offering a high-precision
  3513. hypot as the conventional form is prone to severe loss of accuracy.
  3514.  
  3515. Note that the code is symmetric about the axis x = y = 1 within the
  3516. first quadrant.  Absolute value operation on the input arguments
  3517. allow for four-quadrant operation, yeilding isometric distance lines
  3518. of eight-fold symmetry.
  3519.  
  3520. [SEE-ALSO]
  3521.  
  3522. [EXAMPLE]
  3523.  
  3524. -*)
  3525.  
  3526. Function FastHyp(            XDist     : REAL;
  3527.                              YDist     : REAL        ) : REAL;
  3528. BEGIN
  3529.  
  3530.   If XDist <> 0.0 Then
  3531.     FastHyp := XDist * ( 1.0 + 0.5 * Sqr( YDist / XDist ) )
  3532.   Else
  3533.     FastHyp := Sqrt( Sqr( XDist ) + Sqr( YDist ) );
  3534.  
  3535. END;
  3536.  
  3537. {────────────────────────────────────────────────────────────────────────────}
  3538.  
  3539. (*-
  3540.  
  3541. [Function]
  3542.  
  3543. Function FastHypR(           XDist     : REAL;
  3544.                              YDist     : REAL        ) : REAL;
  3545.  
  3546. [PARAMETERS]
  3547.  
  3548. XDist       X Distance between Points
  3549. YDist       Y Distance between Points
  3550.  
  3551. [RETURNS]
  3552.  
  3553. The Hypotenuse of the X and Y Distances
  3554.  
  3555. [DESCRIPTION]
  3556.  
  3557. Computes and returns the Hypotenuse of the X and Y Distances
  3558. from another Point.  The main advantage of this routine is that
  3559. is does all the routines as simple Math functions thereby
  3560. reducing the computation time.
  3561.  
  3562. This method is useful in providing accept/reject distance tests
  3563. in 2D graphics.  These are commonly used in providing "Gravity
  3564. Fields" or other proximity tests for circle or ellipse selection.
  3565. This form is commony employed in libraries offering a high-precision
  3566. hypot as the conventional form is prone to severe loss of accuracy.
  3567.  
  3568. Note that the code is symmetric about the axis x = y = 1 within the
  3569. first quadrant.  Absolute value operation on the input arguments
  3570. allow for four-quadrant operation, yeilding isometric distance lines
  3571. of eight-fold symmetry.
  3572.  
  3573. [SEE-ALSO]
  3574.  
  3575. [EXAMPLE]
  3576.  
  3577. -*)
  3578.  
  3579. Function FastHypR(           XDist     : REAL;
  3580.                              YDist     : REAL        ) : REAL;
  3581. BEGIN
  3582.  
  3583.   If XDist <> 0.0 Then
  3584.     FastHypR := XDist * ( 1.0 + 0.5 * Sqr( YDist / XDist ) )
  3585.   Else
  3586.     FastHypR := Sqrt( Sqr( XDist ) + Sqr( YDist ) );
  3587.  
  3588. END;
  3589.  
  3590. {────────────────────────────────────────────────────────────────────────────}
  3591.  
  3592. (*-
  3593.  
  3594. [Function]
  3595.  
  3596. Function Hypot(              XDist     : REAL;
  3597.                              YDist     : REAL        ) : REAL;
  3598.  
  3599. [PARAMETERS]
  3600.  
  3601. XDist       X Distance between Points
  3602. YDist       Y Distance between Points
  3603.  
  3604. [RETURNS]
  3605.  
  3606. The Hypotenuse of the X and Y Distances
  3607.  
  3608. [DESCRIPTION]
  3609.  
  3610. Computes and returns the Hypotenuse of the X and Y Distances
  3611. from another Point.
  3612.  
  3613. [SEE-ALSO]
  3614.  
  3615. [EXAMPLE]
  3616.  
  3617. -*)
  3618.  
  3619. Function Hypot(              XDist     : REAL;
  3620.                              YDist     : REAL        ) : REAL;
  3621. BEGIN
  3622.  
  3623.   Hypot := Sqrt( Sqr( XDist ) + Sqr( YDist ) );
  3624.  
  3625. END;
  3626.  
  3627. {────────────────────────────────────────────────────────────────────────────}
  3628.  
  3629. (*-
  3630.  
  3631. [FUNCTION]
  3632.  
  3633. Function FastDist(           X1        : LONGINT;
  3634.                              Y1        : LONGINT;
  3635.                              X2        : LONGINT;
  3636.                              Y2        : LONGINT      ) : LONGINT;
  3637.  
  3638. [PARAMETERS]
  3639.  
  3640. X1          X Coordinate of 1st Point
  3641. Y1          Y Coordinate of 1st Point
  3642. X2          X Coordinate of 2nd Point
  3643. Y2          Y Coordinate of 2nd Point
  3644.  
  3645. [RETURNS]
  3646.  
  3647. The Distance between the 2 Points (the Hypotenuse)
  3648.  
  3649. [DESCRIPTION]
  3650.  
  3651. Computes and returns the distance between 2 points whose Coordinates
  3652. are provided.
  3653.  
  3654. [SEE-ALSO]
  3655.  
  3656. Hypot
  3657.  
  3658. [EXAMPLE]
  3659.  
  3660. BEGIN
  3661.  
  3662.   WriteLn( 'Distance = ',FastDist( 10,10, 20,20 ):8:4 );
  3663.  
  3664. END;
  3665.  
  3666. -*)
  3667.  
  3668. Function FastDist(           X1        : LONGINT;
  3669.                              Y1        : LONGINT;
  3670.                              X2        : LONGINT;
  3671.                              Y2        : LONGINT      ) : LONGINT;
  3672. VAR
  3673.   L : LONGINT;
  3674.  
  3675. BEGIN
  3676.  
  3677.   X2 := X2 - X1;
  3678.   If X2 < 0 Then X2 := -X2;
  3679.   Y2 := Y2 - Y1;
  3680.   If Y2 < 0 Then Y2 := -Y2;
  3681.  
  3682.   If (X2 > Y2) Then
  3683.     L := Y2
  3684.   Else
  3685.     L := X2;
  3686.  
  3687.   FastDist := X2 + Y2 - L SHR 1;
  3688.  
  3689. END;
  3690.  
  3691. {────────────────────────────────────────────────────────────────────────────}
  3692.  
  3693. (*-
  3694.  
  3695. [FUNCTION]
  3696.  
  3697. Function DistanceXY(         X1        : REAL;
  3698.                              Y1        : REAL;
  3699.                              X2        : REAL;
  3700.                              Y2        : REAL         ) : REAL;
  3701.  
  3702. [PARAMETERS]
  3703.  
  3704. X1          X Coordinate of 1st Point
  3705. Y1          Y Coordinate of 1st Point
  3706. X2          X Coordinate of 2nd Point
  3707. Y2          Y Coordinate of 2nd Point
  3708.  
  3709. [RETURNS]
  3710.  
  3711. The Distance between the 2 Points (the Hypotenuse)
  3712.  
  3713. [DESCRIPTION]
  3714.  
  3715. Computes and returns the distance between 2 points whose Coordinates
  3716. are provided.
  3717.  
  3718. [SEE-ALSO]
  3719.  
  3720. Hypot
  3721.  
  3722. [EXAMPLE]
  3723.  
  3724. BEGIN
  3725.  
  3726.   WriteLn( 'Distance = ',Distance( 10,10, 20,20 ):8:4 );
  3727.  
  3728. END;
  3729.  
  3730. -*)
  3731.  
  3732. Function DistanceXY(         X1        : REAL;
  3733.                              Y1        : REAL;
  3734.                              X2        : REAL;
  3735.                              Y2        : REAL         ) : REAL;
  3736.  
  3737. BEGIN
  3738.  
  3739.   DistanceXY := Sqrt( Sqr(X2 - X1) + Sqr(Y2 - Y1) );
  3740.  
  3741. END;
  3742.  
  3743. {────────────────────────────────────────────────────────────────────────────}
  3744.  
  3745. (*-
  3746.  
  3747. [FUNCTION]
  3748.  
  3749. Function Percent(            Part      : LONGINT;
  3750.                              Whole     : LONGINT      ) : REAL;
  3751.  
  3752. [PARAMETERS]
  3753.  
  3754. Part        Portion of the Whole being Referenced
  3755. Whole       Size representing 100% of Value
  3756.  
  3757. [RETURNS]
  3758.  
  3759. Percentage of 100% which Part represents
  3760.  
  3761. [DESCRIPTION]
  3762.  
  3763. Determines what percentage of the "Whole" Value the "Part" Value
  3764. represents.
  3765.  
  3766. [SEE-ALSO]
  3767.  
  3768. [EXAMPLE]
  3769.  
  3770. VAR
  3771.   Answer : REAL;
  3772.  
  3773. BEGIN
  3774.  
  3775.   Answer := Percent( 30.0, 60.0 );  { Answer = 50.0 }
  3776.  
  3777. END;
  3778.  
  3779. -*)
  3780.  
  3781. Function Percent(            Part      : LONGINT;
  3782.                              Whole     : LONGINT      ) : REAL;
  3783.  
  3784. Var
  3785.  
  3786.   R1,R2 : REAL;
  3787.  
  3788. BEGIN
  3789.  
  3790.   R1 := Part;
  3791.   R2 := Whole;
  3792.  
  3793.   Percent := 100.0 * ( R1 / R2 );
  3794.  
  3795. END;  { Percent }
  3796.  
  3797. {────────────────────────────────────────────────────────────────────────────}
  3798.  
  3799. (*-
  3800.  
  3801. [FUNCTION]
  3802.  
  3803. Function Min(                A         : LONGINT;
  3804.                              B         : LONGINT      ) : LONGINT;
  3805.  
  3806. [PARAMETERS]
  3807.  
  3808. A           1st Source Value
  3809. B           2nd Source Value
  3810.  
  3811. [RETURNS]
  3812.  
  3813. The Lesser of the two Values
  3814.  
  3815. [DESCRIPTION]
  3816.  
  3817. Returns the Lesser of the Two Values as a Long Integer Value.
  3818.  
  3819. [SEE-ALSO]
  3820.  
  3821. MinR
  3822. Max
  3823. MaxR
  3824.  
  3825. [EXAMPLE]
  3826.  
  3827. VAR
  3828.   Answer : LONGINT;
  3829.  
  3830. BEGIN
  3831.  
  3832.   Answer := Min( 5, 3 );  { Answer = 3 }
  3833.  
  3834. END;
  3835.  
  3836. -*)
  3837.  
  3838. Function Min(                A         : LONGINT;
  3839.                              B         : LONGINT      ) : LONGINT;
  3840.  
  3841. BEGIN
  3842.  
  3843.   If A < B Then
  3844.     Min := A
  3845.   Else
  3846.     Min := B;
  3847.  
  3848. END;  { Min }
  3849.  
  3850. {────────────────────────────────────────────────────────────────────────────}
  3851.  
  3852. (*-
  3853.  
  3854. [FUNCTION]
  3855.  
  3856. Function MinR(               A         : REAL;
  3857.                              B         : REAL         ) : REAL;
  3858.  
  3859. [PARAMETERS]
  3860.  
  3861. A           1st Source Value
  3862. B           2nd Source Value
  3863.  
  3864. [RETURNS]
  3865.  
  3866. The Lesser of the two Values
  3867.  
  3868. [DESCRIPTION]
  3869.  
  3870. Returns the Lesser of the Two Values as a Floating Point Value.
  3871.  
  3872. [SEE-ALSO]
  3873.  
  3874. Min
  3875. Max
  3876. MaxR
  3877.  
  3878. [EXAMPLE]
  3879.  
  3880. VAR
  3881.   Answer : REAL;
  3882.  
  3883. BEGIN
  3884.  
  3885.   Answer := MinR( 5.2, 3.6 );  { Answer := 3.6 }
  3886.  
  3887. END;
  3888.  
  3889. -*)
  3890.  
  3891. Function MinR(               A         : REAL;
  3892.                              B         : REAL         ) : REAL;
  3893.  
  3894. BEGIN
  3895.  
  3896.   If A < B Then
  3897.     MinR := A
  3898.   Else
  3899.     MinR := B;
  3900.  
  3901. END;  { MinR }
  3902.  
  3903. {────────────────────────────────────────────────────────────────────────────}
  3904.  
  3905. (*-
  3906.  
  3907. [FUNCTION]
  3908.  
  3909. Function Max(                A         : LONGINT;
  3910.                              B         : LONGINT      ) : LONGINT;
  3911.  
  3912. [PARAMETERS]
  3913.  
  3914. A           1st Source Value
  3915. B           2nd Source Value
  3916.  
  3917. [RETURNS]
  3918.  
  3919. The Greater of the two Values
  3920.  
  3921. [DESCRIPTION]
  3922.  
  3923. Returns the Greater of the Two Values as a Long Integer Value.
  3924.  
  3925. [SEE-ALSO]
  3926.  
  3927. Min
  3928. MinR
  3929. MaxR
  3930.  
  3931. [EXAMPLE]
  3932.  
  3933. VAR
  3934.   Answer : LONGINT;
  3935.  
  3936. BEGIN
  3937.  
  3938.   Answer := Max( 5, 3 );  { Answer = 5 }
  3939.  
  3940. END;
  3941.  
  3942. -*)
  3943.  
  3944. Function Max(                A         : LONGINT;
  3945.                              B         : LONGINT      ) : LONGINT;
  3946.  
  3947. BEGIN
  3948.  
  3949.   If A > B Then
  3950.     Max := A
  3951.   Else
  3952.     Max := B;
  3953.  
  3954. END;  { Max }
  3955.  
  3956. {────────────────────────────────────────────────────────────────────────────}
  3957.  
  3958. (*-
  3959.  
  3960. [FUNCTION]
  3961.  
  3962. Function MaxR(               A         : REAL;
  3963.                              B         : REAL         ) : REAL;
  3964.  
  3965. [PARAMETERS]
  3966.  
  3967. A           1st Source Value
  3968. B           2nd Source Value
  3969.  
  3970. [RETURNS]
  3971.  
  3972. The Greater of the two Values
  3973.  
  3974. [DESCRIPTION]
  3975.  
  3976. Returns the Greater of the Two Values as a Floating Point Value.
  3977.  
  3978. [SEE-ALSO]
  3979.  
  3980. Min
  3981. MinR
  3982. Max
  3983.  
  3984. [EXAMPLE]
  3985.  
  3986. VAR
  3987.   Answer : REAL;
  3988.  
  3989. BEGIN
  3990.  
  3991.   Answer := MaxR( 5.2, 3.6 );  { Answer = 5.2 }
  3992.  
  3993. END;
  3994.  
  3995. -*)
  3996.  
  3997. Function MaxR(               A         : REAL;
  3998.                              B         : REAL         ) : REAL;
  3999.  
  4000. BEGIN
  4001.  
  4002.   If A > B Then
  4003.     MaxR := A
  4004.   Else
  4005.     MaxR := B;
  4006.  
  4007. END;
  4008.  
  4009. {────────────────────────────────────────────────────────────────────────────}
  4010.  
  4011. (*-
  4012.  
  4013. [FUNCTION]
  4014.  
  4015. Function Range(              Num       : LONGINT;
  4016.                              Low       : LONGINT;
  4017.                              High      : LONGINT      ) : LONGINT;
  4018.  
  4019. [PARAMETERS]
  4020.  
  4021. Num         Source Value to Range Check
  4022. Low         Minimum Limit
  4023. High        Maximum Limit
  4024.  
  4025. [RETURNS]
  4026.  
  4027. The Value Clipped by the Range
  4028.  
  4029. [DESCRIPTION]
  4030.  
  4031. Range Checks a Value and Clips it to within the given Minimum
  4032. and Maximum Range.  Result is returned as a Long Integer Value.
  4033.  
  4034. [SEE-ALSO]
  4035.  
  4036. RangeR
  4037. Floor
  4038. FloorR
  4039. Ceiling
  4040. CeilingR
  4041.  
  4042. [EXAMPLE]
  4043.  
  4044. VAR
  4045.   Answer : LONGINT;
  4046.  
  4047. BEGIN
  4048.  
  4049.   Answer := RangeR( 43 ,40, 50 );  { Answer = 43 }
  4050.   Answer := RangeR( 37 ,40, 50 );  { Answer = 40 }
  4051.   Answer := RangeR( 73 ,40, 50 );  { Answer = 50 }
  4052.  
  4053. END;
  4054.  
  4055. -*)
  4056.  
  4057. Function Range(              Num       : LONGINT;
  4058.                              Low       : LONGINT;
  4059.                              High      : LONGINT      ) : LONGINT;
  4060.  
  4061. BEGIN
  4062.  
  4063.   If ( Num < Low ) Then
  4064.     Num := Low;
  4065.  
  4066.   If ( Num > High ) Then
  4067.     Num := High;
  4068.  
  4069.   Range := Num;
  4070.  
  4071. END;  { Range }
  4072.  
  4073. {────────────────────────────────────────────────────────────────────────────}
  4074.  
  4075. (*-
  4076.  
  4077. [FUNCTION]
  4078.  
  4079. Function RangeR(             Num       : REAL;
  4080.                              Low       : REAL;
  4081.                              High      : REAL         ) : REAL;
  4082.  
  4083. [PARAMETERS]
  4084.  
  4085. Num         Source Value to Range Check
  4086. Low         Minimum Limit
  4087. High        Maximum Limit
  4088.  
  4089. [RETURNS]
  4090.  
  4091. The Value Clipped by the Range
  4092.  
  4093. [DESCRIPTION]
  4094.  
  4095. Range Checks a Value and Clips it to within the given Minimum
  4096. and Maximum Range.  Result is returned as a Floating Point Value.
  4097.  
  4098. [SEE-ALSO]
  4099.  
  4100. Range
  4101. Floor
  4102. FloorR
  4103. Ceiling
  4104. CeilingR
  4105.  
  4106. [EXAMPLE]
  4107.  
  4108. VAR
  4109.   Answer : REAL;
  4110.  
  4111. BEGIN
  4112.  
  4113.   Answer := RangeR( 43.6 ,40.0, 50.0 );  { Answer = 43.6 }
  4114.   Answer := RangeR( 37.2 ,40.0, 50.0 );  { Answer = 40.0 }
  4115.   Answer := RangeR( 73.3 ,40.0, 50.0 );  { Answer = 50.0 }
  4116.  
  4117. END;
  4118.  
  4119. -*)
  4120.  
  4121. Function RangeR(             Num       : REAL;
  4122.                              Low       : REAL;
  4123.                              High      : REAL         ) : REAL;
  4124.  
  4125. BEGIN
  4126.  
  4127.   If ( Num < Low ) Then
  4128.     Num := Low;
  4129.  
  4130.   If ( Num > High ) Then
  4131.     Num := High;
  4132.  
  4133.   RangeR := Num;
  4134.  
  4135. END;  { RangeR }
  4136.  
  4137. {────────────────────────────────────────────────────────────────────────────}
  4138.  
  4139. (*-
  4140.  
  4141. [FUNCTION]
  4142.  
  4143. Function Floor(              Num       : LONGINT;
  4144.                              Low       : LONGINT      ) : LONGINT;
  4145.  
  4146. [PARAMETERS]
  4147.  
  4148. Num         Source Value to Range Check
  4149. Low         Minimum Limit
  4150.  
  4151. [RETURNS]
  4152.  
  4153. The Value Clipped by the Minimum Range
  4154.  
  4155. [DESCRIPTION]
  4156.  
  4157. Range Checks a Value and Clips it so it is at or above a given
  4158. Minimum Range.  The result is returned as a Long Integer Value.
  4159.  
  4160. [SEE-ALSO]
  4161.  
  4162. Range
  4163. RangeR
  4164. FloorR
  4165. Ceiling
  4166. CeilingR
  4167.  
  4168. [EXAMPLE]
  4169.  
  4170. VAR
  4171.   Answer : LONGINT;
  4172.  
  4173. BEGIN
  4174.  
  4175.   Answer := Floor( 33, 25 );  { Answer = 33 }
  4176.   Answer := Floor( 17, 25 );  { Answer = 25 }
  4177.  
  4178. END;
  4179.  
  4180. -*)
  4181.  
  4182. Function Floor(              Num       : LONGINT;
  4183.                              Low       : LONGINT      ) : LONGINT;
  4184.  
  4185. BEGIN
  4186.  
  4187.   If ( Num < Low ) Then
  4188.     Floor := Low
  4189.   Else
  4190.     Floor := Num;
  4191.  
  4192. END;  { Floor }
  4193.  
  4194. {────────────────────────────────────────────────────────────────────────────}
  4195.  
  4196. (*-
  4197.  
  4198. [FUNCTION]
  4199.  
  4200. Function FloorR(             Num       : REAL;
  4201.                              Low       : REAL         ) : REAL;
  4202.  
  4203. [PARAMETERS]
  4204.  
  4205. Num         Source Value to Range Check
  4206. Low         Minimum Limit
  4207.  
  4208. [RETURNS]
  4209.  
  4210. The Value Clipped by the Minimum Range
  4211.  
  4212. [DESCRIPTION]
  4213.  
  4214. Range Checks a Value and Clips it so it is at or above a given
  4215. Minimum Range.  The result is returned as a Floating Point Value.
  4216.  
  4217. [SEE-ALSO]
  4218.  
  4219. Range
  4220. RangeR
  4221. Floor
  4222. Ceiling
  4223. CeilingR
  4224.  
  4225. [EXAMPLE]
  4226.  
  4227. VAR
  4228.   Answer : REAL;
  4229.  
  4230. BEGIN
  4231.  
  4232.   Answer := FloorR( 22.5, 20.0 );  { Answer = 22.5 }
  4233.   Answer := FloorR( 17.5, 20.0 );  { Answer = 20.0 }
  4234.  
  4235. END;
  4236.  
  4237. -*)
  4238.  
  4239. Function FloorR(             Num       : REAL;
  4240.                              Low       : REAL         ) : REAL;
  4241.  
  4242. BEGIN
  4243.  
  4244.   If ( Num < Low ) Then
  4245.     FloorR := Low
  4246.   Else
  4247.     FloorR := Num;
  4248.  
  4249. END;  { FloorR }
  4250.  
  4251. {────────────────────────────────────────────────────────────────────────────}
  4252.  
  4253. (*-
  4254.  
  4255. [FUNCTION]
  4256.  
  4257. Function Ceiling(            Num       : LONGINT;
  4258.                              High      : LONGINT      ) : LONGINT;
  4259.  
  4260. [PARAMETERS]
  4261.  
  4262. Num         Source Value to Range Check
  4263. High        Maximum Limit
  4264.  
  4265. [RETURNS]
  4266.  
  4267. The Value Clipped by the Maximum Range
  4268.  
  4269. [DESCRIPTION]
  4270.  
  4271. Range Checks a Value and Clips it so it is at or above a given
  4272. Maximum Range.  The result is returned as a Long Integer Value.
  4273.  
  4274. [SEE-ALSO]
  4275.  
  4276. Range
  4277. RangeR
  4278. Floor
  4279. FloorR
  4280. CeilingR
  4281.  
  4282. [EXAMPLE]
  4283.  
  4284. VAR
  4285.   Answer : LONGINT;
  4286.  
  4287. BEGIN
  4288.  
  4289.   Answer := Ceiling( 32, 40 );  { Answer = 32 }
  4290.   Answer := Ceiling( 45, 40 );  { Answer = 40 }
  4291.  
  4292. END;
  4293.  
  4294. -*)
  4295.  
  4296. Function Ceiling(            Num       : LONGINT;
  4297.                              High      : LONGINT      ) : LONGINT;
  4298.  
  4299. BEGIN
  4300.  
  4301.   If ( Num < High ) Then
  4302.     Ceiling := High
  4303.   Else
  4304.     Ceiling := Num;
  4305.  
  4306. END;  { Ceiling }
  4307.  
  4308. {────────────────────────────────────────────────────────────────────────────}
  4309.  
  4310. (*-
  4311.  
  4312. [FUNCTION]
  4313.  
  4314. Function CeilingR(           Num       : REAL;
  4315.                              High      : REAL         ) : REAL;
  4316.  
  4317. [PARAMETERS]
  4318.  
  4319. Num         Source Value to Range Check
  4320. High        Maximum Limit
  4321.  
  4322. [RETURNS]
  4323.  
  4324. The Value Clipped by the Maximum Range
  4325.  
  4326. [DESCRIPTION]
  4327.  
  4328. Range Checks a Value and Clips it so it is at or above a given
  4329. Maximum Range.  The result is returned as a Floating Point Value.
  4330.  
  4331. [SEE-ALSO]
  4332.  
  4333. Range
  4334. RangeR
  4335. Floor
  4336. FloorR
  4337. Ceiling
  4338.  
  4339. [EXAMPLE]
  4340.  
  4341. VAR
  4342.   Answer : REAL;
  4343.  
  4344. BEGIN
  4345.  
  4346.   Answer := Ceiling(  95.2, 100.0 );  { Answer :=  95.2 }
  4347.   Answer := Ceiling( 104.5, 100.0 );  { Answer := 100.0 }
  4348.  
  4349. END;
  4350.  
  4351. -*)
  4352.  
  4353. Function CeilingR(           Num       : REAL;
  4354.                              High      : REAL         ) : REAL;
  4355.  
  4356. BEGIN
  4357.  
  4358.   If ( Num > High ) Then
  4359.     CeilingR := High
  4360.   Else
  4361.     CeilingR := Num;
  4362.  
  4363. END;  { CeilingR }
  4364.  
  4365. {────────────────────────────────────────────────────────────────────────────}
  4366.  
  4367. (*-
  4368.  
  4369. [FUNCTION]
  4370.  
  4371. Function Sign(               Num       : LONGINT      ) : INTEGER;
  4372.  
  4373. [PARAMETERS]
  4374.  
  4375. Num         Source Value
  4376.  
  4377. [RETURNS]
  4378.  
  4379. The Value's Sign (+1 if >= 0, or -1 if < 0 )
  4380.  
  4381. [DESCRIPTION]
  4382.  
  4383. Determines the sign of the Source Value.  If it is Greater or Equal
  4384. to Zero, then it is +1.  If it is Less than Zero, then it is -1.
  4385. The result is returned as a Long Integer Value.
  4386.  
  4387. [SEE-ALSO]
  4388.  
  4389. [EXAMPLE]
  4390.  
  4391. VAR
  4392.   Answer : INTEGER;
  4393.  
  4394. BEGIN
  4395.  
  4396.   Answer := Sign( 100 );  { Answer = +1 }
  4397.  
  4398. END;
  4399.  
  4400. -*)
  4401.  
  4402. Function Sign(               Num       : LONGINT      ) : INTEGER;
  4403.  
  4404. BEGIN
  4405.  
  4406.   If ( Num < 0 ) Then
  4407.     Sign := -1
  4408.   Else
  4409.     Sign := 1;
  4410.  
  4411. END;  { Sign }
  4412.  
  4413. {────────────────────────────────────────────────────────────────────────────}
  4414.  
  4415. (*-
  4416.  
  4417. [FUNCTION]
  4418.  
  4419. Function SignR(              Num       : LONGINT      ) : INTEGER;
  4420.  
  4421. [PARAMETERS]
  4422.  
  4423. Num         Source Value
  4424.  
  4425. a[RETURNS]
  4426.  
  4427. The Value's Sign (+1 if >= 0, or -1 if < 0 )
  4428.  
  4429. [DESCRIPTION]
  4430.  
  4431. Determines the sign of the Source Value.  If it is Greater or Equal
  4432. to Zero, then it is +1.  If it is Less than Zero, then it is -1.
  4433. The result is returned as a Floating Point Value.
  4434.  
  4435. [SEE-ALSO]
  4436.  
  4437. Sign
  4438.  
  4439. [EXAMPLE]
  4440.  
  4441. VAR
  4442.   Answer : INTEGER;
  4443.  
  4444. BEGIN
  4445.  
  4446.   Answer := SignR( -32.6 );  { Answer = -1 }
  4447.  
  4448. END;
  4449.  
  4450. -*)
  4451.  
  4452. Function SignR(              Num       : REAL         ) : INTEGER;
  4453.  
  4454. BEGIN
  4455.  
  4456.   If ( Num < 0.0 ) Then
  4457.     SignR := -1
  4458.   Else
  4459.     SignR := 1;
  4460.  
  4461. END;  { SignR }
  4462.  
  4463.  
  4464. {────────────────────────────────────────────────────────────────────────────}
  4465.  
  4466. (*-
  4467.  
  4468. [FUNCTION]
  4469.  
  4470. Function QuadraticPlus(      A         : LONGINT;
  4471.                              B         : LONGINT;
  4472.                              C         : LONGINT      ) : REAL;
  4473.  
  4474. [PARAMETERS]
  4475.  
  4476. A           1st Polynomial Position Value
  4477. B           2nd Polynomial Position Value
  4478. C           3rd Polynomial Position Value
  4479.  
  4480. [RETURNS]
  4481.  
  4482. Positive Quadratic Solution in Terms of X
  4483.  
  4484. [DESCRIPTION]
  4485.  
  4486. Computes the Quadratic of y = Ax^2 + Bx + C in terms of X with
  4487. only the Positive Answer returned.
  4488.  
  4489. [SEE-ALSO]
  4490.  
  4491. QuadraticNeg
  4492.  
  4493. [EXAMPLE]
  4494.  
  4495. VAR
  4496.   X : REAL;
  4497.  
  4498. BEGIN
  4499.  
  4500.   X := QuadraticPlus( 2, 8, 4 );  { X = -0.5858 }
  4501.  
  4502. END;
  4503.  
  4504. -*)
  4505.  
  4506. Function QuadraticPlus(      A         : LONGINT;
  4507.                              B         : LONGINT;
  4508.                              C         : LONGINT      ) : REAL;
  4509.  
  4510. Var
  4511.  
  4512.   X : REAL;
  4513.  
  4514. BEGIN
  4515.  
  4516.   X := Sqr(B) - (4 * A * C);
  4517.  
  4518.   If (X < 0) Then
  4519.     QuadraticPlus := 0
  4520.   Else
  4521.     QuadraticPlus := (-B + Sqrt(X)) / (2 * A);
  4522.  
  4523. END;  { Quadratic }
  4524.  
  4525.  
  4526. {────────────────────────────────────────────────────────────────────────────}
  4527.  
  4528. (*-
  4529.  
  4530. [FUNCTION]
  4531.  
  4532. Function QuadraticNeg(       A         : LONGINT;
  4533.                              B         : LONGINT;
  4534.                              C         : LONGINT      ) : REAL;
  4535.  
  4536. [PARAMETERS]
  4537.  
  4538. A           1st Polynomial Position Value
  4539. B           2nd Polynomial Position Value
  4540. C           3rd Polynomial Position Value
  4541.  
  4542. [RETURNS]
  4543.  
  4544. Negative Quadratic Solution in Terms of X
  4545.  
  4546. [DESCRIPTION]
  4547.  
  4548. Computes the Quadratic of y = Ax^2 + Bx + C in terms of X with
  4549. only the Negative Answer returned.
  4550.  
  4551. [SEE-ALSO]
  4552.  
  4553. QuadraticPlus
  4554.  
  4555. [EXAMPLE]
  4556.  
  4557. VAR
  4558.   X : REAL;
  4559.  
  4560. BEGIN
  4561.  
  4562.   X := QuadraticNeg( 2, 8, 4 );  { X = -3.4142}
  4563.  
  4564. END;
  4565.  
  4566. -*)
  4567.  
  4568. Function QuadraticNeg(       A         : LONGINT;
  4569.                              B         : LONGINT;
  4570.                              C         : LONGINT      ) : REAL;
  4571.  
  4572. Var
  4573.  
  4574.   X : REAL;
  4575.  
  4576. BEGIN
  4577.  
  4578.   X := Sqr(B) - (4 * A * C);
  4579.  
  4580.   If (X < 0) Then
  4581.     QuadraticNeg := 0
  4582.   Else
  4583.     QuadraticNeg := (-B - Sqrt(X)) / (2 * A);
  4584.  
  4585. END;  { QuadraticNeg }
  4586.  
  4587.  
  4588. {────────────────────────────────────────────────────────────────────────────}
  4589.  
  4590. (*-
  4591.  
  4592. [FUNCTION]
  4593.  
  4594. Function Factorial(           N         : BYTE         ) : REAL;
  4595.  
  4596.  
  4597. [PARAMETERS]
  4598.  
  4599. N           Natural Number to Factor
  4600.  
  4601. [RETURNS]
  4602.  
  4603. Factorial Product
  4604.  
  4605. [DESCRIPTION]
  4606.  
  4607. Returns the Factorial Product of a Number.  N=33 is the Maximum
  4608. for real type answers.
  4609.  
  4610. [SEE-ALSO]
  4611.  
  4612. [EXAMPLE]
  4613.  
  4614. VAR
  4615.   Answer : REAL;
  4616.  
  4617. BEGIN
  4618.  
  4619.   Answer := Factorial(   2 );  { Answer =         2.0000 }
  4620.   Answer := Factorial(   4 );  { Answer =        24.0000 }
  4621.   Answer := Factorial(   6 );  { Answer =       720.0000 }
  4622.   Answer := Factorial(  12 );  { Answer = 479001600.0000 }
  4623.   Answer := Factorial(  36 );  { Answer =         1.0000 }
  4624.   Answer := Factorial( 100 );  { Answer =         1.0000 }
  4625.  
  4626. END;
  4627.  
  4628. -*)
  4629.  
  4630. Function Factorial(           N         : BYTE         ) : REAL;
  4631.  
  4632. Var
  4633.  
  4634.   Result : REAL;
  4635.   Loop   : BYTE;
  4636.  
  4637. BEGIN
  4638.  
  4639.   If (N = 0) Then
  4640.     Factorial := 1
  4641.   Else
  4642.   BEGIN
  4643.  
  4644.     Result := N;
  4645.     For Loop := (N - 1) DownTo 2 Do
  4646.       Result := Result * Loop;
  4647.  
  4648.     Factorial := Result;
  4649.  
  4650.   END;
  4651.  
  4652. END;  { Factorial }
  4653.  
  4654.  
  4655. {────────────────────────────────────────────────────────────────────────────}
  4656.  
  4657. (*-
  4658.  
  4659. [FUNCTION]
  4660.  
  4661. Function Permu(              N         : BYTE;
  4662.                              R         : BYTE         ) : REAL;
  4663.  
  4664. [PARAMETERS]
  4665.  
  4666. N           Number of Objects to Use
  4667. R           Use R at a Time (for each Permutation)
  4668.  
  4669. [RETURNS]
  4670.  
  4671. Permutation Product
  4672.  
  4673. [DESCRIPTION]
  4674.  
  4675. Returns the number of permutations of "N" Objects taken "R"
  4676. at a time, which means a listing or an arrangement of R of
  4677. the Objects in a definite order, where R <= N.  The number
  4678. of such arrangements is denoted by P(n,r).
  4679.  
  4680. [SEE-ALSO]
  4681.  
  4682. Combo
  4683.  
  4684. [EXAMPLE]
  4685.  
  4686. VAR
  4687.   Answer : REAL;
  4688.  
  4689. BEGIN
  4690.  
  4691.   Answer := Permu( 12, 2 );  { Answer =   134 }
  4692.   Answer := Permu( 12, 3 );  { Answer =  1340 }
  4693.   Answer := Permu( 12, 4 );  { Answer = 11880 }
  4694.   Answer := Permu( 12, 5 );  { Answer = 95040 }
  4695.  
  4696. END;
  4697.  
  4698. -*)
  4699.  
  4700. Function Permu(              N         : BYTE;
  4701.                              R         : BYTE         ) : REAL;
  4702.  
  4703. BEGIN
  4704.  
  4705.   Permu := Factorial(N) / Factorial(N - R);
  4706.  
  4707. END;  { Permu }
  4708.  
  4709.  
  4710. {────────────────────────────────────────────────────────────────────────────}
  4711.  
  4712. (*-
  4713.  
  4714. [FUNCTION]
  4715.  
  4716. Function Combo(              N         : BYTE;
  4717.                              R         : BYTE         ) : REAL;
  4718.  
  4719. [PARAMETERS]
  4720.  
  4721. N           Number of Objects to Use
  4722. R           Use R at a Time (for each combination)
  4723.  
  4724. [RETURNS]
  4725.  
  4726. Combination Product
  4727.  
  4728. [DESCRIPTION]
  4729.  
  4730. Returns the selection or subset of "R" Objects from a set of
  4731. "N" Objects, where R <= N.  The number of such combinations
  4732. is denoted C(n,r).
  4733.  
  4734. [SEE-ALSO]
  4735.  
  4736. Permu
  4737.  
  4738. [EXAMPLE]
  4739.  
  4740. VAR
  4741.   Answer : REAL;
  4742.  
  4743. BEGIN
  4744.  
  4745.   Answer := Combo( 12, 2 );  { Answer =  66 }
  4746.   Answer := Combo( 12, 3 );  { Answer = 220 }
  4747.   Answer := Combo( 12, 4 );  { Answer = 495 }
  4748.   Answer := Combo( 12, 5 );  { Answer = 792 }
  4749.  
  4750.  
  4751. END;
  4752.  
  4753. -*)
  4754.  
  4755. Function Combo(              N         : BYTE;
  4756.                              R         : BYTE         ) : REAL;
  4757.  
  4758. BEGIN
  4759.  
  4760.   Combo := Factorial(N) / ( Factorial(R) * Factorial(N - R) );
  4761.  
  4762. END;  { Combo }
  4763.  
  4764.  
  4765. {────────────────────────────────────────────────────────────────────────────}
  4766.  
  4767. (*-
  4768.  
  4769. [FUNCTION]
  4770.  
  4771. Function Prime(              N         : LONGINT      ) : BOOLEAN;
  4772.  
  4773. [PARAMETERS]
  4774.  
  4775. N           Number to Check that it is a Prime Number
  4776.  
  4777. [RETURNS]
  4778.  
  4779. Whether or not this Number was a Prime Nmuber
  4780.  
  4781. [DESCRIPTION]
  4782.  
  4783. Determines if this number was a Prime Number and returns the result.
  4784.  
  4785. [SEE-ALSO]
  4786.  
  4787. [EXAMPLE]
  4788.  
  4789. BEGIN
  4790.  
  4791.   WriteLn( 'Prime( 3)=',Prime( 3) );  { TRUE  }
  4792.   WriteLn( 'Prime( 6)=',Prime( 6) );  { FALSE }
  4793.   WriteLn( 'Prime(15)=',Prime(15) );  { FALSE }
  4794.   WriteLn( 'Prime(23)=',Prime(23) );  { TRUE  }
  4795.  
  4796. END;
  4797.  
  4798. -*)
  4799.  
  4800. Function Prime(              N         : LONGINT      ) : BOOLEAN;
  4801.  
  4802. Var
  4803.  
  4804.   C : LONGINT;
  4805.   S : REAL;
  4806.   X : BOOLEAN;
  4807.  
  4808. BEGIN
  4809.  
  4810.   N := Abs(N);
  4811.   S := Sqrt(N);
  4812.  
  4813.   X := ( (N <= 2) OR ( Odd(N) ) AND (S <> Int(S) ) );
  4814.  
  4815.   If X Then
  4816.   BEGIN
  4817.  
  4818.     C := 3;
  4819.  
  4820.     While (X AND (C < Int(S))) Do
  4821.     BEGIN
  4822.  
  4823.       X := ((N MOD C) > 0);
  4824.       Inc(C, 2);
  4825.  
  4826.     END;  { While X }
  4827.  
  4828.   END;  { If X }
  4829.  
  4830.   Prime := X;
  4831.  
  4832. END; { Prime }
  4833.  
  4834. {────────────────────────────────────────────────────────────────────────────}
  4835.  
  4836. (*-
  4837.  
  4838. [FUNCTION]
  4839.  
  4840. Function GCF(                A         : LONGINT;
  4841.                              B         : LONGINT      ) : LONGINT;
  4842.  
  4843. [PARAMETERS]
  4844.  
  4845. A           1st Source Number
  4846. B           2nd Source Number
  4847.  
  4848. [RETURNS]
  4849.  
  4850. The Greatest Common Factor of the two numbers.
  4851.  
  4852. [DESCRIPTION]
  4853.  
  4854. Determines the Greatest Common Factor between the two given
  4855. numbers.
  4856.  
  4857. [SEE-ALSO]
  4858.  
  4859. LCM
  4860.  
  4861. [EXAMPLE]
  4862.  
  4863. VAR
  4864.   Answer : LONGINT;
  4865.  
  4866. BEGIN
  4867.  
  4868.   Answer := GCF( 6, 9 );
  4869.  
  4870.   { Answer := 3 }
  4871.  
  4872. END;
  4873.  
  4874. -*)
  4875.  
  4876. Function GCF(                A         : LONGINT;
  4877.                              B         : LONGINT      ) : LONGINT;
  4878.  
  4879. Var
  4880.  
  4881.   X    : LONGINT;
  4882.   High : LONGINT;
  4883.  
  4884. BEGIN
  4885.  
  4886.   High := 1;
  4887.  
  4888.   For X := 2 to A Do
  4889.     If (A MOD X = 0) AND
  4890.        (B MOD X = 0) Then
  4891.       High := X;
  4892.  
  4893.   GCF := High;
  4894.  
  4895. END; { GCF }
  4896.  
  4897. {────────────────────────────────────────────────────────────────────────────}
  4898.  
  4899. (*-
  4900.  
  4901. [FUNCTION]
  4902.  
  4903. Function LCM(                A         : LONGINT;
  4904.                              B         : LONGINT      ) : LONGINT;
  4905.  
  4906. [PARAMETERS]
  4907.  
  4908. A           1st Source Number
  4909. B           2nd Source Number
  4910.  
  4911. [RETURNS]
  4912.  
  4913. The Least Common Multiple of the two numbers.
  4914.  
  4915. [DESCRIPTION]
  4916.  
  4917. Determines the Least Common Multiple between the two given
  4918. Numbers.
  4919.  
  4920. [SEE-ALSO]
  4921.  
  4922. GCF
  4923.  
  4924. [EXAMPLE]
  4925.  
  4926. VAR
  4927.   Answer : LONGINT;
  4928.  
  4929. BEGIN
  4930.  
  4931.   Answer := LCM( 36, 54 );
  4932.  
  4933.   { Answer = 108 }
  4934.  
  4935. END;
  4936.  
  4937. -*)
  4938.  
  4939. Function LCM(                A         : LONGINT;
  4940.                              B         : LONGINT      ) : LONGINT;
  4941.  
  4942. Var
  4943.  
  4944.   Incre : LONGINT;
  4945.   Low   : LONGINT;
  4946.   High  : LONGINT;
  4947.  
  4948. BEGIN
  4949.  
  4950.   If (A > B) Then
  4951.   BEGIN
  4952.  
  4953.     High := A;
  4954.     Low := B;
  4955.  
  4956.   END
  4957.   Else
  4958.   BEGIN
  4959.  
  4960.     High := B;
  4961.     Low := A;
  4962.  
  4963.   END;
  4964.  
  4965.   Incre := High;
  4966.  
  4967.   While (High MOD Low <> 0) Do
  4968.     High := High + Incre;
  4969.  
  4970.   LCM := High;
  4971.  
  4972. END; { LCM }
  4973.  
  4974. {────────────────────────────────────────────────────────────────────────────}
  4975.  
  4976. (*-
  4977.  
  4978. [FUNCTION]
  4979.  
  4980. Procedure LoadArrayR( VAR Arr : PArrayR;
  4981.                           Idx : WORD;
  4982.                           R   : REAL  );
  4983.  
  4984. [PARAMETERS]
  4985.  
  4986. Arr         Pointer to Linear Data Array
  4987. Idx         Number of Elements in the Data Array
  4988. R           Value to set Element to
  4989.  
  4990. [RETURNS]
  4991.  
  4992. (Function : None)
  4993. (VAR      : Pointer to Linear Data Array w/ Data Modified)
  4994.  
  4995. [DESCRIPTION]
  4996.  
  4997. Loads the Data Array's Indexed Element to the Provided Value
  4998. Use this Procedure to quickly Load the Data Array Values for the
  4999. Coordinate Record at a specific Index.
  5000.  
  5001. [SEE-ALSO]
  5002.  
  5003. LoadArrayRXY
  5004.  
  5005. [EXAMPLE]
  5006.  
  5007. VAR
  5008.   Arr : PArrayR;
  5009.  
  5010. BEGIN
  5011.  
  5012.   LoadArrayR( Arr, 3, 97.5 );
  5013.  
  5014.   { Element in "Arr" at Index 3 now equals 97.5 }
  5015.  
  5016. END;
  5017.  
  5018. -*)
  5019.  
  5020. Procedure LoadArrayR( VAR Arr : PArrayR;
  5021.                           Idx : WORD;
  5022.                           R   : REAL  );
  5023. BEGIN
  5024.  
  5025.   Arr^[Idx] := R;
  5026.  
  5027. END;  { LoadArrayR }
  5028.  
  5029. {────────────────────────────────────────────────────────────────────────────}
  5030.  
  5031. (*-
  5032.  
  5033. [FUNCTION]
  5034.  
  5035. Procedure LoadArrayRXY( VAR Arr : PArray2R;
  5036.                             Idx : WORD;
  5037.                             X   : REAL;
  5038.                             Y   : REAL  );
  5039.  
  5040. [PARAMETERS]
  5041.  
  5042. Arr         Pointer to Linear Data Array or Coordinates
  5043. Idx         Number of Elements in the Data Array
  5044. X           Value to Set X-Element To
  5045. Y           Value to Set Y-Element To
  5046.  
  5047. [RETURNS]
  5048.  
  5049. (Function : None)
  5050. (VAR      : Pointer to Linear Data Array w/ Data Modified)
  5051.  
  5052. [DESCRIPTION]
  5053.  
  5054. Loads the Data Array's Indexed Elements (X & Y) to the Provided Values.
  5055. Use this Procedure to quickly Load the Data Array Values for the
  5056. Coordinate Record at a specific Index.
  5057.  
  5058. [SEE-ALSO]
  5059.  
  5060. LoadArrayR
  5061.  
  5062. [EXAMPLE]
  5063.  
  5064. VAR
  5065.   Arr : PArray2R;
  5066.  
  5067. BEGIN
  5068.  
  5069.   LoadArrayRXY( Arr, 5, 2.5, 3.7 );
  5070.  
  5071.   { Record in "Arr" at Index now contains X=2.5 and Y=3.7 }
  5072.  
  5073. END;
  5074.  
  5075. -*)
  5076.  
  5077. Procedure LoadArrayRXY( VAR Arr : PArray2R;
  5078.                             Idx : WORD;
  5079.                             X   : REAL;
  5080.                             Y   : REAL  );
  5081. BEGIN
  5082.  
  5083.   Arr^[Idx].X := X;
  5084.   Arr^[Idx].Y := Y;
  5085.  
  5086. END;  { LoadArrayRXY }
  5087.  
  5088. {────────────────────────────────────────────────────────────────────────────}
  5089.  
  5090. (*-
  5091.  
  5092. [FUNCTION]
  5093.  
  5094. Procedure MeanStdDev( Arr    : PArrayR;  { Data Array }
  5095.                       Cnt    : INTEGER;  { Data Count }
  5096.                   VAR Mean   : REAL;     { Mean }
  5097.                   VAR StdDev : REAL );   { Standard Deviation }
  5098.  
  5099. [PARAMETERS]
  5100.  
  5101. Arr         Pointer to Linear Data Array
  5102. Cnt         Number of Elements in Linear Data Array
  5103. Mean        VAR Returned Mean Value of Dispursion
  5104. StdDev      VAR Returned Standard Deviation of Dispursion
  5105.  
  5106. [RETURNS]
  5107.  
  5108. (Function : None)
  5109. (VAR      : [Mean] Returned Mean Value of Dispursion)
  5110. (VAR      : [StdDev] Returned Standard Deviation of Dispursion)
  5111.  
  5112. [DESCRIPTION]
  5113.  
  5114. Takes a List of Values and determines what the Mean [Middle] Dispersion
  5115. Value is and what the Dispursion Deviation is.
  5116.  
  5117. [SEE-ALSO]
  5118.  
  5119. [EXAMPLE]
  5120.  
  5121. VAR
  5122.   Arr    : PArrayR;
  5123.   Mean,
  5124.   StdDev : REAL;
  5125.  
  5126. BEGIN
  5127.   LoadArray( Arr, 1, 1 );
  5128.   LoadArray( Arr, 2, 2 );
  5129.   LoadArray( Arr, 3, 3 );
  5130.   LoadArray( Arr, 4, 4 );
  5131.   LoadArray( Arr, 5, 5 );
  5132.  
  5133.   MeanStdDev( Arr, 5, Mean, StdDev );
  5134.  
  5135.   { Mean = 3.000,  StdDev = 1.5811 }
  5136.  
  5137. END.
  5138.  
  5139. -*)
  5140.  
  5141. Procedure MeanStdDev( Arr    : PArrayR;  { Data Array }
  5142.                       Cnt    : INTEGER;  { Data Count }
  5143.                   VAR Mean   : REAL;     { Mean }
  5144.                   VAR StdDev : REAL );   { Standard Deviation }
  5145. VAR
  5146.   I     : INTEGER;
  5147.   SumX,
  5148.   SumSq : REAL;
  5149.  
  5150. BEGIN
  5151.   SumX  := 0.0;
  5152.   SumSq := 0.0;
  5153.  
  5154.   For i := 1 to Cnt Do
  5155.   BEGIN
  5156.     SumX  := SumX  + Arr^[i];
  5157.     SumSq := SumSq + Arr^[i] * Arr^[i];
  5158.   END;  { For i }
  5159.  
  5160.   Mean   := SumX / Cnt;
  5161.   StdDev := Sqrt( (SumSq - Sqr(SumX) / Cnt) / (Cnt-1) );
  5162.  
  5163. END;  { MeanStdDev }
  5164.  
  5165.  
  5166. {────────────────────────────────────────────────────────────────────────────}
  5167.  
  5168. (*-
  5169.  
  5170. [FUNCTION]
  5171.  
  5172. Function Sigma( Arr : PArrayR;
  5173.                 Cnt : INTEGER ) : REAL;
  5174.  
  5175. [PARAMETERS]
  5176.  
  5177. Arr         Pointer to Linear Data Array
  5178. Cnt         Number of Elements in Data Array
  5179.  
  5180. [RETURNS]
  5181.  
  5182. The Sigma Summation of the Data Values
  5183.  
  5184. [DESCRIPTION]
  5185.  
  5186. Calculates the Sigma Summation of the Data Provided.
  5187.  
  5188. [SEE-ALSO]
  5189.  
  5190. [EXAMPLE]
  5191.  
  5192. -*)
  5193.  
  5194. Function Sigma( Arr : PArrayR;
  5195.                 Cnt : INTEGER ) : REAL;
  5196. VAR
  5197.   Sum : REAL;
  5198.   I   : INTEGER;
  5199. BEGIN
  5200.   Sum := 0.0;
  5201.   For I := 1 to Cnt Do
  5202.     Sum := Sum + Arr^[i];
  5203.   Sigma := Sum;
  5204. END;  { Sigma }
  5205.  
  5206. {────────────────────────────────────────────────────────────────────────────}
  5207.  
  5208. (*-
  5209.  
  5210. [FUNCTION]
  5211.  
  5212. Procedure LeastSqr( Arr   : PArray2R; { Data Array }
  5213.                     Cnt   : INTEGER;  { Data Count }
  5214.                 VAR YInt  : REAL;     { Y-Intercept }
  5215.                 VAR Slope : REAL );   { Slope }
  5216.  
  5217. [PARAMETERS]
  5218.  
  5219. Arr         Pointer to Linear Array of Point Coordinate Data
  5220. Cnt         Number of Coordinates in Array
  5221. YInt        VAR Returned Y-Intercept Solution
  5222. Slope       VAR Returned Line Slope Solution
  5223.  
  5224. [RETURNS]
  5225.  
  5226. (Function : None)
  5227. (VAR      : [YInt] Returned Y-Intercept Solution)
  5228. (VAR      : [Slope] Returned Line Slope Solution)
  5229.  
  5230. [DESCRIPTION]
  5231.  
  5232. Does a Least Squares Line Fitting Algorithm on the Point Data
  5233. and determines the Line Solution's Y-Intercept and Slope (expressed
  5234. as a Tangent Value - ArcTan returns Angle).
  5235.  
  5236. To Construct resulting Line use the Algorithm
  5237.  
  5238.               y = Slope * x + YInt;
  5239.  
  5240. [SEE-ALSO]
  5241.  
  5242. (None)
  5243.  
  5244. [EXAMPLES]
  5245.  
  5246. VAR
  5247.   Arr   : PArray2RA;
  5248.   YInt,
  5249.   Slope : REAL;
  5250.  
  5251. BEGIN
  5252.  
  5253.   LoadArrayRXY( Arr, 1, 1, 2 );
  5254.   LoadArrayRXY( Arr, 2, 2, 3 );
  5255.   LoadArrayRXY( Arr, 3, 3, 4 );
  5256.   LoadArrayRXY( Arr, 4, 4, 5 );
  5257.   LoadArrayRXY( Arr, 5, 5, 6 );
  5258.   LoadArrayRXY( Arr, 6, 6, 7 );
  5259.  
  5260.   LeastSqr( Arr, 6, YInt, Slope );
  5261.  
  5262.   { YInt = 1.0, Slope = 1.0[Tan] (45deg) }
  5263.  
  5264. END;
  5265.  
  5266. -*)
  5267.  
  5268. Procedure LeastSqr( Arr   : PArray2R; { Data Array }
  5269.                     Cnt   : INTEGER;  { Data Count }
  5270.                 VAR YInt  : REAL;     { Y-Intercept }
  5271.                 VAR Slope : REAL );   { Slope }
  5272. VAR
  5273. {  Tmp         : PArrayR; }
  5274.   i           : INTEGER;
  5275.   SumX,SumY,
  5276.   SumXY,X,Y,
  5277.   SumX2,SumY2,
  5278.   SXX,SXY,SYY : REAL;
  5279.  
  5280. BEGIN
  5281.   YInt  := 0.0;
  5282.   Slope := 0.0;
  5283.  
  5284.   SumX  := 0.0;
  5285.   SumY  := 0.0;
  5286.   SumXY := 0.0;
  5287.   SumX2 := 0.0;
  5288.   SumY2 := 0.0;
  5289.  
  5290.   For i := 1 to Cnt Do  { Sigma Summation }
  5291.   BEGIN
  5292.     X := Arr^[i].X;
  5293.     Y := Arr^[i].Y;
  5294.     SumX  := SumX  + X;
  5295.     SumY  := SumY  + Y;
  5296.     SumXY := SumXY + X*Y;
  5297.     SumX2 := SumX2 + X*X;
  5298.     SumY2 := SumY2 + Y*Y;
  5299.   END;  { For i }
  5300.  
  5301.   SXX := SumX2 - SumX * SumX / Cnt;
  5302.   SXY := SumXY - SumX * SumY / Cnt;
  5303.   SYY := SumY2 - SumY * SumY / Cnt;
  5304.  
  5305.   Slope := SXY / SXX;
  5306.   YInt  := ( (SumX2 * SumY - SumX * SumXY) / Cnt) / SXX;
  5307.  
  5308.   {--------------------------------------}
  5309.   { Calculate Sample Line                }
  5310.   {--------------------------------------}
  5311.   { For i := 1 to Cnt Do                 }
  5312.   {   Line[i] := YInt + Slope * Arr^[i]; }
  5313.   {--------------------------------------}
  5314.  
  5315. END;  { LeastSqr }
  5316.  
  5317. {────────────────────────────────────────────────────────────────────────────}
  5318.  
  5319. (*-
  5320.  
  5321. [FUNCTION]
  5322.  
  5323. Function  Integrate(         A         : REAL;
  5324.                              B         : REAL;
  5325.                              Func      : PXFunc;
  5326.                              N         : WORD;
  5327.                              MaxErr    : REAL         ) : REAL;
  5328.  
  5329. [PARAMETERS]
  5330.  
  5331. A               Left/Lower limit of interval.
  5332. B               Right/Upper limit of interval.
  5333. Func            Function to call for evaluation of f(x).
  5334. N               Number of subintervals to evaluate.
  5335. MaxErr          Maximum error tolerance in answer.
  5336.  
  5337. [RETURNS]
  5338.  
  5339. REAL            Definite integral of f(x).
  5340.  
  5341. [DESCRIPTION]
  5342.  
  5343. This approximation technique of evaluating an antiderivative is useful
  5344. when the antiderivative is not an elementary function (and the Fundamental
  5345. Theorem of Calculus can not be applied).
  5346.  
  5347. Letting f be continuous on [a, b].  Simpson's Rule for approximating
  5348. the definite integral f(x)dx is given by:
  5349.  
  5350.    b-a
  5351.    --- * [f(X0) + 4f(X1) + 2f(X2) + 4f(X3) + ... + 4f(Xn-1) + f(Xn)]
  5352.    3n
  5353.  
  5354. Moreover, as n -> ∞, the approximation approaches the indefinate integral.
  5355.  
  5356. If f has a continuous fourth derivative on [a, b], then the error E in
  5357. approximating the definite integral f(x)dx by Simpson's Rule is:
  5358.  
  5359.    E <= ( (b - a)^5 / 180n^4 ) * ( max │f''''(x)│ ), a <= x <= b
  5360.  
  5361. [SEE-ALSO]
  5362.  
  5363. [EXAMPLES]
  5364.  
  5365. Function FuncX(X : REAL) : REAL; Far;
  5366. BEGIN
  5367.  
  5368.   FuncX := 4 / (1 + Sqr(X));
  5369.  
  5370. END;
  5371.  
  5372. Var
  5373.  
  5374.   Answer : REAL;
  5375.  
  5376. BEGIN
  5377.  
  5378.   Answer := Integrate( 0, 1, @FuncX, 6, cTolerance );
  5379.   WriteLn( Answer:12:12 );
  5380.  
  5381.   { Answer = 3.14159265360 }
  5382.  
  5383. END.
  5384.  
  5385. -*)
  5386.  
  5387. Function  Integrate(         A         : REAL;
  5388.                              B         : REAL;
  5389.                              Func      : PXFunc;
  5390.                              N         : WORD;
  5391.                              MaxErr    : REAL         ) : REAL;
  5392.  
  5393. Var
  5394.  
  5395.   FX  : FXFunc;
  5396.  
  5397.   {────────────────────────────────────────────────────────────────────────}
  5398.   { The following two functions are free, and not sold in VDL, but instead }
  5399.   { distributed with VDL.                                                  }
  5400.   {────────────────────────────────────────────────────────────────────────}
  5401.  
  5402.   Procedure Trapezoidal(     A         : REAL;
  5403.                              B         : REAL;
  5404.                          Var Integ     : REAL;
  5405.                              N         : INTEGER );
  5406.  
  5407.   Var
  5408.  
  5409.     J      : INTEGER;
  5410.     X      : REAL;
  5411.     Sum    : REAL;
  5412.     DeltaX : REAL;
  5413.     RIter  : REAL;
  5414.     WIter  : WORD;
  5415.  
  5416.   BEGIN
  5417.  
  5418.     WIter := 1 SHL (N-2);
  5419.     RIter := WIter;
  5420.  
  5421.     If (N = 1) Then
  5422.  
  5423.       {------------------------}
  5424.       { area of end trapezoids }
  5425.       {------------------------}
  5426.  
  5427.       Integ := (B - A) / 2 * (FX(A) + FX(B))
  5428.  
  5429.     Else
  5430.     BEGIN
  5431.  
  5432.       {----------------------}
  5433.       { area + Nth trapezoid }
  5434.       {----------------------}
  5435.  
  5436.       DeltaX := (B - A) / RIter;
  5437.       X      := (DeltaX / 2) + A;
  5438.       Sum    := 0.0;
  5439.  
  5440.       For J := 1 to WIter Do
  5441.       BEGIN
  5442.  
  5443.         Sum := Sum + FX(X);
  5444.         X   := X + DeltaX;
  5445.  
  5446.       END;
  5447.  
  5448.       Integ := (Integ + (B - A) * Sum / RIter) / 2;
  5449.  
  5450.     END;
  5451.  
  5452.   END;
  5453.  
  5454.   {────────────────────────────────────────────────────────────────────────}
  5455.  
  5456.   Procedure Simpson(         A         : REAL;
  5457.                              B         : REAL;
  5458.                          Var Integ     : REAL    );
  5459.  
  5460.   Label Done;
  5461.  
  5462.   Var
  5463.  
  5464.     L1        : WORD;
  5465.     Trapz     : REAL;
  5466.     SaveTrapz : REAL;
  5467.     SaveInteg : REAL;
  5468.  
  5469.   BEGIN
  5470.  
  5471.     SaveTrapz := MaxErr;
  5472.     SaveInteg := MaxErr;
  5473.  
  5474.     For L1 := 1 to N Do
  5475.     BEGIN
  5476.  
  5477.       Trapezoidal(A, B, Trapz, L1);
  5478.       Integ := (4.0 * Trapz - SaveTrapz) / 3.0;
  5479.  
  5480.       If ( Abs(Integ - SaveInteg) < MaxErr * Abs(SaveInteg) ) Then
  5481.         Goto Done;
  5482.  
  5483.       SaveInteg := Integ;
  5484.       SaveTrapz := Trapz;
  5485.  
  5486.     END;
  5487.  
  5488.     Done:
  5489.  
  5490.   END;
  5491.  
  5492.   {────────────────────────────────────────────────────────────────────────}
  5493.  
  5494. Var
  5495.  
  5496.   Answer : REAL;
  5497.  
  5498. BEGIN
  5499.  
  5500.    FX := FXFunc( Func );
  5501.    Simpson( A, B, Answer );
  5502.    Integrate := Answer;
  5503.  
  5504. END;
  5505.  
  5506. {────────────────────────────────────────────────────────────────────────────}
  5507. {────────────────────────────────────────────────────────────────────────────}
  5508. {────────────────────────────────────────────────────────────────────────────}
  5509.  
  5510. BEGIN
  5511. END.
  5512.