1589 lines
46 KiB
ObjectPascal
1589 lines
46 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclComplex.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Alexei Koudinov. Portions created by }
|
|
{ Alexei Koudinov are Copyright (C) of Alexei Koudinov. All Rights Reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Marcel van Brakel }
|
|
{ Alexei Koudinov }
|
|
{ Robert Marquardt (marquardt) }
|
|
{ Robert Rossmair (rrossmair) }
|
|
{ Matthias Thoma (mthoma) }
|
|
{ Petr Vones (pvones) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Class for working with complex numbers. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2006-08-03 16:10:29 +0200 (jeu., 03 août 2006) $
|
|
|
|
unit JclComplex;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
SysUtils,
|
|
JclBase, JclMath, JclResources, JclStrings;
|
|
|
|
const
|
|
TComplex_VERSION = 5.01;
|
|
|
|
type
|
|
TComplexKind = (crRectangular, crPolar);
|
|
|
|
TCoords = record
|
|
X: Float; // rectangular real
|
|
Y: Float; // rectangular imaginary
|
|
R: Float; // polar 1
|
|
Theta: Float; // polar 2
|
|
end;
|
|
|
|
TRectCoord = record
|
|
X: Float;
|
|
Y: Float;
|
|
end;
|
|
|
|
TJclComplex = class(TObject)
|
|
private {z = x + yi}
|
|
FCoord: TCoords;
|
|
FFracLen: Byte;
|
|
function MiscalcSingle(const X: Float): Float;
|
|
procedure MiscalcComplex; // eliminates miscalculation
|
|
procedure FillCoords(const ComplexType: TComplexKind);
|
|
function GetRectangularString: string;
|
|
function GetPolarString: string;
|
|
procedure SetRectangularString(StrToParse: string);
|
|
procedure SetPolarString(StrToParse: string);
|
|
procedure SetFracLen(const X: Byte);
|
|
function GetRadius: Float;
|
|
function GetAngle: Float;
|
|
function NormalizeAngle(Value: Float): Float;
|
|
protected
|
|
function Assign(const Coord: TCoords; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CoreAdd(const First, Second: TRectCoord): TRectCoord;
|
|
function CoreDiv(const First, Second: TRectCoord): TRectCoord;
|
|
function CoreMul(const First, Second: TRectCoord): TRectCoord;
|
|
function CoreSub(const First, Second: TRectCoord): TRectCoord;
|
|
function CoreLn (const LnValue: TRectCoord): TRectCoord;
|
|
function CoreExp(const ExpValue: TRectCoord): TRectCoord;
|
|
function CorePwr(First, Second, Polar: TRectCoord): TRectCoord;
|
|
function CoreIntPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Integer): TRectCoord;
|
|
function CoreRealPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Float): TRectCoord;
|
|
function CoreRoot(First: TRectCoord; const Polar: TRectCoord; const K, N: Word): TRectCoord;
|
|
function CoreCos(const Value: TRectCoord): TRectCoord;
|
|
function CoreSin(const Value: TRectCoord): TRectCoord;
|
|
function CoreTan(const Value: TRectCoord): TRectCoord;
|
|
function CoreCot(const Value: TRectCoord): TRectCoord;
|
|
function CoreSec(const Value: TRectCoord): TRectCoord;
|
|
function CoreCsc(const Value: TRectCoord): TRectCoord;
|
|
function CoreCosH(const Value: TRectCoord): TRectCoord;
|
|
function CoreSinH(const Value: TRectCoord): TRectCoord;
|
|
function CoreTanH(const Value: TRectCoord): TRectCoord;
|
|
function CoreCotH(const Value: TRectCoord): TRectCoord;
|
|
function CoreSecH(const Value: TRectCoord): TRectCoord;
|
|
function CoreCscH(const Value: TRectCoord): TRectCoord;
|
|
function CoreI0(const Value: TRectCoord): TRectCoord;
|
|
function CoreJ0(const Value: TRectCoord): TRectCoord;
|
|
function CoreApproxLnGamma(const Value: TRectCoord): TRectCoord;
|
|
function CoreLnGamma(Value: TRectCoord): TRectCoord;
|
|
function CoreGamma(const Value: TRectCoord): TRectCoord;
|
|
public
|
|
//----------- constructors
|
|
constructor Create; overload;
|
|
constructor Create(const X, Y: Float; const ComplexType: TComplexKind = crRectangular); overload;
|
|
|
|
//----------- complex numbers assignment routines
|
|
function Assign(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function AssignZero: TJclComplex;
|
|
function AssignOne: TJclComplex;
|
|
function Duplicate: TJclComplex;
|
|
|
|
//----------- arithmetics -- modify the object itself
|
|
function CAdd(const AddValue: TJclComplex): TJclComplex; overload;
|
|
function CAdd(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CDiv(const DivValue: TJclComplex): TJclComplex; overload;
|
|
function CDiv(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CMul(const MulValue: TJclComplex): TJclComplex; overload;
|
|
function CMul(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CSub(const SubValue: TJclComplex): TJclComplex; overload;
|
|
function CSub(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNeg: TJclComplex;
|
|
function CConjugate: TJclComplex;
|
|
|
|
//----------- arithmetics -- creates new resulting object
|
|
function CNewAdd(const AddValue: TJclComplex): TJclComplex; overload;
|
|
function CNewAdd(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNewDiv(const DivValue: TJclComplex): TJclComplex; overload;
|
|
function CNewDiv(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNewMul(const MulValue: TJclComplex): TJclComplex; overload;
|
|
function CNewMul(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNewSub(const SubValue: TJclComplex): TJclComplex; overload;
|
|
function CNewSub(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNewNeg: TJclComplex;
|
|
function CNewConjugate: TJclComplex;
|
|
|
|
//----------- natural log and exponential functions
|
|
function CLn: TJclComplex;
|
|
function CNewLn: TJclComplex;
|
|
function CExp: TJclComplex;
|
|
function CNewExp: TJclComplex;
|
|
function CPwr(const PwrValue: TJclComplex): TJclComplex; overload;
|
|
function CPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CNewPwr(PwrValue: TJclComplex): TJclComplex; overload;
|
|
function CNewPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload;
|
|
function CIntPwr(const Pwr: Integer): TJclComplex; overload;
|
|
function CNewIntPwr(const Pwr: Integer): TJclComplex; overload;
|
|
function CRealPwr(const Pwr: Float): TJclComplex; overload;
|
|
function CNewRealPwr(const Pwr: Float): TJclComplex; overload;
|
|
function CRoot(const K, N: Word): TJclComplex; overload;
|
|
function CNewRoot(const K, N: Word): TJclComplex; overload;
|
|
function CSqrt: TJclComplex; overload;
|
|
function CNewSqrt: TJclComplex; overload;
|
|
|
|
//----------- trigonometric functions
|
|
function CCos: TJclComplex;
|
|
function CNewCos: TJclComplex;
|
|
function CSin: TJclComplex;
|
|
function CNewSin: TJclComplex;
|
|
function CTan: TJclComplex;
|
|
function CNewTan: TJclComplex;
|
|
function CCot: TJclComplex;
|
|
function CNewCot: TJclComplex;
|
|
function CSec: TJclComplex;
|
|
function CNewSec: TJclComplex;
|
|
function CCsc: TJclComplex;
|
|
function CNewCsc: TJclComplex;
|
|
|
|
//----------- complex hyperbolic functions
|
|
function CCosH: TJclComplex;
|
|
function CNewCosH: TJclComplex;
|
|
function CSinH: TJclComplex;
|
|
function CNewSinH: TJclComplex;
|
|
function CTanH: TJclComplex;
|
|
function CNewTanH: TJclComplex;
|
|
function CCotH: TJclComplex;
|
|
function CNewCotH: TJclComplex;
|
|
function CSecH: TJclComplex;
|
|
function CNewSecH: TJclComplex;
|
|
function CCscH: TJclComplex;
|
|
function CNewCscH: TJclComplex;
|
|
|
|
//----------- complex Bessel functions of order zero
|
|
function CI0: TJclComplex;
|
|
function CNewI0: TJclComplex;
|
|
function CJ0: TJclComplex;
|
|
function CNewJ0: TJclComplex;
|
|
|
|
function CApproxLnGamma: TJclComplex;
|
|
function CNewApproxLnGamma: TJclComplex;
|
|
function CLnGamma: TJclComplex;
|
|
function CNewLnGamma: TJclComplex;
|
|
function CGamma: TJclComplex;
|
|
function CNewGamma: TJclComplex;
|
|
|
|
//----------- miscellaneous routines
|
|
function AbsoluteValue: Float; overload;
|
|
function AbsoluteValue(const Coord: TRectCoord): Float; overload;
|
|
function AbsoluteValueSqr: Float; overload;
|
|
function AbsoluteValueSqr(const Coord: TRectCoord): Float; overload;
|
|
function FormatExtended(const X: Float): string;
|
|
|
|
property FracLength: Byte read FFracLen write SetFracLen default 8;
|
|
|
|
//----------- getting different parts of the number
|
|
property RealPart: Float read FCoord.X;
|
|
property ImaginaryPart: Float read FCoord.Y;
|
|
property Radius: Float read GetRadius;
|
|
property Angle: Float read GetAngle;
|
|
|
|
//----------- format output
|
|
property AsString: string read GetRectangularString write SetRectangularString;
|
|
property AsPolarString: string read GetPolarString write SetPolarString;
|
|
|
|
{$IFDEF CLR}
|
|
{ TODO : Implement operators }
|
|
{$ENDIF CLR}
|
|
end;
|
|
|
|
var
|
|
ComplexPrecision: Float = 1E-14;
|
|
|
|
const
|
|
MaxTerm: Byte = 35;
|
|
EpsilonSqr: Float = 1E-20;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net:443/svnroot/jcl/tags/JCL-1.100-Build2646/jcl/source/common/JclComplex.pas $';
|
|
Revision: '$Revision: 1706 $';
|
|
Date: '$Date: 2006-08-03 16:10:29 +0200 (jeu., 03 août 2006) $';
|
|
LogPath: 'JCL\source\common'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
const
|
|
MaxFracLen = 18;
|
|
RectOne: TRectCoord = (X: 1.0; Y: 0.0);
|
|
RectZero: TRectCoord = (X: 0.0; Y: 0.0);
|
|
RectInfinity: TRectCoord = (X: Infinity; Y: Infinity);
|
|
|
|
function Coordinates(const cX, cY: Float; CoordType: TComplexKind): TCoords;
|
|
begin
|
|
case CoordType of
|
|
crRectangular:
|
|
begin
|
|
Result.X := cX;
|
|
Result.Y := cY;
|
|
Result.R := 0.0;
|
|
Result.Theta := 0.0;
|
|
end;
|
|
crPolar:
|
|
begin
|
|
Result.X := 0.0;
|
|
Result.Y := 0.0;
|
|
Result.R := cX;
|
|
Result.Theta := cY;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function RectCoord(X, Y: Float): TRectCoord; overload;
|
|
begin
|
|
Result.X := X;
|
|
Result.Y := Y;
|
|
end;
|
|
|
|
function RectCoord(Value: TJclComplex): TRectCoord; overload;
|
|
begin
|
|
Result.X := Value.FCoord.X;
|
|
Result.Y := Value.FCoord.Y;
|
|
end;
|
|
|
|
//=== { TJclComplex } ========================================================
|
|
|
|
constructor TJclComplex.Create;
|
|
begin
|
|
inherited Create;
|
|
AssignZero;
|
|
FFracLen := MaxFracLen;
|
|
end;
|
|
|
|
constructor TJclComplex.Create(const X, Y: Float; const ComplexType: TComplexKind);
|
|
begin
|
|
inherited Create;
|
|
Assign(X, Y, ComplexType);
|
|
FFracLen := MaxFracLen;
|
|
end;
|
|
|
|
procedure TJclComplex.FillCoords(const ComplexType: TComplexKind);
|
|
begin
|
|
MiscalcComplex;
|
|
case ComplexType of
|
|
crPolar:
|
|
begin
|
|
FCoord.X := FCoord.R * Cos(FCoord.Theta);
|
|
FCoord.Y := FCoord.R * Sin(FCoord.Theta);
|
|
end;
|
|
crRectangular:
|
|
if FCoord.X = 0.0 then
|
|
begin
|
|
FCoord.R := Abs(FCoord.Y);
|
|
FCoord.Theta := PiOn2 * Sgn(FCoord.Y);
|
|
end
|
|
else
|
|
begin
|
|
FCoord.R := AbsoluteValue;
|
|
FCoord.Theta := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.ArcTan(FCoord.Y / FCoord.X);
|
|
if FCoord.X < 0.0 then
|
|
FCoord.Theta := FCoord.Theta + Pi * Sgn(FCoord.Y);
|
|
end;
|
|
end;
|
|
MiscalcComplex;
|
|
end;
|
|
|
|
function TJclComplex.MiscalcSingle(const X: Float): Float;
|
|
begin
|
|
Result := X;
|
|
if Abs(Result) < ComplexPrecision then
|
|
Result := 0.0;
|
|
end;
|
|
|
|
procedure TJclComplex.MiscalcComplex; // eliminates miscalculation
|
|
begin
|
|
FCoord.X := MiscalcSingle(FCoord.X);
|
|
FCoord.Y := MiscalcSingle(FCoord.Y);
|
|
FCoord.R := MiscalcSingle(FCoord.R);
|
|
if FCoord.R = 0.0 then
|
|
FCoord.Theta := 0.0
|
|
else
|
|
FCoord.Theta := MiscalcSingle(FCoord.Theta);
|
|
end;
|
|
|
|
function TJclComplex.Assign(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
begin
|
|
Result := Assign(Coordinates(X, Y, ComplexType), ComplexType);
|
|
end;
|
|
|
|
function TJclComplex.Assign(const Coord: TCoords; const ComplexType: TComplexKind): TJclComplex;
|
|
begin
|
|
FCoord := Coord;
|
|
FillCoords(ComplexType);
|
|
MiscalcComplex;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.AssignZero: TJclComplex;
|
|
begin
|
|
Result := Assign(0.0, 0.0, crRectangular);
|
|
end;
|
|
|
|
function TJclComplex.AssignOne: TJclComplex;
|
|
begin
|
|
Result := Assign(1.0, 0.0, crRectangular);
|
|
end;
|
|
|
|
function TJclComplex.GetRectangularString: string;
|
|
const
|
|
cImaginary = 'i';
|
|
begin
|
|
MiscalcComplex;
|
|
if (FCoord.X = 0.0) and (FCoord.Y = 0.0) then
|
|
Result := '0'
|
|
else
|
|
if FCoord.X <> 0.0 then
|
|
begin
|
|
Result := FormatExtended(FCoord.X);
|
|
if FCoord.Y > 0.0 then
|
|
Result := Result + '+'
|
|
else
|
|
if FCoord.Y < 0.0 then
|
|
Result := Result + '-';
|
|
if FCoord.Y <> 0.0 then
|
|
Result := Result + FormatExtended(Abs(FCoord.Y)) + cImaginary;
|
|
end
|
|
else
|
|
Result := FormatExtended(FCoord.Y) + cImaginary;
|
|
end;
|
|
|
|
function TJclComplex.GetPolarString: string;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
Result := FormatExtended(FCoord.R) + '*CIS(' + FormatExtended(FCoord.Theta) + ')';
|
|
end;
|
|
|
|
procedure TJclComplex.SetRectangularString(StrToParse: string);
|
|
var
|
|
SignPos: Integer;
|
|
RealPart, ImagPart: Float;
|
|
begin
|
|
StrToParse := StrRemoveChars(StrToParse, [' ']);
|
|
SignPos := StrFind('+', StrToParse, 2);
|
|
if SignPos = 0 then
|
|
SignPos := StrFind('-', StrToParse, 2);
|
|
if SignPos > 0 then
|
|
begin
|
|
try
|
|
RealPart := StrToFloat(Copy(StrToParse, 1, SignPos - 1));
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
try
|
|
ImagPart := StrToFloat(Copy(StrToParse, SignPos, Length(StrToParse) - SignPos));
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if (StrToParse[Length(StrToParse)] = 'i') or (StrToParse[Length(StrToParse)] = 'I') then
|
|
begin
|
|
RealPart := 0.0;
|
|
try
|
|
ImagPart := StrToFloat(Copy(StrToParse, 1, Length(StrToParse) - 1));
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
try
|
|
RealPart := StrToFloat(StrToParse);
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
ImagPart := 0.0;
|
|
end;
|
|
end;
|
|
Assign(RealPart, ImagPart, crRectangular);
|
|
end;
|
|
|
|
procedure TJclComplex.SetPolarString(StrToParse: string);
|
|
var
|
|
AstPos: Integer;
|
|
Radius, Angle: Float;
|
|
begin
|
|
{$IFDEF CLR}
|
|
StrToParse := StrRemoveChars(StrToParse, [' ']).toUpper;
|
|
{$ELSE}
|
|
StrToParse := AnsiUpperCase(StrRemoveChars(StrToParse, [' ']));
|
|
{$ENDIF CLR}
|
|
AstPos := Pos('*', StrToParse);
|
|
if AstPos = 0 then
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
try
|
|
Radius := StrToFloat(StrLeft(StrToParse, AstPos - 1));
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
AstPos := Pos('(', StrToParse);
|
|
if AstPos = 0 then
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
try
|
|
Angle := StrToFloat(Copy(StrToParse, AstPos + 1, Length(StrToParse) - AstPos - 1));
|
|
except
|
|
{$IFDEF CLR}
|
|
raise EJclMathError.Create(RsComplexInvalidString);
|
|
{$ELSE}
|
|
raise EJclMathError.CreateRes(@RsComplexInvalidString);
|
|
{$ENDIF CLR}
|
|
end;
|
|
Assign(Radius, Angle, crPolar);
|
|
end;
|
|
|
|
function TJclComplex.Duplicate: TJclComplex;
|
|
begin
|
|
Result := TJclComplex.Create(FCoord.X, FCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
//=== arithmetics ============================================================
|
|
|
|
function TJclComplex.CoreAdd(const First, Second: TRectCoord): TRectCoord;
|
|
begin
|
|
Result.X := First.X + Second.X;
|
|
Result.Y := First.Y + Second.Y;
|
|
end;
|
|
|
|
function TJclComplex.CAdd(const AddValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreAdd(RectCoord(Self), RectCoord(AddValue));
|
|
FCoord.X := ResCoord.X;
|
|
FCoord.Y := ResCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CAdd(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CAdd(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNewAdd(const AddValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreAdd(RectCoord(Self), RectCoord(AddValue));
|
|
Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CNewAdd(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CNewAdd(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CoreDiv(const First, Second: TRectCoord): TRectCoord;
|
|
var
|
|
Denom: Float;
|
|
begin
|
|
Denom := Sqr(Second.X) + Sqr(Second.Y);
|
|
Result.X := (First.X * Second.X + First.Y * Second.Y) / Denom;
|
|
Result.Y := (First.Y * Second.X - First.X * Second.Y) / Denom;
|
|
end;
|
|
|
|
function TJclComplex.CDiv(const DivValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreDiv(RectCoord(Self), RectCoord(DivValue));
|
|
FCoord.X := ResCoord.X;
|
|
FCoord.Y := ResCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CDiv(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CDiv(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNewDiv(const DivValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreDiv(RectCoord(Self), RectCoord(DivValue));
|
|
Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CNewDiv(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CNewDiv(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CoreMul(const First, Second: TRectCoord): TRectCoord;
|
|
begin
|
|
Result.X := First.X * Second.X - First.Y * Second.Y;
|
|
Result.Y := First.X * Second.Y + First.Y * Second.X;
|
|
end;
|
|
|
|
function TJclComplex.CMul(const MulValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreMul(RectCoord(Self), RectCoord(MulValue));
|
|
FCoord.X := ResCoord.X;
|
|
FCoord.Y := ResCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CMul(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CMul(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNewMul(const MulValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreMul(RectCoord(Self), RectCoord(MulValue));
|
|
Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CNewMul(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CNewMul(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CoreSub(const First, Second: TRectCoord): TRectCoord;
|
|
begin
|
|
Result.X := First.X - Second.X;
|
|
Result.Y := First.Y - Second.Y;
|
|
end;
|
|
|
|
function TJclComplex.CSub(const SubValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSub(RectCoord(Self), RectCoord(SubValue));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CSub(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CSub(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNewSub(const SubValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSub(RectCoord(Self), RectCoord(SubValue));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CNewSub(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CNewSub(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNeg;
|
|
begin
|
|
FCoord.X := -FCoord.X;
|
|
FCoord.Y := -FCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewNeg;
|
|
begin
|
|
Result := TJclComplex.Create(-FCoord.X, -FCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CConjugate;
|
|
begin
|
|
FCoord.Y := -FCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewConjugate;
|
|
begin
|
|
Result := TJclComplex.Create(FCoord.X, -FCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
//=== natural log and exponential functions ==================================
|
|
|
|
function TJclComplex.CoreLn(const LnValue: TRectCoord): TRectCoord;
|
|
begin
|
|
Result.X := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Ln(LnValue.X);
|
|
Result.Y := NormalizeAngle(LnValue.Y);
|
|
end;
|
|
|
|
function TJclComplex.CLn: TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResCoord := CoreLn(RectCoord(FCoord.R, FCoord.Theta));
|
|
FCoord.X := ResCoord.X;
|
|
FCoord.Y := ResCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewLn: TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResCoord := CoreLn(RectCoord(FCoord.R, FCoord.Theta));
|
|
Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreExp(const ExpValue: TRectCoord): TRectCoord;
|
|
var
|
|
ExpX: Float;
|
|
begin
|
|
ExpX := Exp(ExpValue.X);
|
|
Result.X := ExpX * Cos(ExpValue.Y);
|
|
Result.Y := ExpX * Sin(ExpValue.Y);
|
|
end;
|
|
|
|
function TJclComplex.CExp: TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreExp(RectCoord(FCoord.X, FCoord.Y));
|
|
FCoord.X := ResCoord.X;
|
|
FCoord.Y := ResCoord.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewExp: TJclComplex;
|
|
var
|
|
ResCoord: TRectCoord;
|
|
begin
|
|
ResCoord := CoreExp(RectCoord(FCoord.X, FCoord.Y));
|
|
Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CorePwr(First, Second, Polar: TRectCoord): TRectCoord;
|
|
begin
|
|
First.X := MiscalcSingle(First.X);
|
|
First.Y := MiscalcSingle(First.Y);
|
|
Second.X := MiscalcSingle(Second.X);
|
|
Second.Y := MiscalcSingle(Second.Y);
|
|
if AbsoluteValueSqr(First) = 0.0 then
|
|
if AbsoluteValueSqr(Second) = 0.0 then
|
|
Result := RectOne
|
|
else
|
|
Result := RectZero
|
|
else
|
|
Result := CoreExp(CoreMul(Second, CoreLn(Polar)));
|
|
end;
|
|
|
|
function TJclComplex.CPwr(const PwrValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CorePwr(RectCoord(Self), RectCoord(PwrValue), RectCoord(FCoord.R, FCoord.Theta));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CPwr(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CPwr(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CNewPwr(PwrValue: TJclComplex): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CorePwr(RectCoord(Self), RectCoord(PwrValue), RectCoord(FCoord.R, FCoord.Theta));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CNewPwr(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex;
|
|
var
|
|
NewComplex: TJclComplex;
|
|
begin
|
|
NewComplex := TJclComplex.Create(X, Y, ComplexType);
|
|
try
|
|
Result := CNewPwr(NewComplex);
|
|
finally
|
|
NewComplex.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CoreIntPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Integer): TRectCoord;
|
|
begin
|
|
First.X := MiscalcSingle(First.X);
|
|
First.Y := MiscalcSingle(First.Y);
|
|
if AbsoluteValueSqr(First) = 0.0 then
|
|
if Pwr = 0 then
|
|
Result := RectOne
|
|
else
|
|
Result := RectZero
|
|
else
|
|
Result := RectCoord(PowerInt(Polar.X, Pwr), NormalizeAngle(Pwr * Polar.Y));
|
|
end;
|
|
|
|
function TJclComplex.CIntPwr(const Pwr: Integer): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreIntPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr);
|
|
FCoord.R := ResValue.X;
|
|
FCoord.Theta := ResValue.Y;
|
|
FillCoords(crPolar);
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewIntPwr(const Pwr: Integer): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreIntPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr);
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreRealPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Float): TRectCoord;
|
|
begin
|
|
First.X := MiscalcSingle(First.X);
|
|
First.Y := MiscalcSingle(First.Y);
|
|
if AbsoluteValueSqr(First) = 0.0 then
|
|
if MiscalcSingle(Pwr) = 0.0 then
|
|
Result := RectOne
|
|
else
|
|
Result := RectZero
|
|
else
|
|
Result := RectCoord(Power(Polar.X, Pwr), NormalizeAngle(Pwr * Polar.Y));
|
|
end;
|
|
|
|
function TJclComplex.CRealPwr(const Pwr: Float): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreRealPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr);
|
|
FCoord.R := ResValue.X;
|
|
FCoord.Theta := ResValue.Y;
|
|
FillCoords(crPolar);
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewRealPwr(const Pwr: Float): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreRealPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr);
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreRoot(First: TRectCoord; const Polar: TRectCoord; const K, N: Word): TRectCoord;
|
|
begin
|
|
First.X := MiscalcSingle(First.X);
|
|
First.Y := MiscalcSingle(First.Y);
|
|
if AbsoluteValue(First) = 0.0 then
|
|
Result := RectZero
|
|
else
|
|
Result := RectCoord(Power(Polar.X, 1.0 / N), NormalizeAngle((Polar.Y + K * TwoPi) / N));
|
|
end;
|
|
|
|
function TJclComplex.CRoot(const K, N: Word): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreRoot(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), K, N);
|
|
FCoord.R := ResValue.X;
|
|
FCoord.Theta := ResValue.Y;
|
|
FillCoords(crPolar);
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewRoot(const K, N: Word): TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
ResValue := CoreRoot(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), K, N);
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CSqrt: TJclComplex;
|
|
begin
|
|
Result := CRoot(0, 2);
|
|
end;
|
|
|
|
function TJclComplex.CNewSqrt: TJclComplex;
|
|
begin
|
|
Result := CNewRoot(0, 2);
|
|
end;
|
|
|
|
//=== trigonometric functions ================================================
|
|
|
|
function TJclComplex.CoreCos(const Value: TRectCoord): TRectCoord;
|
|
begin
|
|
Result := RectCoord(Cos(Value.X) * CosH(Value.Y), -Sin(Value.X) * SinH(Value.Y));
|
|
end;
|
|
|
|
function TJclComplex.CCos: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCos(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCos: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCos(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreSin(const Value: TRectCoord): TRectCoord;
|
|
begin
|
|
Result := RectCoord(Sin(Value.X) * CosH(Value.Y), Cos(Value.X) * SinH(Value.Y));
|
|
end;
|
|
|
|
function TJclComplex.CSin: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSin(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewSin: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSin(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreTan(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: Float;
|
|
begin
|
|
TempValue := Cos(2.0 * Value.X) + CosH(2.0 * Value.Y);
|
|
if MiscalcSingle(TempValue) <> 0.0 then
|
|
Result := RectCoord(Sin(2.0 * Value.X) / TempValue, SinH(2.0 * Value.Y) / TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CTan: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreTan(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewTan: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreTan(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreCot(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: Float;
|
|
begin
|
|
TempValue := Cosh(2.0 * Value.Y) - Cos(2.0 * Value.X);
|
|
if MiscalcSingle(TempValue) <> 0.0 then
|
|
Result := RectCoord(Sin(2.0 * Value.X) / TempValue, -SinH(2.0 * Value.Y) / TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CCot: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCot(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCot: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCot(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreSec(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: TRectCoord;
|
|
begin
|
|
TempValue := CoreCos(Value);
|
|
if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
|
|
Result := CoreDiv(RectOne, TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CSec: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSec(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewSec: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSec(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreCsc(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: TRectCoord;
|
|
begin
|
|
TempValue := CoreSin(Value);
|
|
if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
|
|
Result := CoreDiv(RectOne, TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CCsc: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCsc(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCsc: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCsc(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
//=== hyperbolic functions ===================================================
|
|
|
|
function TJclComplex.CoreCosH(const Value: TRectCoord): TRectCoord;
|
|
begin
|
|
Result := RectCoord(CosH(Value.X) * Cos(Value.Y), SinH(Value.X) * Sin(Value.Y));
|
|
end;
|
|
|
|
function TJclComplex.CCosH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCosH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCosH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCosH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreSinH(const Value: TRectCoord): TRectCoord;
|
|
begin
|
|
Result := RectCoord(SinH(Value.X) * Cos(Value.Y), CosH(Value.X) * Sin(Value.Y));
|
|
end;
|
|
|
|
function TJclComplex.CSinH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSinH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewSinH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSinH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreTanH(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: Float;
|
|
begin
|
|
TempValue := CosH(2.0 * Value.X) + Cos(2.0 * Value.Y);
|
|
if MiscalcSingle(TempValue) <> 0.0 then
|
|
Result := RectCoord(SinH(2.0 * Value.X) / TempValue, Sin(2.0 * Value.Y) / TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CTanH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreTanH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewTanH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreTanH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreCotH(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: Float;
|
|
begin
|
|
TempValue := Cosh(2.0 * Value.X) - Cos(2.0 * Value.Y);
|
|
if MiscalcSingle(TempValue) <> 0.0 then
|
|
Result := RectCoord(SinH(2.0 * Value.X) / TempValue, -Sin(2.0 * Value.Y) / TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CCotH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCotH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCotH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCotH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreSecH(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: TRectCoord;
|
|
begin
|
|
TempValue := CoreCosH(Value);
|
|
if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
|
|
Result := CoreDiv(RectOne, TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CSecH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSecH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewSecH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreSecH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreCscH(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
TempValue: TRectCoord;
|
|
begin
|
|
TempValue := CoreSinH(Value);
|
|
if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
|
|
Result := CoreDiv(RectOne, TempValue)
|
|
else
|
|
Result := RectInfinity;
|
|
end;
|
|
|
|
function TJclComplex.CCscH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCscH(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewCscH: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreCscH(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
//=== complex Bessel functions of order zero =================================
|
|
|
|
function TJclComplex.CoreI0(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
ZSqr25, Term: TRectCoord;
|
|
I: Integer;
|
|
SizeSqr: Float;
|
|
begin
|
|
Result := RectOne;
|
|
ZSqr25 := CoreMul(Value, Value);
|
|
ZSqr25 := RectCoord(0.25 * ZSqr25.X, 0.25 * ZSqr25.Y);
|
|
Term := ZSqr25;
|
|
Result := CoreAdd(Result, ZSqr25);
|
|
I := 1;
|
|
repeat
|
|
Term := CoreMul(ZSqr25, Term);
|
|
Inc(I);
|
|
Term := RectCoord(Term.X / Sqr(I), Term.Y / Sqr(I));
|
|
Result := CoreAdd(Result, Term);
|
|
SizeSqr := Sqr(Term.X) + Sqr(Term.Y);
|
|
until (I > MaxTerm) or (SizeSqr < EpsilonSqr);
|
|
end;
|
|
|
|
function TJclComplex.CI0: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreI0(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewI0: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreI0(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreJ0(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
ZSqr25, Term: TRectCoord;
|
|
I: Integer;
|
|
SizeSqr: Float;
|
|
AddFlag: Boolean;
|
|
begin
|
|
Result := RectOne;
|
|
ZSqr25 := CoreMul(Value, Value);
|
|
ZSqr25 := RectCoord(0.25 * ZSqr25.X, 0.25 * ZSqr25.Y);
|
|
Term := ZSqr25;
|
|
Result := CoreSub(Result, ZSqr25);
|
|
AddFlag := False;
|
|
I := 1;
|
|
repeat
|
|
Term := CoreMul(ZSqr25, Term);
|
|
Inc(I);
|
|
AddFlag := not AddFlag;
|
|
Term := RectCoord(Term.X / Sqr(I), Term.Y / Sqr(I));
|
|
if AddFlag then
|
|
Result := CoreAdd(Result, Term)
|
|
else
|
|
Result := CoreSub(Result, Term);
|
|
SizeSqr := Sqr(Term.X) + Sqr(Term.Y);
|
|
until (I > MaxTerm) or (SizeSqr < EpsilonSqr);
|
|
end;
|
|
|
|
function TJclComplex.CJ0: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreJ0(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewJ0: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreJ0(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreApproxLnGamma(const Value: TRectCoord): TRectCoord;
|
|
const
|
|
C: array [1..8] of Float =
|
|
(1.0 / 12.0, -1.0 / 360.0, 1.0 / 1260.0, -1.0 / 1680.0,
|
|
1.0 / 1188.0, -691.0 / 360360.0, 1.0 / 156.0, -3617.0 / 122400.0);
|
|
var
|
|
I: Integer;
|
|
Powers: array [1..8] of TRectCoord;
|
|
Temp1, Temp2: TRectCoord;
|
|
begin
|
|
Temp1 := CoreLn(Value);
|
|
Temp2 := RectCoord(Value.X - 0.5, Value.Y);
|
|
Result := CoreAdd(Temp1, Temp2);
|
|
Result := CoreSub(Result, Value);
|
|
Result.X := Result.X + hLn2PI;
|
|
|
|
Temp1 := RectOne;
|
|
Powers[1] := CoreDiv(Temp1, Value);
|
|
Temp2 := CoreMul(powers[1], Powers[1]);
|
|
for I := 2 to 8 do
|
|
Powers[I] := CoreMul(Powers[I - 1], Temp2);
|
|
for I := 8 downto 1 do
|
|
begin
|
|
Temp1 := RectCoord(C[I] * Powers[I].X, C[I] * Powers[I].Y);
|
|
Result := CoreAdd(Result, Temp1);
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CApproxLnGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreApproxLnGamma(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewApproxLnGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreApproxLnGamma(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreLnGamma(Value: TRectCoord): TRectCoord;
|
|
var
|
|
LNA, Temp: TRectCoord;
|
|
begin
|
|
if (Value.X <= 0.0) and (MiscalcSingle(Value.Y) = 0.0) then
|
|
if MiscalcSingle(Int(Value.X - 1E-8) - Value.X) = 0.0 then
|
|
begin
|
|
Result := RectInfinity;
|
|
Exit;
|
|
end;
|
|
|
|
if Value.Y < 0.0 then
|
|
begin
|
|
Value := RectCoord(Value.X, -Value.Y);
|
|
Result := CoreLnGamma(Value);
|
|
Result := RectCoord(Result.X, -Result.Y);
|
|
end
|
|
else
|
|
begin
|
|
if Value.X < 9.0 then
|
|
begin
|
|
LNA := CoreLn(Value);
|
|
Value := RectCoord(Value.X + 1, Value.Y);
|
|
Temp := CoreLnGamma(Value);
|
|
Result := CoreSub(Temp, LNA);
|
|
end
|
|
else
|
|
CoreApproxLnGamma(Value);
|
|
end;
|
|
end;
|
|
|
|
function TJclComplex.CLnGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreLnGamma(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewLnGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreLnGamma(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
function TJclComplex.CoreGamma(const Value: TRectCoord): TRectCoord;
|
|
var
|
|
LNZ: TRectCoord;
|
|
begin
|
|
LNZ := CoreLnGamma(Value);
|
|
if LNZ.X > 75.0 then
|
|
Result := RectInfinity
|
|
else
|
|
if LNZ.X < -200.0 then
|
|
Result := RectZero
|
|
else
|
|
Result := CoreExp(LNZ);
|
|
end;
|
|
|
|
function TJclComplex.CGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreGamma(RectCoord(Self));
|
|
FCoord.X := ResValue.X;
|
|
FCoord.Y := ResValue.Y;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclComplex.CNewGamma: TJclComplex;
|
|
var
|
|
ResValue: TRectCoord;
|
|
begin
|
|
ResValue := CoreGamma(RectCoord(Self));
|
|
Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
|
|
Result.FFracLen := FFracLen;
|
|
end;
|
|
|
|
//=== miscellaneous ==========================================================
|
|
|
|
function TJclComplex.AbsoluteValue: Float;
|
|
begin
|
|
Result := Sqrt(Sqr(FCoord.X) + Sqr(FCoord.Y));
|
|
end;
|
|
|
|
function TJclComplex.AbsoluteValue(const Coord: TRectCoord): Float;
|
|
begin
|
|
Result := Sqrt(Sqr(Coord.X) + Sqr(Coord.Y));
|
|
end;
|
|
|
|
function TJclComplex.AbsoluteValueSqr: Float;
|
|
begin
|
|
Result := Sqr(FCoord.X) + Sqr(FCoord.Y);
|
|
end;
|
|
|
|
function TJclComplex.AbsoluteValueSqr(const Coord: TRectCoord): Float;
|
|
begin
|
|
Result := Sqr(Coord.X) + Sqr(Coord.Y);
|
|
end;
|
|
|
|
function TJclComplex.FormatExtended(const X: Float): string;
|
|
begin
|
|
Result := FloatToStrF(X, ffFixed, FFracLen, FFracLen);
|
|
end;
|
|
|
|
procedure TJclComplex.SetFracLen(const X: Byte);
|
|
begin
|
|
if X > MaxFracLen then
|
|
FFracLen := MaxFracLen
|
|
else
|
|
FFracLen := X;
|
|
end;
|
|
|
|
function TJclComplex.GetRadius: Float;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
Result := FCoord.R;
|
|
end;
|
|
|
|
function TJclComplex.GetAngle: Float;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
Result := FCoord.Theta;
|
|
end;
|
|
|
|
function TJclComplex.NormalizeAngle(Value: Float): Float;
|
|
begin
|
|
FillCoords(crRectangular);
|
|
while Value > Pi do
|
|
Value := Value - TwoPi;
|
|
while Value < -Pi do
|
|
Value := Value + TwoPi;
|
|
Value := MiscalcSingle(Value);
|
|
Result := Value;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|