matlib_.pas

Delphi math processing compononets and sources. Release.

{
@abstract(EBK&NVS Library for Turbo Pascal: Math Library.
          It is mainly obsolete because of expansion of math unit)
@author(Nikolai V. Shokhirev <[e-mail]> <[e-mail]>)
@author(Eugene B. Krissinel <[e-mail]> <[e-mail]>)
@created(02.02.1991)
@lastmod(10.10.2002)
This is a temporary publication (reduced variant), will be updated later
㎞ikolai V. Shokhirev, 2002
}
unit  MatLib_;

interface

uses
  MathTypes;

function Min(i1,i2: IntType): IntType;

function Max(i1,i2: IntType): IntType;

function AMax1( A,B: RealType):  RealType;

function Sign(X: IntType): IntType;

function Sign1(X: RealType): RealType;

function sign2( a, b: RealType): RealType;

function SrX2Y2( X,Y: RealType): RealType;

function Log10(X: RealType): RealType;

function Angle(X,Y: RealType): RealType;

function ArcSin(X: RealType): RealType;

function Power(R: RealType; p: IntType): RealType;

function Power1(R,p: RealType): RealType;

function Combinations(m, n: IntType): IntType;

function Fac(m: IntType): longint;

{  ------------------------------------------------------------  }
implementation

var
  ln10: RealType;

function Min(i1,i2: IntType): IntType;
begin
  if i1>i2  then  result := i2
            else  result := i1;
end;

function Max(i1,i2: IntType): IntType;
begin
  if i1>i2  then  result := i1
            else  result := i2;
end;

function AMax1( A,B: RealType):  RealType;
begin
  if  A>B  then   result := A
           else   result := B;
end;

function Sign(X: IntType):  IntType;
begin
  if X > 0 then
    result := 1
  else
    if X < 0 then
      result := -1
    else
      result := 0;
end;

function Sign1(X: RealType): RealType;
begin
  if X > 0.0 then
    result := 1.0
  else
    if X < 0.0 then
      result := -1.0
    else
      result := 0.0;
end;

function sign2( a, b: RealType): RealType;
begin
  if b < 0.0 then result := - abs(a)
             else result :=   abs(a) ;
end;{ of sign2 }

{ SrX2Y2 = sqrt(X**2+Y**2) }
function SrX2Y2( X,Y: RealType):  RealType;
var  Ax,Ay:  REalType;
begin
  Ax := abs(X);
  Ay := abs(Y);
  if  Ay>Ax  then
    result := Ay*sqrt(sqr(X/Y)+1.0)
  else if Ay=Ax  then
    result := Ax*sqrt(2.0)
  else
    result := Ax*sqrt(sqr(Y/X)+1.0);
end;

function Log10(X: RealType): RealType;
begin
  Log10 := ln(X)/ln10;
end;

{@lastmod(01.01.1991)}
function Angle(X,Y: RealType): RealType;
var
  A   : RealType;
begin
  if X=0.0       then    A := Pi/2.0
  else if Y=0.0  then    A := 0.0
  else if X>Y    then    A := arctan(Y/X )
                 else    A := Pi/2.0-arctan( X/Y );
  if X<0.0  then  A := Pi-A;
  if Y<0.0  then  A := -A;
  result := A;
end;

function ArcSin(X: RealType): RealType;
var
  R,S,Y  : RealType;
  l      : longint;
begin
  if  X>=1.0    then    ArcSin := Pi/2.0
  else if X<=-1.0 then  ArcSin := -Pi/2.0
  else
    begin
      if abs(X)<0.71  then  Y := X
                      else  Y := sqrt(1.0-sqr(X));
      S := 0.0;
      R := Y;
      l := 1;
      repeat
        S := S+R;
        R := R*sqr(Y*l)/((l+1)*(l+2));
        l := l+2;
      until (abs(R)<1.0e-35) or
            (abs(R)<=1.0e-16*abs(S));
      S := S+R;
      if abs(X-Y)>1.0e-12  then
        begin
          if X>0.0  then   S := Pi/2.0-S
                    else   S := -Pi/2.0+S;
        end;
      ArcSin := S;
    end;
end;

function Power(R: RealType;  p: IntType): RealType;
var
  n : IntType;
  z,x : RealType;
begin
  n := abs(p);
  z := 1.0;
  x := R;
  while n<>0  do
    begin
      if odd(n)  then   z := z*x;
      x := sqr(x);
      n := n div 2;
    end;
  if p>0  then  Power := z
          else  Power := 1.0/z;
end;

function exp1(X: RealType): RealType;
begin
  if X = 0.0 then exp1 := 1.0
             else if X > -ExpArg then  exp1 := exp(X)
                                 else  exp1 := 0.0;
end;

function Power1(R,p: RealType): RealType;
begin
  if p=0.0  then   Power1 := 1.0
  else  if R=0.0  then   Power1 := 0.0
  else  Power1 := exp1( p*ln(R) );
end;

function Combinations(m, n: IntType): IntType;
var
  i, C : IntType;
begin
  C := 1;
  if m>0  then
    for i:=1 to m  do
      C := (C*(n-i+1)) div i;
  Combinations := C;
end;

function Fac(m: IntType): longint;
var
  i, z : IntType;
begin
  z := 1;
  if m>1  then
    for i:=2 to m  do
      z := z*i;
  Fac := z;
end;


begin

  ln10 := ln(10.0);

end.