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

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

{ **** UBPFD *********** by kladovka.net.ru ****
>>
Модуль предназначен для работы с комплексными числами.
Данный модуль был взят с <a href="http://gaivan.hypermart.net" title="http://gaivan.hypermart.net">http://gaivan.hypermart.net</a> и переработан мной
Зависимости: SysUtils - для работы ComplexToStr и StrToComplex; Math - для cmPow
Автор: Separator, <a href="mailto:wilhelm@mail.ru">wilhelm@mail.ru</a>, ICQ:162770303, Алматы
Copyright: http://gaivan.hypermart.net
Дата: 16 марта 2004 г.
********************************************** }

unit cmplx;
//----------------------------------------------------------------------------//
// Complex numbers routines library //
// Copyright (c) 2001 by Serghei Gaivan //
// e-mail: <a href="mailto:gaivan@mail.hypermart.net">gaivan@mail.hypermart.net</a> //
// <a href="http://gaivan.hypermart.net" title="http://gaivan.hypermart.net">http://gaivan.hypermart.net</a> //
//----------------------------------------------------------------------------//
// Update: //
// 04.07.2003 Sergey Vilgelm (<a href="mailto:wilhelm@mail.kz">wilhelm@mail.kz</a>) //
//----------------------------------------------------------------------------//
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 ///

Закралась ошибка в cSqrt. не учитывается знак мнимой части.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...