Модуль для работы с комплексными числами

{ **** 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 ///
Author: Separator
ID: 04065
Category:Алгоритмы
Category:Математика