home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Freelog Special Edition 9
/
FreelogHS09.iso
/
FractalExplo
/
complex.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-06-05
|
27KB
|
937 lines
// -----------------------------------------------------------------
// Complex functions for Formulae Compilator 2.03 and greater
// Fractal Explorer
// <c> 2000, Sirotinsky A, Fedorenko O.
//
// =================================================================
// Please, do not modify without authors permission !
// =================================================================
Unit Complex;
Interface
Uses SysUtils, Math;
Type
TComplex = record
real: Extended;
imag: Extended;
end;
Function MakeComplex(const real, imag: Extended): TComplex;
Procedure SetResult(var x,y: Extended; const complex: TComplex);
Procedure CAddV(var Cmp1: TComplex; const Cmp2: TComplex); // Z:=Z+A
Function CAdd (const Cmp1, Cmp2: TComplex): TComplex; // V:=Z+A
Procedure CSubV(var Cmp1: TComplex; const Cmp2: TComplex); // Z:=Z-A
Function CSub (const Cmp1, Cmp2: TComplex): TComplex; // V:=Z-A
Procedure CMulV(var Cmp1: TComplex; const Cmp2: TComplex); // Z:=Z*A
Function CMul (const Cmp1, Cmp2: TComplex): TComplex; // V:=Z*A
Procedure CDivV(var Cmp1: TComplex; const Cmp2: TComplex); // Z:=Z/A
Function CDiv (const Cmp1, Cmp2: TComplex): TComplex; // V:=Z/A
// ++19/08/2000
Function CAddR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z+var
Function CSubR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z-var
Function CMulR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z*var
Function CDivR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z/var
Procedure CSqrV(var Cmp1: TComplex); // Z:=Z*Z
Function CSqr (const Cmp1: TComplex): TComplex; // V:=Z*Z
Procedure CTripleV(var Cmp1: TComplex); // Z:=Z*Z*Z
Function CTriple (const Cmp1: TComplex): TComplex; // V:=Z*Z*Z
Procedure CFourV(var Cmp1: TComplex); // Z:=Z*Z*Z*Z
Function CFour (const Cmp1: TComplex): TComplex; // V:=Z*Z*Z*Z
Procedure CFlipV(var Cmp1: TComplex);
Function CFlip (const Cmp1: TComplex): TComplex;
Procedure CRevV (var Cmp1: TComplex); // Z:=1/Z
Function CRev (const Cmp1: TComplex): TComplex; // V:=1/Z
Procedure CRev2V(var Cmp1: TComplex; const Cmp2: TComplex); // Z:=1/(Z-A)
Function CRev2 (const Cmp1,Cmp2: TComplex): TComplex; // V:=1/(Z-A)
Function CConj (const Cmp1: TComplex): TComplex;
Procedure CConjV(var Cmp1: TComplex);
Procedure CSqrtV(var Cmp1: TComplex); // Z:=Sqrt(Z)
Function CSqrt (const Cmp1: TComplex): TComplex; // V:=Sqrt(Z)
Procedure CExpV (var Cmp1: TComplex); // Z:=Exp(Z)
Function CExp (const Cmp1: TComplex): TComplex; // V:=Exp(Z)
Procedure CLnV (var Cmp1: TComplex); // Z:=Ln(Z)
Function CLn (const Cmp1: TComplex): TComplex; // V:=Ln(Z)
Procedure CPowerV(var Cmp1: TComplex; Cmp2: TComplex); // Z:=Z^A
Function CPower (const Cmp1,Cmp2: TComplex): TComplex; // V:=Z^A
// ++19/08/2000
Procedure CPowerRV(var Cmp1: TComplex; t: Extended); // Z:=Z^var
Function CPowerR (const Cmp1:TComplex;t: Extended): TComplex; // V:=Z^var
Procedure CSinV (var Cmp1: TComplex); // Z:=Sin(Z)
Function CSin (const Cmp1: TComplex): TComplex; // V:=Sin(Z)
Procedure CCosV (var Cmp1: TComplex); // Z:=Cos(Z)
Function CCos (const Cmp1: TComplex): TComplex; // V:=Cos(Z)
Procedure CTanV (var Cmp1: TComplex); // Z:=Tan(Z)
Function CTan (const Cmp1: TComplex): TComplex; // V:=Tan(Z)
Procedure CSinhV (var Cmp1: TComplex); // Z:=Sinh(Z)
Function CSinh (const Cmp1: TComplex): TComplex; // V:=Sinh(Z)
Procedure CCoshV (var Cmp1: TComplex); // Z:=Cosh(Z)
Function CCosh (const Cmp1: TComplex): TComplex; // V:=Cosh(Z)
// ++20/08/2000
Procedure CCotanV(var Cmp1: TComplex); // Z:=Cotan(Z)
Function CCotan (const Cmp1: TComplex): TComplex; // V:=Cotan(Z)
Procedure CTanhV (var Cmp1: TComplex); // Z:=Tanh(Z)
Function CTanh (const Cmp1: TComplex): TComplex; // V:=Tanh(Z)
Procedure CCotanhV(var Cmp1: TComplex); // Z:=Cotanh(Z)
Function CCotanh(const Cmp1: TComplex): TComplex; // V:=Cotanh(Z)
// ++19/08/2000
Procedure CASinV (var Cmp1: TComplex); // Z:=ArcSin(Z)
Function CASin (const Cmp1: TComplex): TComplex; // V:=ArcSin(Z)
Procedure CACosV (var Cmp1: TComplex); // Z:=ArcCos(Z)
Function CACos (const Cmp1: TComplex): TComplex; // V:=ArcCos(Z)
Procedure CATanV (var Cmp1: TComplex); // Z:=ArcTan(Z)
Function CATan (const Cmp1: TComplex): TComplex; // V:=ArcTan(Z)
// ++19/08/2000
Procedure CASinhV(var Cmp1: TComplex); // Z:=ArcSinh(Z)
Function CASinh (const Cmp1: TComplex): TComplex; // V:=ArcSinh(Z)
Procedure CACoshV(var Cmp1: TComplex); // Z:=ArcCosh(Z)
Function CACosh (const Cmp1: TComplex): TComplex; // V:=ArcCosh(Z)
Procedure CATanhV(var Cmp1: TComplex); // Z:=ArcTanh(Z)
Function CATanh (const Cmp1: TComplex): TComplex; // V:=ArcTanh(Z)
// ++22/08/2000
Procedure FuncDisp(const Fn: Integer; var Cmp1: TComplex); // functions dispatcher
Implementation
Const SmallTol: Extended = 1E-25;
Function MakeComplex(const real, imag: Extended): TComplex;
Begin
Result.real:=real;
Result.imag:=imag;
End;
Procedure SetResult(var x,y: Extended; const complex: TComplex);
Begin
x:=complex.real;
y:=complex.imag;
End;
{ ------------------------------------------------------------------- }
Procedure CAddV(var Cmp1: TComplex; const Cmp2: TComplex);
Begin
Cmp1.real:=Cmp1.real+Cmp2.real;
Cmp1.imag:=Cmp1.imag+Cmp2.imag;
End;
Function CAdd (const Cmp1, Cmp2: TComplex): TComplex;
Begin
Result.real:=Cmp1.real+Cmp2.real;
Result.imag:=Cmp1.imag+Cmp2.imag;
End;
Function CAddR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z+var
Begin
Result.real:=Cmp1.real+t;
Result.imag:=Cmp1.imag;
End;
Procedure CSubV(var Cmp1: TComplex; const Cmp2: TComplex);
Begin
Cmp1.real:=Cmp1.real-Cmp2.real;
Cmp1.imag:=Cmp1.imag-Cmp2.imag;
End;
Function CSub (const Cmp1, Cmp2: TComplex): TComplex;
Begin
Result.real:=Cmp1.real-Cmp2.real;
Result.imag:=Cmp1.imag-Cmp2.imag;
End;
Function CSubR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z-var
Begin
Result.real:=Cmp1.real-t;
Result.imag:=Cmp1.imag;
End;
Procedure CMulV(var Cmp1: TComplex; const Cmp2: TComplex);
var tmp: Extended;
Begin
tmp :=Cmp1.real*Cmp2.real - Cmp1.imag*Cmp2.imag;
Cmp1.imag:=Cmp1.real*Cmp2.imag + Cmp1.imag*Cmp2.real;
Cmp1.real:=tmp;
End;
Function CMul (const Cmp1, Cmp2: TComplex): TComplex;
Begin
Result.real:=Cmp1.real*Cmp2.real - Cmp1.imag*Cmp2.imag;
Result.imag:=Cmp1.real*Cmp2.imag + Cmp1.imag*Cmp2.real;
End;
Function CMulR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z*var
Begin
Result.real:=Cmp1.real*t;
Result.imag:=Cmp1.imag*t;
End;
Procedure CDivV(var Cmp1: TComplex; const Cmp2: TComplex);
var tmp1,tmp2: Extended;
Begin
tmp1 := Cmp2.real*Cmp2.real + Cmp2.imag*Cmp2.imag + SmallTol;
tmp2 :=(Cmp1.real*Cmp2.real + Cmp1.imag*Cmp2.imag)/tmp1;
Cmp1.imag :=(Cmp1.imag*Cmp2.real - Cmp1.real*Cmp2.imag)/tmp1;
Cmp1.real := tmp2;
End;
Function CDiv (const Cmp1, Cmp2: TComplex): TComplex;
var tmp: Extended;
Begin
tmp := Cmp2.real*Cmp2.real + Cmp2.imag*Cmp2.imag + SmallTol;
Result.real:=(Cmp1.real*Cmp2.real + Cmp1.imag*Cmp2.imag)/tmp;
Result.imag:=(Cmp1.imag*Cmp2.real - Cmp1.real*Cmp2.imag)/tmp;
End;
Function CDivR(const Cmp1: TComplex; t: Extended): TComplex; // V:=Z/var
Begin
Result.real:=Cmp1.real/t;
Result.imag:=Cmp1.imag/t;
End;
{ ------------------------------------------------------------------- }
Procedure CSqrV(var Cmp1: TComplex);
var tmp: Extended;
Begin
tmp :=(Cmp1.real+Cmp1.imag)*(Cmp1.real-Cmp1.imag);
Cmp1.imag:= Cmp1.real*Cmp1.imag * 2;
Cmp1.real:=tmp;
End;
Function CSqr (const Cmp1: TComplex): TComplex;
Begin
Result.real:=(Cmp1.real+Cmp1.imag)*(Cmp1.real-Cmp1.imag);
Result.imag:= Cmp1.real*Cmp1.imag * 2;
End;
Procedure CTripleV(var Cmp1: TComplex);
var tmp: Extended;
Begin
tmp :=Cmp1.real*(Cmp1.real*Cmp1.real - 3*Cmp1.imag*Cmp1.imag);
Cmp1.imag:=Cmp1.imag*(3*Cmp1.real*Cmp1.real - Cmp1.imag*Cmp1.imag);
Cmp1.real:=tmp;
End;
Function CTriple (const Cmp1: TComplex): TComplex;
Begin
Result.real:=Cmp1.real*(Cmp1.real*Cmp1.real - 3*Cmp1.imag*Cmp1.imag);
Result.imag:=Cmp1.imag*(3*Cmp1.real*Cmp1.real - Cmp1.imag*Cmp1.imag);
End;
Procedure CFourV(var Cmp1: TComplex);
var tmpR, tmpI: Extended;
Begin
tmpR:=(Cmp1.real-Cmp1.imag)*(Cmp1.real+Cmp1.imag);
tmpI:= Cmp1.real*Cmp1.imag * 2;
Cmp1.real:=(tmpR-tmpI)*(tmpR+tmpI);
Cmp1.imag:= tmpR*tmpI * 2;
End;
Function CFour (const Cmp1: TComplex): TComplex;
var tmpR, tmpI: Extended;
Begin
tmpR:=(Cmp1.real-Cmp1.imag)*(Cmp1.real+Cmp1.imag);
tmpI:= Cmp1.real*Cmp1.imag * 2;
Result.real:=(tmpR-tmpI)*(tmpR+tmpI);
Result.imag:= tmpR*tmpI * 2;
End;
{ ------------------------------------------------------------------- }
Procedure CFlipV(var Cmp1: TComplex);
var tmp: Extended;
Begin
tmp:=Cmp1.real;
Cmp1.real:=Cmp1.imag;
Cmp1.imag:=tmp;
End;
Function CFlip (const Cmp1: TComplex): TComplex;
Begin
Result.real:=Cmp1.imag;
Result.imag:=Cmp1.real;
End;
Procedure CRevV(var Cmp1: TComplex);
var tmp: Extended;
Begin
tmp := Cmp1.real*Cmp1.real + Cmp1.imag*Cmp1.imag + SmallTol;
Cmp1.real := Cmp1.real/tmp;
Cmp1.imag :=-Cmp1.imag/tmp;
End;
Function CRev (const Cmp1: TComplex): TComplex;
var tmp: Extended;
Begin
tmp := Cmp1.real*Cmp1.real + Cmp1.imag*Cmp1.imag + SmallTol;
Result.real:= Cmp1.real/tmp;
Result.imag:=-Cmp1.imag/tmp;
End;
Procedure CRev2V(var Cmp1: TComplex; const Cmp2: TComplex);
var tmp: Extended;
Begin
tmp := (Cmp1.real-Cmp2.real)*(Cmp1.real-Cmp2.real) +
(Cmp1.imag-Cmp2.imag)*(Cmp1.imag-Cmp2.imag) + SmallTol;
Cmp1.real := (Cmp1.real-Cmp2.real)/tmp;
Cmp1.imag := (Cmp2.imag-Cmp1.imag)/tmp;
End;
Function CRev2 (const Cmp1,Cmp2: TComplex): TComplex;
var tmp: Extended;
Begin
tmp := (Cmp1.real-Cmp2.real)*(Cmp1.real-Cmp2.real) +
(Cmp1.imag-Cmp2.imag)*(Cmp1.imag-Cmp2.imag) + SmallTol;
Result.real:= (Cmp1.real-Cmp2.real)/tmp;
Result.imag:= (Cmp2.imag-Cmp1.imag)/tmp;
End;
{ ------------------------------------------------------------------- }
Procedure CSqrtV(var Cmp1: TComplex); // Z:=Sqrt(Z)
var a,b: Extended;
Begin
With Cmp1 do begin
a:=Sqrt(Sqrt(real*real+imag*imag));
b:=ArcTan2(imag,real)/2;
real:=a*cos(b);
imag:=a*sin(b);
end;
End;
Function CSqrt (const Cmp1: TComplex): TComplex; // V:=Sqrt(Z)
var a,b: Extended;
Begin
With Cmp1 do begin
a:=Sqrt(Sqrt(real*real+imag*imag));
b:=ArcTan2(imag,real)/2;
Result.real:=a*cos(b);
Result.imag:=a*sin(b);
end;
End;
Procedure CExpV (var Cmp1: TComplex); // Z:=Exp(Z)
var tmp: Extended;
Begin
tmp :=Exp(Cmp1.real);
Cmp1.real:=tmp*Cos(Cmp1.imag);
Cmp1.imag:=tmp*Sin(Cmp1.imag);
End;
Function CExp (const Cmp1: TComplex): TComplex; // V:=Exp(Z)
var tmp: Extended;
Begin
tmp :=Exp(Cmp1.real);
Result.real:=tmp*Cos(Cmp1.imag);
Result.imag:=tmp*Sin(Cmp1.imag);
End;
Procedure CLnV (var Cmp1: TComplex); // Z:=Ln(Z)
var tmp: Extended;
Begin
tmp :=Log2(Cmp1.real*Cmp1.real + Cmp1.imag*Cmp1.imag)/2.7182818285;
Cmp1.imag:=ArcTan2(Cmp1.imag, Cmp1.real);
Cmp1.real:=tmp;
End;
Function CLn (const Cmp1: TComplex): TComplex; // V:=Ln(Z)
Begin
Result.real:=Log2(Cmp1.real*Cmp1.real + Cmp1.imag*Cmp1.imag)/2.7182818285;
Result.imag:=ArcTan2(Cmp1.imag, Cmp1.real);
End;
Procedure CPowerV(var Cmp1: TComplex; Cmp2: TComplex); // Z:=Z^A
var h1x,h1y: Extended;
h2x,h2y: Extended;
f : Extended;
Begin
h1x:=Log2(Cmp1.real*Cmp1.real+Cmp1.imag*Cmp1.imag)/2.7182818285;
h1y:=ArcTan2(Cmp1.imag, Cmp1.real);
h2x:=h1x*Cmp2.real-h1y*Cmp2.imag;
h2y:=h1y*Cmp2.real+h1x*Cmp2.imag;
f :=Exp(h2x);
Cmp1.real :=f*Cos(h2y);
Cmp1.imag :=f*Sin(h2y);
End;
Function CPower (const Cmp1,Cmp2: TComplex): TComplex; // V:=Z^A
var h1x,h1y: Extended;
h2x,h2y: Extended;
f : Extended;
Begin
h1x:=Log2(Cmp1.real*Cmp1.real+Cmp1.imag*Cmp1.imag)/2.7182818285;
h1y:=ArcTan2(Cmp1.imag, Cmp1.real);
h2x:=h1x*Cmp2.real-h1y*Cmp2.imag;
h2y:=h1y*Cmp2.real+h1x*Cmp2.imag;
f :=Exp(h2x);
Result.real :=f*Cos(h2y);
Result.imag :=f*Sin(h2y);
End;
Procedure CPowerRV(var Cmp1: TComplex; t: Extended); // Z:=Z^var
var tr,ti,f: Extended;
Begin
tr:=t*Log2(Cmp1.real*Cmp1.real+Cmp1.imag*Cmp1.imag)/2.7182818285;
ti:=t*ArcTan2(Cmp1.imag,Cmp1.real);
f :=Exp(tr);
Cmp1.real:=f*Cos(ti);
Cmp1.imag:=f*Sin(ti);
End;
Function CPowerR (const Cmp1:TComplex;t: Extended): TComplex; // V:=Z^var
var tr,ti,f: Extended;
Begin
tr:=t*Log2(Cmp1.real*Cmp1.real+Cmp1.imag*Cmp1.imag)/2.7182818285;
ti:=t*ArcTan2(Cmp1.imag,Cmp1.real);
f :=Exp(tr);
Result.real:=f*Cos(ti);
Result.imag:=f*Sin(ti);
End;
{ ------------------------------------------------------------------- }
Procedure CSinV (var Cmp1: TComplex); // Z:=Sin(Z)
var tmp1,tmp2,tmp3: Extended;
Begin
tmp1:=Exp(Cmp1.imag)/2;
tmp2:=0.25/tmp1;
tmp3:=Sin(Cmp1.real)*(tmp1+tmp2);
Cmp1.imag:=Cos(Cmp1.real)*(tmp1-tmp2);
Cmp1.real:=tmp3;
End;
Function CSin (const Cmp1: TComplex): TComplex; // V:=Sin(Z)
var tmp1,tmp2: Extended;
Begin
tmp1:=Exp(Cmp1.imag)/2;
tmp2:=0.25/tmp1;
Result.real:=Sin(Cmp1.real)*(tmp1+tmp2);
Result.imag:=Cos(Cmp1.real)*(tmp1-tmp2);
End;
Procedure CCosV (var Cmp1: TComplex); // Z:=Cos(Z)
var tmp1: Extended;
Begin
tmp1:=Cos(Cmp1.real)*Cosh(Cmp1.imag);
Cmp1.imag:=-Sin(Cmp1.real)*Sinh(Cmp1.imag);
Cmp1.real:=tmp1;
End;
Function CCos (const Cmp1: TComplex): TComplex; // V:=Cos(Z)
Begin
Result.real:=Cos(Cmp1.real)*Cosh(Cmp1.imag);
Result.imag:=-Sin(Cmp1.real)*Sinh(Cmp1.imag);
End;
Procedure CTanV (var Cmp1: TComplex); // Z:=Tan(Z)
var b: Extended;
Begin
b:=Cos(2*Cmp1.real)+Cosh(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Cmp1.real:=Sin (2*Cmp1.real)/b;
Cmp1.imag:=Sinh(2*Cmp1.imag)/b;
End;
Function CTan (const Cmp1: TComplex): TComplex; // V:=Tan(Z)
var b: Extended;
Begin
b:=Cos(2*Cmp1.real)+Cosh(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Result.real:=Sin (2*Cmp1.real)/b;
Result.imag:=Sinh(2*Cmp1.imag)/b;
End;
Procedure CCotanV(var Cmp1: TComplex); // Z:=Cotan(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.imag)-Cos(2*Cmp1.real);
If b=0 Then b:=SmallTol;
Cmp1.real:= Sin( 2*Cmp1.real)/b;
Cmp1.imag:=-Sinh(2*Cmp1.imag)/b;
End;
Function CCotan (const Cmp1: TComplex): TComplex; // V:=Cotan(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.imag)-Cos(2*Cmp1.real);
If b=0 Then b:=SmallTol;
Result.real:= Sin( 2*Cmp1.real)/b;
Result.imag:=-Sinh(2*Cmp1.imag)/b;
End;
Procedure CSinhV(var Cmp1: TComplex); // Z:=Sinh(Z)
var tmp1: Extended;
Begin
tmp1:=Sinh(Cmp1.real)*Cos(Cmp1.imag);
Cmp1.imag:=Cosh(Cmp1.real)*Sin(Cmp1.imag);
Cmp1.real:=tmp1;
End;
Function CSinh (const Cmp1: TComplex): TComplex; // V:=Sinh(Z)
Begin
Result.real:=Sinh(Cmp1.real)*Cos(Cmp1.imag);
Result.imag:=Cosh(Cmp1.real)*Sin(Cmp1.imag);
End;
Procedure CCoshV(var Cmp1: TComplex); // Z:=Cosh(Z)
var tmp1: Extended;
Begin
tmp1:=Cosh(Cmp1.real)*Cos(Cmp1.imag);
Cmp1.imag:=Sinh(Cmp1.real)*Sin(Cmp1.imag);
Cmp1.real:=tmp1;
End;
Function CCosh (const Cmp1: TComplex): TComplex; // V:=Cosh(Z)
Begin
Result.real:=Cosh(Cmp1.real)*Cos(Cmp1.imag);
Result.imag:=Sinh(Cmp1.real)*Sin(Cmp1.imag);
End;
Procedure CTanhV (var Cmp1: TComplex); // Z:=Tanh(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.real)+Cos(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Cmp1.real:=Sinh(2*Cmp1.real)/b;
Cmp1.imag:=Sin( 2*Cmp1.imag)/b;
End;
Function CTanh (const Cmp1: TComplex): TComplex; // V:=Tanh(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.real)+Cos(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Result.real:=Sinh(2*Cmp1.real)/b;
Result.imag:=Sin( 2*Cmp1.imag)/b;
End;
Procedure CCotanhV(var Cmp1: TComplex); // Z:=Cotanh(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.real)-Cos(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Cmp1.real:= Sinh(2*Cmp1.real)/b;
Cmp1.imag:=-Sin( 2*Cmp1.imag)/b;
End;
Function CCotanh(const Cmp1: TComplex): TComplex; // V:=Cotanh(Z)
var b: Extended;
Begin
b:=Cosh(2*Cmp1.real)-Cos(2*Cmp1.imag);
If b=0 Then b:=SmallTol;
Result.real:= Sinh(2*Cmp1.real)/b;
Result.imag:=-Sin( 2*Cmp1.imag)/b;
End;
{ ------------------------------------------------------------------- }
Procedure CASinV (var Cmp1: TComplex); // Z:=Sin(Z)
var a,b : Extended;
xr,xi: Extended; // [-i * log(i*z+sqrt(1-z*z))]
Begin
With Cmp1 do begin
a :=(real - imag)*(real + imag);
xi:= -2*real*imag;
xr:=1-a;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)-imag;
xi:=a*sin(b)+real;
imag:=-Ln(xr*xr + xi*xi + SmallTol)/2;
real:=ArcTan2(xi, xr);
end;
End;
Function CASin (const Cmp1: TComplex): TComplex; // V:=Sin(Z)
var a,b : Extended;
xr,xi: Extended; // [-i * log(i*z+sqrt(1-z*z))]
Begin
With Cmp1 do begin
a :=(real - imag)*(real + imag);
xi:= -2*real*imag;
xr:=1-a;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)-imag;
xi:=a*sin(b)+real;
Result.imag:=-Ln(xr*xr + xi*xi + SmallTol)/2;
Result.real:=ArcTan2(xi, xr);
end;
End;
Procedure CACosV (var Cmp1: TComplex); // Z:=Cos(Z)
var a,b : Extended;
xr,xi: Extended; // [-i * log(z+sqrt(z*z-1))]
Begin
With Cmp1 do begin
a :=(real - imag)*(real + imag);
xi:=2*real*imag;
xr:=a-1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+real;
xi:=a*sin(b)+imag;
imag:=-Ln(xr*xr + xi*xi + SmallTol)/2;
real:=ArcTan2(xi, xr);
end;
End;
Function CACos (const Cmp1: TComplex): TComplex; // V:=Cos(Z)
var a,b : Extended;
xr,xi: Extended; // [-i * log(z+sqrt(z*z-1))]
Begin
With Cmp1 do begin
a :=(real - imag)*(real + imag);
xi:=2*real*imag;
xr:=a-1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+real;
xi:=a*sin(b)+imag;
Result.imag:=-Ln(xr*xr + xi*xi + SmallTol)/2;
Result.real:=ArcTan2(xi, xr);
end;
End;
Procedure CATanV (var Cmp1: TComplex); // Z:=ArcTan(Z)
var a,b : Extended;
xr,xi: Extended;
tr,ti: Extended;
f : Extended;
Begin
// i/2 * log((1-i*z)/(1+i*z))
a :=1+Cmp1.imag; b := -Cmp1.real;
xr:=1-Cmp1.imag; xi:= Cmp1.real;
f:= xr*xr + xi*xi + SmallTol;
tr:=(a*xr + b*xi)/f;
ti:=(b*xr - a*xi)/f;
xr:=Ln(tr*tr + ti*ti + SmallTol)/4;
xi:=ArcTan2(ti, tr)/2;
Cmp1.real:=-xi;
Cmp1.imag:= xr;
End;
Function CATan (const Cmp1: TComplex): TComplex; // V:=ArcTan(Z)
var a,b : Extended;
xr,xi: Extended;
tr,ti: Extended;
f : Extended;
Begin
// i/2 * log((1-i*z)/(1+i*z))
a :=1+Cmp1.imag; b := -Cmp1.real;
xr:=1-Cmp1.imag; xi:= Cmp1.real;
f:= xr*xr + xi*xi + SmallTol;
tr:=(a*xr + b*xi)/f;
ti:=(b*xr - a*xi)/f;
xr:=Ln(tr*tr + ti*ti + SmallTol)/4;
xi:=ArcTan2(ti, tr)/2;
Result.real:=-xi;
Result.imag:= xr;
End;
{ ------------------------------------------------------------------- }
Procedure CASinhV(var Cmp1: TComplex); // Z:=ArcSinh(Z)
var a,b : Extended;
xr,xi: Extended;
Begin
// log(z+sqrt(z*z+1))
a :=(Cmp1.real - Cmp1.imag)*(Cmp1.real + Cmp1.imag);
xi:=2*Cmp1.real*Cmp1.imag;
xr:=a+1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+Cmp1.real;
xi:=a*sin(b)+Cmp1.imag;
Cmp1.real:=Ln(xr*xr + xi*xi + SmallTol)/2;
Cmp1.imag:=ArcTan2(xi, xr);
End;
Function CASinh (const Cmp1: TComplex): TComplex; // V:=ArcSinh(Z)
var a,b : Extended; // log(z+sqrt(z*z+1))
xr,xi: Extended;
Begin
a :=(Cmp1.real - Cmp1.imag)*(Cmp1.real + Cmp1.imag);
xi:=2*Cmp1.real*Cmp1.imag;
xr:=a+1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+Cmp1.real;
xi:=a*sin(b)+Cmp1.imag;
Result.real:=Ln(xr*xr + xi*xi + SmallTol)/2;
Result.imag:=ArcTan2(xi, xr);
End;
Procedure CACoshV(var Cmp1: TComplex); // Z:=ArcCosh(Z)
var a,b : Extended; // log(z+sqrt(z*z-1))
xr,xi: Extended;
Begin
a :=(Cmp1.real - Cmp1.imag)*(Cmp1.real + Cmp1.imag);
xi:=2*Cmp1.real*Cmp1.imag;
xr:=a-1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+Cmp1.real;
xi:=a*sin(b)+Cmp1.imag;
Cmp1.real:=Ln(xr*xr + xi*xi + SmallTol)/2;
Cmp1.imag:=ArcTan2(xi, xr);
End;
Function CACosh (const Cmp1: TComplex): TComplex; // V:=ArcCosh(Z)
var a,b : Extended; // log(z+sqrt(z*z-1))
xr,xi: Extended;
Begin
a :=(Cmp1.real - Cmp1.imag)*(Cmp1.real + Cmp1.imag);
xi:=2*Cmp1.real*Cmp1.imag;
xr:=a-1;
a :=Sqrt(Sqrt(xr*xr+xi*xi));
b :=ArcTan2(xi,xr)/2;
xr:=a*cos(b)+Cmp1.real;
xi:=a*sin(b)+Cmp1.imag;
Result.real:=Ln(xr*xr + xi*xi + SmallTol)/2;
Result.imag:=ArcTan2(xi, xr);
End;
Procedure CATanhV(var Cmp1: TComplex); // Z:=ArcTanh(Z)
var a,b : Extended; // log((1+z)/(1-z))/2
xr,xi: Extended;
tr,ti: Extended;
f : Extended;
Begin
a :=1+Cmp1.real; b := Cmp1.imag;
xr:=1-Cmp1.real; xi:=-Cmp1.imag;
f:= xr*xr + xi*xi + SmallTol;
tr:=(a*xr + b*xi)/f;
ti:=(b*xr - a*xi)/f;
Cmp1.real:=Ln(tr*tr + ti*ti + SmallTol)/4;
Cmp1.imag:=ArcTan2(ti, tr)/2;
End;
Function CATanh (const Cmp1: TComplex): TComplex; // V:=ArcTanh(Z)
var a,b : Extended; // log((1+z)/(1-z))/2
xr,xi: Extended;
tr,ti: Extended;
f : Extended;
Begin
a :=1+Cmp1.real; b := Cmp1.imag;
xr:=1-Cmp1.real; xi:=-Cmp1.imag;
f:= xr*xr + xi*xi + SmallTol;
tr:=(a*xr + b*xi)/f;
ti:=(b*xr - a*xi)/f;
Result.real:=Ln(tr*tr + ti*ti + SmallTol)/4;
Result.imag:=ArcTan2(ti, tr)/2;
End;
{ =================================================================== }
Procedure CCabsV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Sqrt(real*real+imag*imag);
imag:=0;
end;
End;
Procedure CAbsV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Abs(real);
end;
End;
Procedure CFloorV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Floor(real);
imag:=Floor(imag);
end;
End;
Procedure CCeilV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Trunc(real);
imag:=Trunc(imag);
end;
End;
Procedure CTruncV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Trunc(real);
imag:=Trunc(imag);
end;
End;
Procedure CRoundV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=Round(real);
imag:=Round(imag);
end;
End;
Procedure COneV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=1;
imag:=0;
end;
End;
Procedure CCosxxV(var Cmp1: TComplex);
var a: Extended;
Begin
// cos(x)cosh(y) + i sin(x)sinh(y)
With Cmp1 do begin
a :=Cos(real)*Cosh(imag);
imag:=Sin(real)*Sinh(imag);
real:=a;
end;
End;
Procedure CRecipV(var Cmp1: TComplex);
var a: Extended;
Begin
// (x-iy) / (x^2+y^2)
With Cmp1 do begin
a := real*real + imag*imag + SmallTol;
real:= real/a;
imag:=-imag/a
end;
End;
Function CConj(const Cmp1: TComplex): TComplex;
Begin
Result.real:= Cmp1.real;
Result.imag:=-Cmp1.imag;
End;
Procedure CConjV(var Cmp1: TComplex);
Begin
Cmp1.imag:=-Cmp1.imag;
End;
Procedure CZeroV(var Cmp1: TComplex);
Begin
With Cmp1 do begin
real:=0;
imag:=0;
end;
End;
Procedure CLogV(var Cmp1: TComplex);
var a: Extended;
Begin
// (1/2)ln(x^2 + y^2) + i*arctan2(y/x)
With Cmp1 do begin
a :=Ln(real*real + imag*imag + SmallTol)/2;
imag:=ArcTan2(imag, real);
real:=a;
end;
End;
{ ------------------------------------------------------------------- }
Procedure FuncDisp(const Fn: Integer; var Cmp1: TComplex); // dispatcher
Begin
Case Fn of
0: ; // CIdent(Cmp1);
1: CCosV(Cmp1);
2: CTanV(Cmp1);
3: CTanhV(Cmp1);
4: CCotanV(Cmp1);
5: CCotanhV(Cmp1);
6: CFlipV(Cmp1);
7: CConjV(Cmp1);
8: CZeroV(Cmp1);
9: CASinV(Cmp1);
10: CASinhV(Cmp1);
11: CACosV(Cmp1);
12: CACoshV(Cmp1);
13: CATanV(Cmp1);
14: CATanhV(Cmp1);
15: CCabsV(Cmp1);
16: CAbsV(Cmp1);
17: CSqrtV(Cmp1);
18: CFloorV(Cmp1);
19: CCeilV(Cmp1);
20: CTruncV(Cmp1);
21: CRoundV(Cmp1);
22: COneV(Cmp1);
23: CSinV(Cmp1);
24: CCosxxV(Cmp1);
25: CSinhV(Cmp1);
26: CCoshV(Cmp1);
27: CExpV(Cmp1);
28: CLogV(Cmp1);
29: CSqrV(Cmp1);
30: CRecipV(Cmp1);
end;
End;
END.