GR32.Math.Complex.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961
  1. unit GR32.Math.Complex;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is Complex Math for Delphi
  23. *
  24. * The Initial Developers of the Original Code are
  25. * Hallvard Vassbotn, Anders Melander
  26. *
  27. * Portions created by the Initial Developer are Copyright (C) 2006
  28. * the Initial Developer. All Rights Reserved.
  29. *
  30. * ***** END LICENSE BLOCK ***** *)
  31. interface
  32. {$include GR32.inc}
  33. uses
  34. Types,
  35. Variants,
  36. SysUtils,
  37. Math;
  38. //------------------------------------------------------------------------------
  39. //
  40. // TComplex
  41. //
  42. //------------------------------------------------------------------------------
  43. // Originally adapted from code by Hallvard Vassbotn.
  44. //------------------------------------------------------------------------------
  45. type
  46. TComplex = record
  47. strict private
  48. class constructor Create;
  49. procedure Defuzz;
  50. class procedure AssertImaginaryIsZero(const AValue: TComplex); static;
  51. public
  52. var
  53. Real: Double;
  54. Imaginary: Double;
  55. class var
  56. Symbol: string; // defaults to 'i'
  57. SymbolBeforeImaginary: Boolean; // defaults to false
  58. DefuzzAtZero: Boolean; // defaults to true
  59. class function From(const AReal: Double): TComplex; overload; static;
  60. class function From(const AReal, AImaginary: Double): TComplex; overload; static;
  61. class function FromPolar(const AModulus, APhase: Double): TComplex; static;
  62. function Modulus: Double;
  63. function Phase: Double;
  64. function IsInfinite: Boolean;
  65. function IsComplexInfinite: Boolean;
  66. function IsNaN: Boolean;
  67. function IsZero: Boolean;
  68. class function Abs(const AValue: TComplex): Double; static; // Magnitude
  69. class function AbsSqr(const AValue: TComplex): Double; static;
  70. class function Angle(const AValue: TComplex): Double; static;
  71. class function Sign(const AValue: TComplex): TComplex; static;
  72. class function Conjugate(const AValue: TComplex): TComplex; static;
  73. class function Inverse(const AValue: TComplex): TComplex; static;
  74. class function Exp(const AValue: TComplex): TComplex; static;
  75. class function Ln(const AValue: TComplex): TComplex; static;
  76. class function Log10(const AValue: TComplex): TComplex; static;
  77. class function Log2(const AValue: TComplex): TComplex; static;
  78. class function LogN(const AValue: TComplex; const X: Double): TComplex; static;
  79. class function Sqr(const AValue: TComplex): TComplex; static;
  80. class function Sqrt(const AValue: TComplex): TComplex; static;
  81. class function Power(const AValue, APower: TComplex): TComplex; static;
  82. class function Cos(const AValue: TComplex): TComplex; static;
  83. class function Sin(const AValue: TComplex): TComplex; static;
  84. class function Tan(const AValue: TComplex): TComplex; static;
  85. class function Cot(const AValue: TComplex): TComplex; static; // Cotan
  86. class function Csc(const AValue: TComplex): TComplex; static; // Cosecant
  87. class function Sec(const AValue: TComplex): TComplex; static; // Secant
  88. class function ArcCos(const AValue: TComplex): TComplex; static;
  89. class function ArcSin(const AValue: TComplex): TComplex; static;
  90. class function ArcTan(const AValue: TComplex): TComplex; static;
  91. class function ArcCot(const AValue: TComplex): TComplex; static;
  92. class function ArcCsc(const AValue: TComplex): TComplex; static;
  93. class function ArcSec(const AValue: TComplex): TComplex; static;
  94. class function CosH(const AValue: TComplex): TComplex; static;
  95. class function SinH(const AValue: TComplex): TComplex; static;
  96. class function TanH(const AValue: TComplex): TComplex; static;
  97. class function CotH(const AValue: TComplex): TComplex; static;
  98. class function CscH(const AValue: TComplex): TComplex; static;
  99. class function SecH(const AValue: TComplex): TComplex; static;
  100. class function ArcCosH(const AValue: TComplex): TComplex; static;
  101. class function ArcSinH(const AValue: TComplex): TComplex; static;
  102. class function ArcTanH(const AValue: TComplex): TComplex; static;
  103. class function ArcCotH(const AValue: TComplex): TComplex; static;
  104. class function ArcCscH(const AValue: TComplex): TComplex; static;
  105. class function ArcSecH(const AValue: TComplex): TComplex; static;
  106. class function Parse(const AText: string): TComplex; overload; static;
  107. class function Parse(const AText: string; const AFormatSettings: TFormatSettings): TComplex; overload; static;
  108. function ToString: string; overload;
  109. function ToString(const AFormatSettings: TFormatSettings): string; overload;
  110. class function Frac(const AValue: TComplex): Double; static;
  111. class function Int(const AValue: TComplex): Double; static;
  112. class function Compare(const Left, Right: TComplex): Integer; static;
  113. class function Equals(const Left, Right: TComplex): Boolean; static;
  114. {$IFNDEF FPC}
  115. class operator Round(const AValue: TComplex): Int64; static;
  116. class operator Trunc(const AValue: TComplex): Int64; static;
  117. {$ENDIF}
  118. class operator Equal(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  119. class operator NotEqual(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  120. class operator LessThan(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  121. class operator LessThanOrEqual(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  122. class operator GreaterThan(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  123. class operator GreaterThanOrEqual(const Left, Right: TComplex): Boolean; {$IFNDEF FPC}static;{$ENDIF}
  124. class operator Add(const Left, Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  125. class operator Add(const Left: Double; const Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  126. class operator Add(const Left: TComplex; const Right: Double): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  127. class operator Subtract(const Left, Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  128. class operator Subtract(const Left: Double; const Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  129. class operator Subtract(const Left: TComplex; const Right: Double): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  130. class operator Multiply(const Left, Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  131. class operator Multiply(const Left: Double; const Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  132. class operator Multiply(const Left: TComplex; const Right: Double): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  133. class operator Divide(const Left, Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  134. class operator Divide(const Left: Double; const Right: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  135. class operator Divide(const Left: TComplex; const Right: Double): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  136. class operator Negative(const AValue: TComplex): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  137. class operator Implicit(const AValue: Double): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  138. class operator Implicit(const AValue: Integer): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  139. class operator Implicit(const AValue: Int64): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  140. class operator Implicit(const AValue: Variant): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  141. class operator Implicit(const AValue: string): TComplex; {$IFNDEF FPC}static;{$ENDIF}
  142. class operator Explicit(const AValue: TComplex): Double; {$IFNDEF FPC}static;{$ENDIF}
  143. class operator Explicit(const AValue: TComplex): Integer; {$IFNDEF FPC}static;{$ENDIF}
  144. class operator Explicit(const AValue: TComplex): Int64; {$IFNDEF FPC}static;{$ENDIF}
  145. class operator Explicit(const AValue: TComplex): string; {$IFNDEF FPC}static;{$ENDIF}
  146. end;
  147. const
  148. ComplexOne: TComplex = (Real: 1; Imaginary: 0);
  149. ComplexMinusOne: TComplex = (Real: -1; Imaginary: 0);
  150. ComplexImaginaryOne: TComplex = (Real: 0; Imaginary: 1);
  151. ComplexImaginaryMinusOne: TComplex = (Real: 0; Imaginary: -1);
  152. ComplexHalfPi: TComplex = (Real: PI/2; Imaginary: 0);
  153. ComplexZero: TComplex = (Real: 0; Imaginary: 0);
  154. ComplexInfinity: TComplex = (Real: NaN; Imaginary: NaN);
  155. ComplexPositiveInfinity: TComplex = (Real: Math.Infinity; Imaginary: 0);
  156. ComplexNegativeInfinity: TComplex = (Real: Math.NegInfinity; Imaginary: 0);
  157. //------------------------------------------------------------------------------
  158. //------------------------------------------------------------------------------
  159. //------------------------------------------------------------------------------
  160. implementation
  161. uses
  162. SysConst;
  163. //------------------------------------------------------------------------------
  164. procedure ZeroDivideError;
  165. begin
  166. raise EZeroDivide.Create(SysConst.SDivByZero);
  167. end;
  168. //------------------------------------------------------------------------------
  169. class constructor TComplex.Create;
  170. begin
  171. Symbol := 'i';
  172. SymbolBeforeImaginary := False;
  173. DefuzzAtZero := True;
  174. end;
  175. procedure TComplex.Defuzz;
  176. begin
  177. if Math.IsZero(Real) then
  178. Real := 0;
  179. if Math.IsZero(Imaginary) then
  180. Imaginary := 0;
  181. end;
  182. class procedure TComplex.AssertImaginaryIsZero(const AValue: TComplex);
  183. begin
  184. if not Math.IsZero(AValue.Imaginary) then
  185. raise EConvertError.CreateFmt('Can not simplify, imaginary part is non-zero [%s]', [AValue.ToString]);
  186. end;
  187. //------------------------------------------------------------------------------
  188. class function TComplex.From(const AReal: Double): TComplex;
  189. begin
  190. Result.Real := AReal;
  191. Result.Imaginary := 0;
  192. if DefuzzAtZero then
  193. Result.Defuzz;
  194. end;
  195. class function TComplex.From(const AReal, AImaginary: Double): TComplex;
  196. begin
  197. Result.Real := AReal;
  198. Result.Imaginary := AImaginary;
  199. if DefuzzAtZero then
  200. Result.Defuzz;
  201. end;
  202. class function TComplex.FromPolar(const AModulus, APhase: Double): TComplex;
  203. begin
  204. Result := TComplex.From(
  205. AModulus * System.Cos(APhase),
  206. AModulus * System.Sin(APhase));
  207. end;
  208. //------------------------------------------------------------------------------
  209. function TComplex.Modulus: Double;
  210. begin
  211. Result := System.Sqr(Real) + System.Sqr(Imaginary);
  212. end;
  213. function TComplex.Phase: Double;
  214. begin
  215. Result := ArcTan2(Imaginary, Real);
  216. end;
  217. //------------------------------------------------------------------------------
  218. function TComplex.IsZero: Boolean;
  219. begin
  220. Result := Math.IsZero(Real) and Math.IsZero(Imaginary);
  221. end;
  222. function TComplex.IsInfinite: Boolean;
  223. begin
  224. Result := Math.IsInfinite(Real) or Math.IsInfinite(Imaginary);
  225. end;
  226. function TComplex.IsComplexInfinite: Boolean;
  227. begin
  228. Result := Math.IsNaN(Real) and Math.IsNaN(Imaginary);
  229. end;
  230. function TComplex.IsNaN: Boolean;
  231. begin
  232. Result := Math.IsNaN(Real) xor Math.IsNaN(Imaginary);
  233. end;
  234. //------------------------------------------------------------------------------
  235. class function TComplex.Abs(const AValue: TComplex): Double;
  236. begin
  237. Result := System.Sqrt(AbsSqr(AValue));
  238. end;
  239. class function TComplex.AbsSqr(const AValue: TComplex): Double;
  240. begin
  241. Result := AValue.Modulus;
  242. end;
  243. class function TComplex.Angle(const AValue: TComplex): Double;
  244. begin
  245. Result := AValue.Phase;
  246. end;
  247. class function TComplex.Sign(const AValue: TComplex): TComplex;
  248. begin
  249. if AValue.IsZero then
  250. Result := ComplexZero
  251. else
  252. Result := AValue / Sqrt(From(AbsSqr(AValue), 0));
  253. end;
  254. class function TComplex.Conjugate(const AValue: TComplex): TComplex;
  255. begin
  256. Result.Real := AValue.Real;
  257. Result.Imaginary := -AValue.Imaginary;
  258. end;
  259. class function TComplex.Inverse(const AValue: TComplex): TComplex;
  260. var
  261. LDenominator: Double;
  262. begin
  263. LDenominator := AbsSqr(AValue);
  264. if Math.IsZero(LDenominator) then
  265. ZeroDivideError;
  266. Result := From(AValue.Real / LDenominator, -(AValue.Imaginary / LDenominator));
  267. end;
  268. class function TComplex.Exp(const AValue: TComplex): TComplex;
  269. var
  270. LExp: Double;
  271. begin
  272. LExp := System.Exp(AValue.Real);
  273. Result := From(LExp * System.Cos(AValue.Imaginary),
  274. LExp * System.Sin(AValue.Imaginary));
  275. end;
  276. class operator TComplex.Explicit(const AValue: TComplex): string;
  277. begin
  278. Result := AValue.ToString;
  279. end;
  280. class function TComplex.Ln(const AValue: TComplex): TComplex;
  281. begin
  282. if AValue.IsZero then
  283. Result := ComplexNegativeInfinity
  284. else
  285. Result := From(System.Ln(AValue.Modulus), AValue.Phase);
  286. end;
  287. class function TComplex.Log10(const AValue: TComplex): TComplex;
  288. begin
  289. if AValue.IsZero then
  290. Result := ComplexNegativeInfinity
  291. else
  292. Result := From(System.Ln(AValue.Modulus), AValue.Phase) /
  293. From(System.Ln(10), 0);
  294. end;
  295. class function TComplex.Log2(const AValue: TComplex): TComplex;
  296. begin
  297. if AValue.IsZero then
  298. Result := ComplexNegativeInfinity
  299. else
  300. Result := From(System.Ln(AValue.Modulus), AValue.Phase) /
  301. From(System.Ln(2), 0);
  302. end;
  303. class function TComplex.LogN(const AValue: TComplex; const X: Double): TComplex;
  304. begin
  305. if AValue.IsZero and (X > 0) and (X <> 1) then
  306. Result := ComplexNegativeInfinity
  307. else
  308. Result := From(System.Ln(AValue.Modulus), AValue.Phase) /
  309. Ln(From(X, 0));
  310. end;
  311. class function TComplex.Sqr(const AValue: TComplex): TComplex;
  312. begin
  313. Result := From(System.Sqr(AValue.Real) - System.Sqr(AValue.Imaginary),
  314. 2.0 * (AValue.Real * AValue.Imaginary));
  315. end;
  316. class function TComplex.Sqrt(const AValue: TComplex): TComplex;
  317. var
  318. LValue: Double;
  319. begin
  320. if AValue.IsZero then
  321. Result := ComplexZero
  322. else
  323. if (AValue.Real > 0) then
  324. begin
  325. LValue := Abs(AValue) + AValue.Real;
  326. Result := From(System.Sqrt(LValue * 0.5),
  327. AValue.Imaginary / System.Sqrt(LValue * 2));
  328. end else
  329. begin
  330. LValue := Abs(AValue) - AValue.Real;
  331. if (AValue.Imaginary < 0) then
  332. Result := From(System.Abs(AValue.Imaginary) / System.Sqrt(LValue * 2),
  333. -System.Sqrt(LValue * 0.5))
  334. else
  335. Result := From(System.Abs(AValue.Imaginary) / System.Sqrt(LValue * 2),
  336. System.Sqrt(LValue * 0.5));
  337. end;
  338. end;
  339. class function TComplex.Power(const AValue, APower: TComplex): TComplex;
  340. begin
  341. if Math.IsZero(AbsSqr(AValue)) then
  342. if Math.IsZero(AbsSqr(APower)) then
  343. Result := ComplexOne
  344. else
  345. Result := ComplexZero
  346. else
  347. Result := Exp(Ln(AValue) * APower);
  348. end;
  349. //------------------------------------------------------------------------------
  350. class function TComplex.Cos(const AValue: TComplex): TComplex;
  351. begin
  352. Result := From(System.Cos(AValue.Real) * Math.CosH(AValue.Imaginary),
  353. -System.Sin(AValue.Real) * Math.SinH(AValue.Imaginary));
  354. end;
  355. class function TComplex.Sin(const AValue: TComplex): TComplex;
  356. begin
  357. Result := From(System.Sin(AValue.Real) * Math.CosH(AValue.Imaginary),
  358. System.Cos(AValue.Real) * Math.SinH(AValue.Imaginary));
  359. end;
  360. class function TComplex.Tan(const AValue: TComplex): TComplex;
  361. var
  362. LDenominator: Double;
  363. begin
  364. if (AValue = ComplexHalfPi) then
  365. Result := ComplexInfinity
  366. else
  367. begin
  368. LDenominator := System.Cos(2.0 * AValue.Real) + Math.CosH(2.0 * AValue.Imaginary);
  369. if Math.IsZero(LDenominator) then
  370. ZeroDivideError;
  371. Result := From(System.Sin(2.0 * AValue.Real) / LDenominator,
  372. Math.SinH(2.0 * AValue.Imaginary) / LDenominator);
  373. end;
  374. end;
  375. class function TComplex.Cot(const AValue: TComplex): TComplex;
  376. begin
  377. if AValue.IsZero then
  378. Result := ComplexInfinity
  379. else
  380. Result := Cos(AValue) / Sin(AValue);
  381. end;
  382. class function TComplex.Csc(const AValue: TComplex): TComplex;
  383. begin
  384. if AValue.IsZero then
  385. Result := ComplexInfinity
  386. else
  387. Result := ComplexOne / Sin(AValue);
  388. end;
  389. class function TComplex.Sec(const AValue: TComplex): TComplex;
  390. begin
  391. if AValue.IsZero then
  392. Result := ComplexInfinity
  393. else
  394. Result := ComplexOne / Cos(AValue);
  395. end;
  396. class function TComplex.ArcCos(const AValue: TComplex): TComplex;
  397. begin
  398. Result := ComplexHalfPi + (ComplexImaginaryOne * Ln((ComplexImaginaryOne * AValue) + Sqrt(ComplexOne - Sqr(AValue))));
  399. end;
  400. class function TComplex.ArcSin(const AValue: TComplex): TComplex;
  401. begin
  402. Result := ComplexImaginaryMinusOne * Ln((ComplexImaginaryOne * AValue) + Sqrt(ComplexOne - Sqr(AValue)));
  403. end;
  404. class function TComplex.ArcTan(const AValue: TComplex): TComplex;
  405. begin
  406. Result := ComplexHalfPi * (Ln(ComplexOne - (ComplexImaginaryOne * AValue)) - Ln((ComplexImaginaryOne * AValue) - ComplexOne));
  407. end;
  408. class function TComplex.ArcCot(const AValue: TComplex): TComplex;
  409. begin
  410. Result := ArcTan(Inverse(AValue));
  411. end;
  412. class function TComplex.ArcCsc(const AValue: TComplex): TComplex;
  413. begin
  414. if AValue.IsZero then
  415. Result := ComplexInfinity
  416. else
  417. Result := ArcSin(Inverse(AValue));
  418. end;
  419. class function TComplex.ArcSec(const AValue: TComplex): TComplex;
  420. begin
  421. if AValue.IsZero then
  422. Result := ComplexInfinity
  423. else
  424. Result := ArcCos(Inverse(AValue));
  425. end;
  426. class function TComplex.CosH(const AValue: TComplex): TComplex;
  427. begin
  428. Result := From(Math.CosH(AValue.Real) * System.Cos(AValue.Imaginary),
  429. Math.SinH(AValue.Real) * System.Sin(AValue.Imaginary));
  430. end;
  431. class function TComplex.SinH(const AValue: TComplex): TComplex;
  432. begin
  433. Result := From(Math.CosH(AValue.Real) * System.Cos(AValue.Imaginary),
  434. Math.SinH(AValue.Real) * System.Sin(AValue.Imaginary));
  435. end;
  436. class function TComplex.TanH(const AValue: TComplex): TComplex;
  437. begin
  438. if AValue.IsZero then
  439. Result := ComplexZero
  440. else
  441. Result := SinH(AValue) / CosH(AValue);
  442. end;
  443. class function TComplex.CotH(const AValue: TComplex): TComplex;
  444. begin
  445. if AValue.IsZero then
  446. Result := ComplexInfinity
  447. else
  448. Result := Inverse(TanH(AValue));
  449. end;
  450. class function TComplex.CscH(const AValue: TComplex): TComplex;
  451. begin
  452. if AValue.IsZero then
  453. Result := ComplexInfinity
  454. else
  455. Result := Inverse(SinH(AValue));
  456. end;
  457. class function TComplex.SecH(const AValue: TComplex): TComplex;
  458. begin
  459. Result := Inverse(CosH(AValue));
  460. end;
  461. class function TComplex.ArcCosH(const AValue: TComplex): TComplex;
  462. begin
  463. Result := Ln(AValue + Sqrt(AValue - ComplexOne) * Sqrt(AValue + ComplexOne));
  464. end;
  465. class function TComplex.ArcSinH(const AValue: TComplex): TComplex;
  466. begin
  467. Result := ArcSin(AValue * ComplexImaginaryOne) * ComplexImaginaryMinusOne;
  468. end;
  469. class function TComplex.ArcTanH(const AValue: TComplex): TComplex;
  470. begin
  471. if AValue = ComplexOne then
  472. Result := ComplexPositiveInfinity
  473. else
  474. if AValue = ComplexMinusOne then
  475. Result := ComplexNegativeInfinity
  476. else
  477. Result := ArcTan(AValue * ComplexImaginaryOne) * ComplexImaginaryMinusOne;
  478. end;
  479. class function TComplex.ArcCotH(const AValue: TComplex): TComplex;
  480. begin
  481. if AValue = ComplexOne then
  482. Result := ComplexPositiveInfinity
  483. else
  484. if AValue = ComplexMinusOne then
  485. Result := ComplexNegativeInfinity
  486. else
  487. Result := ArcTanH(Inverse(AValue));
  488. end;
  489. class function TComplex.ArcCscH(const AValue: TComplex): TComplex;
  490. begin
  491. if AValue.IsZero then
  492. Result := ComplexInfinity
  493. else
  494. Result := ArcSinH(Inverse(AValue));
  495. end;
  496. class function TComplex.ArcSecH(const AValue: TComplex): TComplex;
  497. begin
  498. if AValue.IsZero then
  499. Result := ComplexInfinity
  500. else
  501. Result := ArcCosH(Inverse(AValue));
  502. end;
  503. //------------------------------------------------------------------------------
  504. class function TComplex.Parse(const AText: string): TComplex;
  505. begin
  506. Result := TComplex.Parse(AText, FormatSettings);
  507. end;
  508. class function TComplex.Parse(const AText: string; const AFormatSettings: TFormatSettings): TComplex;
  509. function ParseNumber(const AText: string; out ARest: string; out ANumber: Double): Boolean;
  510. var
  511. LAt: Integer;
  512. LFirstPart: string;
  513. begin
  514. Result := True;
  515. ARest := '';
  516. Val(AText, ANumber, LAt); // TODO : Use something else
  517. if LAt <> 0 then
  518. begin
  519. ARest := Copy(AText, LAt, MaxInt);
  520. LFirstPart := Copy(AText, 1, LAt - 1);
  521. Val(LFirstPart, ANumber, LAt); // TODO : Ditto
  522. if LAt <> 0 then
  523. Result := False;
  524. end;
  525. end;
  526. function ParseWhiteSpace(const AText: string; out ARest: string): Boolean;
  527. var
  528. LAt: Integer;
  529. begin
  530. LAt := 1;
  531. ARest := '';
  532. if AText <> '' then
  533. begin
  534. while AText[LAt] = ' ' do
  535. Inc(LAt);
  536. ARest := Copy(AText, LAt, MaxInt);
  537. end;
  538. Result := ARest <> '';
  539. end;
  540. procedure ParseError(const AText, ALeftOver, AMessage: string);
  541. begin
  542. raise EConvertError.CreateFmt('%s [%s<?>%s]', [AMessage,
  543. Copy(AText, 1, Length(AText) - Length(ALeftOver)),
  544. Copy(AText, Length(AText) - Length(ALeftOver) + 1, MaxInt)]);
  545. end;
  546. var
  547. LPart, LLeftover: string;
  548. LReal, LImaginary: Double;
  549. LSign: Integer;
  550. begin
  551. // where to start?
  552. LLeftover := AText;
  553. // first get the real portion
  554. if not ParseNumber(LLeftover, LPart, LReal) then
  555. ParseError(AText, LLeftover, 'Can not parse real portion');
  556. // is that it?
  557. if not ParseWhiteSpace(LPart, LLeftover) then
  558. Result := TComplex.From(LReal)
  559. // if there is more then parse the TComplex part
  560. else
  561. begin
  562. // look for the concat symbol
  563. LSign := 1;
  564. if LLeftover[1] = '-' then
  565. LSign := -1
  566. else
  567. if LLeftover[1] <> '+' then
  568. ParseError(AText, LLeftover, 'Required sign symbol missing (''+'' or ''-'')');
  569. LPart := Copy(LLeftover, 2, MaxInt);
  570. // skip any whitespace
  571. ParseWhiteSpace(LPart, LLeftover);
  572. // symbol before?
  573. if SymbolBeforeImaginary then
  574. begin
  575. if not SameText(Copy(LLeftOver, 1, Length(Symbol)), Symbol) then
  576. ParseError(AText, LLeftover, Format('Required ''%s'' symbol missing', [Symbol]));
  577. LPart := Copy(LLeftover, Length(Symbol) + 1, MaxInt);
  578. // skip any whitespace
  579. ParseWhiteSpace(LPart, LLeftover);
  580. end;
  581. // imaginary part
  582. if not ParseNumber(LLeftover, LPart, LImaginary) then
  583. ParseError(AText, LLeftover, 'Can not parse imaginary portion');
  584. // correct for sign
  585. LImaginary := LImaginary * LSign;
  586. // symbol after?
  587. if not SymbolBeforeImaginary then
  588. begin
  589. // skip any whitespace
  590. ParseWhiteSpace(LPart, LLeftover);
  591. // make sure there is symbol!
  592. if not SameText(Copy(LLeftOver, 1, Length(Symbol)), Symbol) then
  593. ParseError(AText, LLeftover, Format('Required ''%s'' symbol missing', [Symbol]));
  594. LPart := Copy(LLeftover, Length(Symbol) + 1, MaxInt);
  595. end;
  596. // make sure the rest of the string is whitespaces
  597. ParseWhiteSpace(LPart, LLeftover);
  598. if LLeftover <> '' then
  599. ParseError(AText, LLeftover, 'Unexpected characters');
  600. // make it then
  601. Result := TComplex.From(LReal, LImaginary);
  602. end;
  603. end;
  604. //------------------------------------------------------------------------------
  605. function TComplex.ToString: string;
  606. begin
  607. Result := ToString(FormatSettings);
  608. end;
  609. function TComplex.ToString(const AFormatSettings: TFormatSettings): string;
  610. const
  611. cFormats: array[Boolean] of string = ('%2:s %1:s %3:s%0:s',
  612. '%2:s %1:s %0:s%3:s');
  613. cSign: array[Boolean] of string = ('-', '+');
  614. var
  615. RealStr, IStr: string;
  616. begin
  617. RealStr := FloatToStr(Real, AFormatSettings);
  618. IStr := FloatToStr(System.Abs(Imaginary), AFormatSettings);
  619. Result := Format(cFormats[SymbolBeforeImaginary], [Symbol, cSign[Imaginary >= 0], RealStr, IStr]);
  620. end;
  621. //------------------------------------------------------------------------------
  622. class function TComplex.Frac(const AValue: TComplex): Double;
  623. begin
  624. Result := System.Frac(Double(AValue));
  625. end;
  626. class function TComplex.Int(const AValue: TComplex): Double;
  627. begin
  628. Result := System.Int(Double(AValue));
  629. end;
  630. //------------------------------------------------------------------------------
  631. class function TComplex.Compare(const Left, Right: TComplex): Integer;
  632. begin
  633. if (Left = Right) then
  634. Result := 0
  635. else
  636. Result := -1;
  637. end;
  638. class function TComplex.Equals(const Left, Right: TComplex): Boolean;
  639. begin
  640. Result := (Left = Right);
  641. end;
  642. //------------------------------------------------------------------------------
  643. {$IFNDEF FPC}
  644. class operator TComplex.Round(const AValue: TComplex): Int64;
  645. begin
  646. Result := System.Round(Double(AValue));
  647. end;
  648. class operator TComplex.Trunc(const AValue: TComplex): Int64;
  649. begin
  650. Result := System.Trunc(Double(AValue));
  651. end;
  652. {$ENDIF}
  653. //------------------------------------------------------------------------------
  654. class operator TComplex.Equal(const Left, Right: TComplex): Boolean;
  655. begin
  656. Result := SameValue(Left.Real, Right.Real) and
  657. SameValue(Left.Imaginary, Right.Imaginary);
  658. end;
  659. class operator TComplex.NotEqual(const Left, Right: TComplex): Boolean;
  660. begin
  661. Result := not (Left = Right);
  662. end;
  663. class operator TComplex.LessThan(const Left, Right: TComplex): Boolean;
  664. begin
  665. Result := False;
  666. end;
  667. class operator TComplex.LessThanOrEqual(const Left, Right: TComplex): Boolean;
  668. begin
  669. Result := (Left = Right);
  670. end;
  671. class operator TComplex.GreaterThan(const Left, Right: TComplex): Boolean;
  672. begin
  673. Result := False;
  674. end;
  675. class operator TComplex.GreaterThanOrEqual(const Left, Right: TComplex): Boolean;
  676. begin
  677. Result := (Left = Right);
  678. end;
  679. //------------------------------------------------------------------------------
  680. class operator TComplex.Add(const Left, Right: TComplex): TComplex;
  681. begin
  682. Result.Real := Left.Real + Right.Real;
  683. Result.Imaginary := Left.Imaginary + Right.Imaginary;
  684. end;
  685. class operator TComplex.Add(const Left: TComplex; const Right: Double): TComplex;
  686. begin
  687. Result.Real := Left.Real + Right;
  688. Result.Imaginary := Left.Imaginary;
  689. end;
  690. class operator TComplex.Add(const Left: Double; const Right: TComplex): TComplex;
  691. begin
  692. Result.Real := Left + Right.Real;
  693. Result.Imaginary := Right.Imaginary;
  694. end;
  695. class operator TComplex.Subtract(const Left, Right: TComplex): TComplex;
  696. begin
  697. Result.Real := Left.Real - Right.Real;
  698. Result.Imaginary := Left.Imaginary - Right.Imaginary;
  699. end;
  700. class operator TComplex.Subtract(const Left: TComplex; const Right: Double): TComplex;
  701. begin
  702. Result.Real := Left.Real - Right;
  703. Result.Imaginary := Left.Imaginary;
  704. end;
  705. class operator TComplex.Subtract(const Left: Double; const Right: TComplex): TComplex;
  706. begin
  707. Result.Real := Left - Right.Real;
  708. Result.Imaginary := -Right.Imaginary;
  709. end;
  710. class operator TComplex.Multiply(const Left, Right: TComplex): TComplex;
  711. begin
  712. Result.Real := (Left.Real * Right.Real) - (Left.Imaginary * Right.Imaginary);
  713. Result.Imaginary := (Left.Real * Right.Imaginary) + (Left.Imaginary * Right.Real);
  714. end;
  715. class operator TComplex.Multiply(const Left: TComplex; const Right: Double): TComplex;
  716. begin
  717. Result.Real := Left.Real * Right;
  718. Result.Imaginary := Left.Imaginary * Right;
  719. end;
  720. class operator TComplex.Multiply(const Left: Double; const Right: TComplex): TComplex;
  721. begin
  722. Result.Real := Left * Right.Real;
  723. Result.Imaginary := Left * Right.Imaginary;
  724. end;
  725. class operator TComplex.Divide(const Left, Right: TComplex): TComplex;
  726. var
  727. LDenominator: Double;
  728. begin
  729. LDenominator := (Right.Real * Right.Real) + (Right.Imaginary * Right.Imaginary);
  730. if Math.IsZero(LDenominator) then
  731. ZeroDivideError;
  732. Result.Real := ((Left.Real * Right.Real) + (Left.Imaginary * Right.Imaginary)) / LDenominator;
  733. Result.Imaginary := ((Left.Imaginary * Right.Real) - (Left.Real * Right.Imaginary)) / LDenominator;
  734. end;
  735. class operator TComplex.Divide(const Left: TComplex; const Right: Double): TComplex;
  736. begin
  737. Result := Left * (1.0 / Right);
  738. end;
  739. class operator TComplex.Divide(const Left: Double; const Right: TComplex): TComplex;
  740. var
  741. R, LDenominator: Double;
  742. begin
  743. if (System.Abs(Right.Real) >= System.Abs(Right.Imaginary)) then
  744. begin
  745. if Math.IsZero(Right.Real) then
  746. ZeroDivideError;
  747. R := Right.Imaginary / Right.Real;
  748. LDenominator := Right.Real + R * Right.Imaginary;
  749. if Math.IsZero(LDenominator) then
  750. ZeroDivideError;
  751. Result.Real := Left / LDenominator;
  752. Result.Imaginary := -R * Result.Real;
  753. end else
  754. begin
  755. if Math.IsZero(Right.Imaginary) then
  756. ZeroDivideError;
  757. R := Right.Real / Right.Imaginary;
  758. LDenominator := Right.Imaginary + R * Right.Real;
  759. if Math.IsZero(LDenominator) then
  760. ZeroDivideError;
  761. Result.Imaginary := -Left / LDenominator;
  762. Result.Real := -R * Result.Imaginary;
  763. end;
  764. end;
  765. class operator TComplex.Negative(const AValue: TComplex): TComplex;
  766. begin
  767. Result.Real := -AValue.Real;
  768. Result.Imaginary := -AValue.Imaginary;
  769. end;
  770. //------------------------------------------------------------------------------
  771. class operator TComplex.Implicit(const AValue: Double): TComplex;
  772. begin
  773. Result.Real := AValue;
  774. end;
  775. class operator TComplex.Implicit(const AValue: Integer): TComplex;
  776. begin
  777. Result.Real := AValue;
  778. end;
  779. class operator TComplex.Implicit(const AValue: Int64): TComplex;
  780. begin
  781. Result.Real := AValue;
  782. end;
  783. class operator TComplex.Implicit(const AValue: Variant): TComplex;
  784. begin
  785. Result.Real := Double(AValue);
  786. end;
  787. class operator TComplex.Implicit(const AValue: string): TComplex;
  788. begin
  789. Result := TComplex.Parse(AValue);
  790. end;
  791. //------------------------------------------------------------------------------
  792. class operator TComplex.Explicit(const AValue: TComplex): Double;
  793. begin
  794. AssertImaginaryIsZero(AValue);
  795. Result := AValue.Real;
  796. end;
  797. class operator TComplex.Explicit(const AValue: TComplex): Integer;
  798. begin
  799. AssertImaginaryIsZero(AValue);
  800. Result := Round(AValue.Real);
  801. end;
  802. class operator TComplex.Explicit(const AValue: TComplex): Int64;
  803. begin
  804. AssertImaginaryIsZero(AValue);
  805. Result := Round(AValue.Real);
  806. end;
  807. //------------------------------------------------------------------------------
  808. end.