Модуль для работы с комплексными числами
01.01.2007
{ **** UBPFD *********** by kladovka.net.ru ****
>> Модуль для работы с комплексными числами
Модуль предназначен для работы с комплексными числами.
Данный модуль был взят с http://gaivan.hypermart.net и переработан мной
Зависимости: SysUtils - для работы ComplexToStr и StrToComplex; Math - для cmPow
Автор: Separator, wilhelm@mail.ru, ICQ:162770303, Алматы
Copyright: http://gaivan.hypermart.net
Дата: 16 марта 2004 г.
********************************************** }
unit cmplx;
//----------------------------------------------------------------------------//
// Complex numbers routines library //
// Copyright (c) 2001 by Serghei Gaivan //
// e-mail: gaivan@mail.hypermart.net //
// http://gaivan.hypermart.net //
//----------------------------------------------------------------------------//
// Update: //
// 04.07.2003 Sergey Vilgelm (wilhelm@mail.kz) //
//----------------------------------------------------------------------------//
interface
uses SysUtils, Math;
type
TComplexType = extended;
PComplex = ^TComplex;
TComplex = packed record
x: TComplexType;
y: TComplexType;
end;
const
OneComplex : TComplex = (x: 1; y: 0);
NegOneComplex : TComplex = (x: -1; y: 0);
OneComplexIm : TComplex = (x: 0; y: 1);
NegOneComplexIm : TComplex = (x: 0; y: -1);
NullComplex : TComplex = (x: 0; y: 0);
OneOneComplex : TComplex = (x: 1; y: 1);
NegOneOneComplex : TComplex = (x: -1; y: 1);
OneNegOneComplex : TComplex = (x: 1; y: -1);
NegOneNegOneComplex : TComplex = (x: -1; y: -1);
function Re(z: TComplex): TComplexType; // z :--> Re(z)
function Im(z: TComplex): TComplexType; // z :--> Im(z)
//------ Unary operations ----------------------------------------------------//
function cConj(z: TComplex): TComplex; // z :--> z*
function cNeg(z: TComplex): TComplex; // z :--> -z
function cFlip(z: TComplex): TComplex; // (x, y) :--> (y, x)
function cRCW(z: TComplex): TComplex; // (x, y) :--> (-y, x)
function cRCC(z: TComplex): TComplex; // (x, y) :--> (y, -x)
//------ Binary operations ---------------------------------------------------//
function cSum(z1, z2: TComplex): TComplex; // z1, z2 :--> z1 + z2
function cSub(z1, z2: TComplex): TComplex; // z1, z2 :--> z1 - z2
function cMul(z1, z2: TComplex): TComplex; // z1, z2 :--> z1 * z2
function cDiv(z1, z2: TComplex): TComplex; // z1, z2 :--> z1 / z2
//------ Standard routines ---------------------------------------------------//
function cPolar(rho, phi: TComplexType): TComplex; // (rho, phi) :--> z
function cAbs(z: TComplex): TComplexType; // z :--> |z|
function cArg(z: TComplex): TComplexType; // z :--> arg(z)
function cNorm(z: TComplex): TComplexType; // z :--> |z|^2
//------ Algebraic functions -------------------------------------------------//
function cSqr(z: TComplex): TComplex; // z :--> z^2
function cInv(z: TComplex): TComplex; // z :--> 1 / z
function cSqrt(z: TComplex): TComplex; // z :--> Sqrt(z)
function cPow(z: TComplex; n: integer): TComplex; // z :--> z^n
//------ Transcendent functions ----------------------------------------------//
function cLn(z: TComplex): TComplex; // z :--> Ln(z)
function cExp(z: TComplex): TComplex; // z :--> Exp(z)
//------ Trigonometric functions ---------------------------------------------//
function cSin(z: TComplex): TComplex; // z :--> Sin(z)
function cCos(z: TComplex): TComplex; // z :--> Cos(z)
function cTan(z: TComplex): TComplex; // z :--> Tan(z)
function cCotan(z: TComplex): TComplex; // z :--> Cotan(z)
//------ Hyperbolic functions ------------------------------------------------//
function cSinh(z: TComplex): TComplex; // z :--> Sinh(z)
function cCosh(z: TComplex): TComplex; // z :--> Cosh(z)
function cTanh(z: TComplex): TComplex; // z :--> Tanh(z)
function cCotanh(z: TComplex): TComplex; // z :--> Cotanh(z)
//------ Other operations ----- Sergey Vilgelm -------------------------------//
function Complex(x, y: TComplexType): TComplex; // Result.x:= x; Result.y:= y
function cEqual(z1, z2: TComplex): boolean; // z1 = z2
function cEqualZero(z: TComplex): boolean; // z.x = 0 and z.y = 0
function cEqualOne(z: TComplex): boolean; // z.x = 1 and z.y = 0
function cmPow(z: TComplex; n: integer): TComplex; // Альтернативное возведение в степень, так как оригинальный cPow не корректно работает
//------ String operations ---- Sergey Vilgelm -------------------------------//
function ComplexToStr(z: TComplex): string;
function StrToComplex(S: string): TComplex;
implementation
//----------------------------------------------------------------------------//
function Re(z: TComplex): TComplexType; register;
// z :--> Re(z)
asm
FLD TComplex.x [EAX]
end;
//----------------------------------------------------------------------------//
function Im(z: TComplex): TComplexType; register;
// z :--> Im(z)
asm
FLD TComplex.y [EAX]
end;
//----------------------------------------------------------------------------//
//------ Unary operations ----------------------------------------------------//
//----------------------------------------------------------------------------//
function cConj(z: TComplex): TComplex; register;
// z :--> z*
asm
FLD TComplex.y [EAX]
FCHS
FSTP TComplex.y [EDX]
FLD TComplex.x [EAX]
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
function cNeg(z: TComplex): TComplex; register;
// (x, y) :--> (-x, -y)
asm
FLD TComplex.x [EAX]
FCHS
FSTP TComplex.x [EDX]
FLD TComplex.y [EAX]
FCHS
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cFlip(z: TComplex): TComplex;
// (x, y) :--> (y, x)
asm
FLD TComplex.y [EAX]
FSTP TComplex.x [EDX]
FLD TComplex.x [EAX]
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cRCW(z: TComplex): TComplex; register;
// (x, y) :--> (-y, x) that is z :--> i * z
asm
FLD TComplex.y [EAX]
FCHS
FSTP TComplex.x [EDX]
FLD TComplex.x [EAX]
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cRCC(z: TComplex): TComplex; register;
// (x, y) :--> (y, -x)
asm
FLD TComplex.y [EAX]
FSTP TComplex.x [EDX]
FLD TComplex.x [EAX]
FCHS
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
//------ Binary operations ---------------------------------------------------//
//----------------------------------------------------------------------------//
function cSum(z1, z2: TComplex): TComplex; register;
// z1, z2 :--> z1 + z2
asm
FLD TComplex.x [EAX]
FLD TComplex.x [EDX]
FADD
FSTP TComplex.x [ECX]
FLD TComplex.y [EAX]
FLD TComplex.y [EDX]
FADD
FSTP TComplex.y [ECX]
end;
//----------------------------------------------------------------------------//
function cSub(z1, z2: TComplex): TComplex; register;
// z1, z2 :--> z1 - z2
asm
FLD TComplex.x [EAX]
FLD TComplex.x [EDX]
FSUB
FSTP TComplex.x [ECX]
FLD TComplex.y [EAX]
FLD TComplex.y [EDX]
FSUB
FSTP TComplex.y [ECX]
end;
//----------------------------------------------------------------------------//
function cMul(z1, z2: TComplex): TComplex; register;
// z1, z2 :--> z1 * z2
asm
FLD TComplex.x [EAX]
FLD TComplex.x [EDX]
FLD ST // x2 x2 x1
FMUL ST, ST(2) // x1*x2 x2 x1
FLD TComplex.y [EAX]
FXCH ST(1) // x1*x2 y1 x2 x1
FLD TComplex.y [EDX]
FXCH ST(1)
FLD ST(1)
FMUL ST, ST(3)
FSUB
FSTP TComplex.x [ECX] // y2 y1 x2 x1
FMULP ST(3), ST(0) //y1 x2 x1*y2
FMUL // x2*y1 x1*y2
FADD
FSTP TComplex.y [ECX]
end;
//----------------------------------------------------------------------------//
function cDiv(z1, z2: TComplex): TComplex; register;
// z1, z2 :--> z1 / z2
asm
FLD TComplex.y [EDX]
FLD ST(0)
FMUL ST, ST
FLD TComplex.x [EDX]
FXCH ST(1)
FLD ST(1)
FMUL ST, ST
FADD
FLD1
FDIVR
FLD TComplex.x [EAX]
FLD TComplex.y [EAX]
FXCH ST(2)
FLD ST(1)
FMUL ST, ST(4)
FLD ST(3)
FMUL ST, ST(6)
FADD
FMUL ST, ST(1)
FSTP TComplex.x [ECX]
FXCH ST(4)
FMUL
FXCH ST(2)
FMUL // x2*y1 x1*y2 1/norm
FSUBR
FMUL
FSTP TComplex.y [ECX]
end;
//----------------------------------------------------------------------------//
//------ Standard routines ---------------------------------------------------//
//----------------------------------------------------------------------------//
function cPolar(rho, phi: TComplexType): TComplex; register;
// (rho, phi) :--> z
asm
FLD rho
FLD phi
FSINCOS
FMUL ST, ST(2)
FSTP TComplex.x [EAX]
FMUL
FSTP TComplex.y [EAX]
end;
//----------------------------------------------------------------------------//
function cAbs(z: TComplex): TComplexType; register;
// z :--> |z|
asm
FLD TComplex.y [EAX]
FMUL ST, ST
FLD TComplex.x [EAX]
FMUL ST, ST
FADD
FSQRT
end;
//----------------------------------------------------------------------------//
function cArg(z: TComplex): TComplexType; register;
// z :--> arg(z)
asm
FLD TComplex.y [EAX]
FLD TComplex.x [EAX]
FPATAN
end;
//----------------------------------------------------------------------------//
function cNorm(z: TComplex): TComplexType; register;
// z :--> |z|^2
asm
FLD TComplex.y [EAX]
FMUL ST, ST
FLD TComplex.x [EAX]
FMUL ST, ST
FADD
end;
//----------------------------------------------------------------------------//
//------ Algebraic functions -------------------------------------------------//
//----------------------------------------------------------------------------//
function cSqr(z: TComplex): TComplex; register;
// z :--> z^2
asm
FLD TComplex.y [EAX]
FLD ST
FMUL ST, ST
FLD TComplex.x [EAX]
FLD ST
FMUL ST, ST
FXCH ST(3)
FMUL
FADD ST, ST
FSTP TComplex.y [EDX]
FSUB
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
function cSqrt(z: TComplex): TComplex; register;
// z :--> sqrt(z)
asm
FLD TComplex.x [EAX]
FLD ST
FMUL ST, ST
FLD TComplex.y [EAX]
FMUL ST, ST
FADD
FSQRT
FLD ST(1)
FADD ST, ST(1)
FABS
FLD1
FADD ST, ST
FDIV
FSQRT
FSTP TComplex.x [EDX]
FSUB
FABS
FLD1
FADD ST, ST
FDIV
FSQRT
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cInv(z: TComplex): TComplex; register;
// z :--> 1/z
asm
FLD TComplex.y [EAX]
FLD ST
FMUL ST, ST
FLD TComplex.x [EAX]
FXCH
FLD ST(1)
FMUL ST, ST
FADD
FLD1
FDIVR
FXCH ST(2)
FMUL ST, ST(2)
FSTP TComplex.y [EDX]
FMUL
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
function cPow(z: TComplex; n: integer): TComplex; register;
// z :--> z^n
asm
FLD TComplex.x [EAX]
FLD TComplex.y [EAX]
FLD1
FLD ST(2)
FMUL ST, ST
FLD ST(2)
FMUL ST, ST
FADD
FSQRT
MOV EAX,EDX
JMP @2
@1: FMUL ST, ST
@2: SHR EAX,1
JNC @1
FMUL ST(1),ST
JNZ @1
FSTP ST(0)
FXCH ST(2)
FPATAN
MOV [ESP-$04],EDX
FILD DWORD PTR [ESP-$04]
FMUL
FSINCOS
FMUL ST,ST(2)
FSTP TComplex.x [ECX]
FMUL
FSTP TComplex.y [ECX]
end;
//----------------------------------------------------------------------------//
//------- Transcendent functions ---------------------------------------------//
//----------------------------------------------------------------------------//
function cLn(z: TComplex): TComplex; register;
// z :--> Ln(z)
asm
FLD TComplex.y [EAX]
FLD TComplex.x [EAX]
FLDLN2
FLD1
FADD ST, ST
FDIV
FLD ST(2)
FMUL ST, ST
FLD ST(2)
FMUL ST, ST
FADD
FYL2X
FSTP TComplex.x [EDX]
FPATAN
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cExp(z: TComplex): TComplex; register;
// z :--> Exp(z)
asm
FLD TComplex.x [EAX]
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1)
FLD TComplex.y [EAX]
FSINCOS
FMUL ST,ST(2)
FSTP TComplex.x [EDX]
FMUL
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
//------ Trigonometric functions ---------------------------------------------//
//----------------------------------------------------------------------------//
function cSin(z: TComplex): TComplex; register;
// z :--> Sin(z)
asm
FLD TComplex.y [EAX]
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1)
FLD1
FLD ST(1)
FADD ST, ST
FDIV
FXCH
FLD1
FADD ST, ST
FDIV
FLD TComplex.x [EAX]
FSINCOS
FLD ST(2)
FSUB ST, ST(4)
FMUL
FSTP TComplex.y [EDX]
FXCH ST(2)
FADD
FMUL
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
function cCos(z: TComplex): TComplex; register;
// z :--> Cos(z)
asm
FLD TComplex.y [EAX]
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1)
FLD1
FLD ST(1)
FADD ST, ST
FDIV
FXCH
FLD1
FADD ST, ST
FDIV
FLD TComplex.x [EAX]
FSINCOS
FLD ST(2)
FADD ST, ST(4)
FMUL
FSTP TComplex.x [EDX]
FXCH ST(2)
FSUBR
FMUL
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cTan(z: TComplex): TComplex; register;
// z :--> Tan(z)
asm
FLD TComplex.x [EAX]
FADD ST, ST
FLD TComplex.y [EAX]
FADD ST, ST // 2y 2x
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1) // exp(2y) 2x
FLD1 // 1 exp(2y) 2x
FDIV ST(0), ST(1) // exp(-2y) exp(2y) 2x
FLD1
FADD ST, ST // 2 exp(-2y) exp(2y) 2x
FLD ST(0) // 2 2 exp(-2y) exp(2y) 2x
FDIVP ST(2), ST(0) // 2 exp(-2y)/2 exp(2y) 2x
FDIVP ST(2), ST(0) // exp(-2y)/2 exp(2y)/2 2x
FLD ST(1) // exp(2y)/2 exp(-2y)/2 exp(2y)/2 2x
FSUB ST(0), ST(1) // sinh(2y) exp(-2y)/2 exp(2y)/2 2x
FXCH ST(2) // exp(2y)/2 exp(-2y)/2 sinh(2y) 2x
FADD // cosh(2y) sinh(2y) 2x
FXCH ST(2) // 2x sinh(2y) cosh(2y)
FSINCOS // cos(2x) sin(2x) sinh(2y) cosh(2y)
FADDP ST(3), ST(0) // sin(2x) sinh(2y) (cos+cosh)
FDIV ST(0), ST(2)
FSTP TComplex.x [EDX] // sinh(2y) (cos+cosh)
FDIVR
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cCotan(z: TComplex): TComplex; register;
// z :--> Cotan(z)
asm
FLD TComplex.x [EAX]
FADD ST, ST
FLD TComplex.y [EAX]
FADD ST, ST // 2y 2x
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1) // exp(2y) 2x
FLD1 // 1 exp(2y) 2x
FDIV ST(0), ST(1) // exp(-2y) exp(2y) 2x
FLD1
FADD ST, ST // 2 exp(-2y) exp(2y) 2x
FLD ST(0) // 2 2 exp(-2y) exp(2y) 2x
FDIVP ST(2), ST(0) // 2 exp(-2y)/2 exp(2y) 2x
FDIVP ST(2), ST(0) // exp(-2y)/2 exp(2y)/2 2x
FLD ST(0) // exp(-2y)/2 exp(-2y)/2 exp(2y)/2 2x
FSUB ST(0), ST(2) // -sinh(2y) exp(-2y)/2 exp(2y)/2 2x
FXCH ST(2)
FADD
FXCH ST(2)
FSINCOS
FSUBP ST(3), ST(0)
FDIV ST(0), ST(2)
FSTP TComplex.x [EDX]
FDIVR
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
//------ Hyperbolic functions -----------------------------------------------//
//----------------------------------------------------------------------------//
function cSinh(z: TComplex): TComplex; register;
// z :--> Sinh(z)
asm
FLD TComplex.x [EAX]
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1) // exp(x)
FLD1 // 1 exp(x)
FLD ST(1) // exp(x) 1 exp(x)
FADD ST, ST // 2exp(x) 1 exp(x)
FDIV // 1/2exp(x) exp(x)
FXCH // exp(x) 1/2exp(x)
FLD1 // 1 exp(x) 1/2exp(x)
FADD ST, ST // 2 exp(x) 1/2exp(x)
FDIV // exp(x)/2 1/2exp(x)
FLD TComplex.y [EAX] // y tmp tmp2
FSINCOS // cos(y) sin(y) tmp tmp2
FLD ST(2) // tmp cos(y) sin(y) tmp tmp2
FSUB ST, ST(4) // (tmp-tmp2) cos(y) sin(y) tmp tmp2
FMUL
FSTP TComplex.x [EDX] // sin(y) tmp tmp2
FXCH ST(2) // tmp2 tmp sin(y)
FADD // (tmp+tmp2 sin(y)
FMUL
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cCosh(z: TComplex): TComplex; register;
// z :--> Cosh(z)
asm
FLD TComplex.x [EAX]
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1) // exp(x)
FLD1 // 1 exp(x)
FLD ST(1) // exp(x) 1 exp(x)
FADD ST, ST // 2exp(x) 1 exp(x)
FDIV // 1/2exp(x) exp(x)
FXCH // exp(x) 1/2exp(x)
FLD1 // 1 exp(x) 1/2exp(x)
FADD ST, ST // 2 exp(x) 1/2exp(x)
FDIV // exp(x)/2 1/2exp(x)
FLD TComplex.y [EAX] // y tmp tmp2
FSINCOS // cos(y) sin(y) tmp tmp2
FLD ST(2) // tmp cos(y) sin(y) tmp tmp2
FADD ST, ST(4) // (tmp+tmp2) cos(y) sin(y) tmp tmp2
FMUL
FSTP TComplex.x [EDX] // sin(y) tmp tmp2
FXCH ST(2) // tmp2 tmp sin(y)
FSUB // (tmp-tmp2 sin(y)
FMUL
FSTP TComplex.y [EDX]
end;
//----------------------------------------------------------------------------//
function cTanh(z: TComplex): TComplex; register;
// z :--> Tanh(z)
asm
FLD TComplex.y [EAX]
FADD ST, ST
FLD TComplex.x [EAX]
FADD ST, ST // 2x 2y
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1) // exp(2x) 2y
FLD1 // 1 exp(2x) 2y
FDIV ST(0),ST(1) // exp(-2x) exp(2x) 2y
FLD1
FADD ST,ST // 2 exp(-2x) exp(2x) 2y
FLD ST(0) // 2 2 exp(-2x) exp(2x) 2y
FDIVP ST(2), ST(0) // 2 exp(-2x)/2 exp(2x) 2y
FDIVP ST(2), ST(0) // exp(-2x)/2 exp(2x)/2 2y
FLD ST(1) // exp(2x)/2 exp(-2x)/2 exp(2x)/2 2y
FSUB ST(0), ST(1) // sinh(2x) exp(-2x)/2 exp(2x)/2 2y
FXCH ST(2) // exp(2x)/2 exp(-2x)/2 sinh(2x) 2y
FADD // cosh(2x) sinh(2x) 2y
FXCH ST(2) // 2y sinh(2x) cosh(2x)
FSINCOS // cos(2y) sin(2y) sinh(2x) cosh(2x)
FADDP ST(3), ST(0) // sin(2y) sinh(2x) (cos+cosh)
FDIV ST(0), ST(2)
FSTP TComplex.y [EDX] // sinh(2x) (cos+cosh)
FDIVR
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
function cCotanh(z: TComplex): TComplex; register;
// z :--> Cotanh(z)
asm
FLD TComplex.y [EAX]
FADD ST, ST
FLD TComplex.x [EAX]
FADD ST, ST
FLDL2E
FMUL
FLD ST(0)
FRNDINT
FSUB ST(1), ST
FXCH ST(1)
F2XM1
FLD1
FADD
FSCALE
FSTP ST(1)
FLD1
FDIV ST(0), ST(1)
FLD1
FADD ST,ST
FLD ST(0)
FDIVP ST(2), ST(0)
FDIVP ST(2), ST(0)
FLD ST(0)
FSUB ST(0), ST(2)
FXCH ST(2)
FADD
FXCH ST(2)
FSINCOS
FSUBRP ST(3), ST(0)
FDIV ST(0), ST(2)
FSTP TComplex.y [EDX]
FDIVR
FSTP TComplex.x [EDX]
end;
//----------------------------------------------------------------------------//
//------ Other operations ----------------------------------------------------//
//----------------------------------------------------------------------------//
function Complex(x, y: TComplexType): TComplex; register;
// Result.x:= x; Result.y:= y
asm
FLD x
FSTP TComplex.x [EAX]
FLD y
FSTP TComplex.y [EAX]
end;
//----------------------------------------------------------------------------//
function cEqual(z1, z2: TComplex): boolean; register;
// z1 = z2
asm
MOV ECX, EAX
FLD TComplex.x [ECX]
FLD TComplex.x [EDX]
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
FLD TComplex.y [ECX]
FLD TComplex.y [EDX]
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
MOV AL, $01
ret
@NOT:
XOR AL, AL
end;
//----------------------------------------------------------------------------//
function cEqualZero(z: TComplex): boolean; register;
// z.x = 0 and z.y = 0
{begin
Result:= (z.x = 0) and (z.y = 0)
end;}
asm
MOV ECX, EAX
FLD TComplex.x [ECX]
FLDZ
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
FLD TComplex.y [ECX]
FLDZ
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
MOV AL, $1
RET
@NOT:
XOR AL, AL
end;
//----------------------------------------------------------------------------//
function cEqualOne(z: TComplex): boolean; register;
// z.x = 1 and z.y = 0
{begin
Result:= (z.x = 1) and(z.y = 0)
end;}
asm
MOV ECX, EAX
FLD TComplex.x [ECX]
FLD1
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
FLD TComplex.y [ECX]
FLDZ
FCOMPP
FSTSW AX
SAHF
JNZ @NOT
MOV AL, $01
ret
@NOT:
XOR AL, AL
end;
//----------------------------------------------------------------------------//
//------ Other operations ----------------------------------------------------//
//----------------------------------------------------------------------------//
function ComplexToStr(z: TComplex): string;
var x, y: TComplexType;
begin
if not cEqualZero(z) then begin
Result:= '';
x:= Re(z);
y:= Im(z);
if x <> 0 then Result:= FloatToStr(x);
if y <> 0 then begin
if (y > 0) and (x <> 0) then
Result:= Result + '+';
Result:= Result + FloatToStr(y) + 'i'
end
end else Result:= '0'
end;
//----------------------------------------------------------------------------//
function StrToComplex(S: string): TComplex;
var i: integer;
sr, si: string;
begin
if Length(S) <> 0 then
if S[Length(S)] in ['i', 'I'] then begin
i:= Length(S) - 1;
while (not (S[i] in ['+', '-'])) and (i > 1) do
dec(i);
if S[i - 1] in ['E', 'e'] then begin
dec(i);
while not (S[i] in ['+', '-']) do
dec(i)
end;
sr:= Copy(S, 1, i - 1);
if sr = '' then sr:= '0';
si:= Copy(S, i, Length(S) - i);
Result.x:= StrToFloat(sr);
Result.y:= StrToFloat(si)
end else begin
Result.x:= StrToFloat(S);
Result.y:= 0
end
else Result:= NullComplex;
end;
//----------------------------------------------------------------------------//
function cmPow(z: TComplex; n: integer): TComplex;
var x, y, r, f: TComplexType;
begin
x:= Re(z);
y:= Im(z);
r:= Power(SQRT(SQR(x) + SQR(y)), n);
if x > 0 then f:= ArcTan(y / x)
else if x < 0 then f:= PI * ArcTan(y / x)
else if y > 0 then f:= PI / 2
else if y < 0 then f:= -PI / 2;
Result:= Complex(r * COS(n * f), r * SIN(n * f))
end;
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
end. /// end of cmplx module ///