GComplex.pm 30 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589
  1. package Math::GComplex;
  2. use 5.010;
  3. use strict;
  4. use warnings;
  5. our $VERSION = '0.13';
  6. use overload
  7. '""' => \&stringify,
  8. '0+' => \&numify,
  9. bool => \&boolify,
  10. '+' => \&add,
  11. '*' => \&mul,
  12. '==' => \&eq,
  13. '!=' => \&ne,
  14. '~' => \&conj,
  15. '&' => \&and,
  16. '|' => \&or,
  17. '^' => \&xor,
  18. '>>' => \&rsft,
  19. '<<' => \&lsft,
  20. '>' => sub { $_[2] ? (goto &lt) : (goto &gt) },
  21. '>=' => sub { $_[2] ? (goto &le) : (goto &ge) },
  22. '<' => sub { $_[2] ? (goto &gt) : (goto &lt) },
  23. '<=' => sub { $_[2] ? (goto &ge) : (goto &le) },
  24. '<=>' => sub { $_[2] ? -(&cmp($_[0], $_[1]) // return undef) : &cmp($_[0], $_[1]) },
  25. '/' => sub { @_ = ($_[1], $_[0]) if $_[2]; goto &div },
  26. '-' => sub { @_ = ($_[1], $_[0]) if $_[2]; goto &sub },
  27. '**' => sub { @_ = $_[2] ? @_[1, 0] : @_[0, 1]; goto &pow },
  28. '%' => sub { @_ = $_[2] ? @_[1, 0] : @_[0, 1]; goto &mod },
  29. atan2 => sub { @_ = $_[2] ? @_[1, 0] : @_[0, 1]; goto &atan2 },
  30. eq => sub { "$_[0]" eq "$_[1]" },
  31. ne => sub { "$_[0]" ne "$_[1]" },
  32. cmp => sub { $_[2] ? ("$_[1]" cmp $_[0]->stringify) : ($_[0]->stringify cmp "$_[1]") },
  33. neg => \&neg,
  34. sin => \&sin,
  35. cos => \&cos,
  36. exp => \&exp,
  37. log => \&log,
  38. int => \&int,
  39. abs => \&abs,
  40. sqrt => \&sqrt;
  41. {
  42. my %const = ( # prototypes are assigned in import()
  43. i => \&i,
  44. );
  45. my %trig = (
  46. sin => sub (_) { goto &sin }, # built-in function
  47. sinh => \&sinh,
  48. asin => \&asin,
  49. asinh => \&asinh,
  50. cos => sub (_) { goto &cos }, # built-in function
  51. cosh => \&cosh,
  52. acos => \&acos,
  53. acosh => \&acosh,
  54. tan => \&tan,
  55. tanh => \&tanh,
  56. atan => \&atan,
  57. atanh => \&atanh,
  58. cot => \&cot,
  59. coth => \&coth,
  60. acot => \&acot,
  61. acoth => \&acoth,
  62. sec => \&sec,
  63. sech => \&sech,
  64. asec => \&asec,
  65. asech => \&asech,
  66. csc => \&csc,
  67. csch => \&csch,
  68. acsc => \&acsc,
  69. acsch => \&acsch,
  70. atan2 => sub ($$) { goto &atan2 }, # built-in function
  71. deg2rad => \&deg2rad,
  72. rad2deg => \&rad2deg,
  73. );
  74. my %special = (
  75. exp => sub (_) { goto &exp }, # built-in function
  76. log => sub (_) { goto &log }, # built-in function
  77. sqrt => sub (_) { goto &sqrt }, # built-in function
  78. cbrt => \&cbrt,
  79. logn => \&logn,
  80. root => \&root,
  81. pow => \&pow,
  82. pown => \&pown,
  83. gcd => \&gcd,
  84. invmod => \&invmod,
  85. powmod => \&powmod,
  86. );
  87. my %misc = (
  88. acmp => \&acmp,
  89. cplx => \&cplx,
  90. polar => \&polar,
  91. abs => sub (_) { goto &abs }, # built-in function
  92. inv => \&inv,
  93. sgn => \&sgn,
  94. conj => \&conj,
  95. norm => \&norm,
  96. real => \&real,
  97. imag => \&imag,
  98. floor => \&floor,
  99. ceil => \&ceil,
  100. round => \&round,
  101. reals => \&reals,
  102. );
  103. sub import {
  104. shift;
  105. my $caller = caller(0);
  106. while (@_) {
  107. my $name = shift(@_);
  108. if ($name eq ':overload') {
  109. overload::constant
  110. integer => sub { __PACKAGE__->new($_[0], 0) },
  111. float => sub { __PACKAGE__->new($_[0], 0) };
  112. # Export the 'i' constant
  113. foreach my $pair (['i', i()]) {
  114. my $sub = $caller . '::' . $pair->[0];
  115. no strict 'refs';
  116. no warnings 'redefine';
  117. my $value = $pair->[1];
  118. *$sub = sub () { $value };
  119. }
  120. }
  121. elsif (exists $const{$name}) {
  122. no strict 'refs';
  123. no warnings 'redefine';
  124. my $caller_sub = $caller . '::' . $name;
  125. my $sub = $const{$name};
  126. my $value = $sub->();
  127. *$caller_sub = sub() { $value }
  128. }
  129. elsif ( exists($trig{$name})
  130. or exists($special{$name})
  131. or exists($misc{$name})) {
  132. no strict 'refs';
  133. no warnings 'redefine';
  134. my $caller_sub = $caller . '::' . $name;
  135. *$caller_sub = $trig{$name} // $misc{$name} // $special{$name};
  136. }
  137. elsif ($name eq ':trig') {
  138. push @_, keys(%trig);
  139. }
  140. elsif ($name eq ':misc') {
  141. push @_, keys(%misc);
  142. }
  143. elsif ($name eq ':special') {
  144. push @_, keys(%special);
  145. }
  146. elsif ($name eq ':all') {
  147. push @_, keys(%const), keys(%trig), keys(%special), keys(%misc);
  148. }
  149. else {
  150. die "unknown import: <<$name>>";
  151. }
  152. }
  153. return;
  154. }
  155. sub unimport {
  156. overload::remove_constant(float => '',
  157. integer => '',);
  158. }
  159. }
  160. #
  161. ## Be somewhat compatible with Math::Complex
  162. #
  163. sub _cartesian {
  164. my ($self) = @_;
  165. $self->{cartesian} //= [$self->{a}, $self->{b}];
  166. }
  167. sub _polar {
  168. my ($self) = @_;
  169. $self->{polar} //= [CORE::sqrt($self->{a} * $self->{a} + $self->{b} * $self->{b}), CORE::atan2($self->{b}, $self->{a})];
  170. }
  171. #
  172. ## Return the polar form
  173. #
  174. sub polar {
  175. my ($self) = @_;
  176. @{$self->_polar};
  177. }
  178. #
  179. ## Create a new Math::GComplex object
  180. #
  181. sub new {
  182. my ($class, $x, $y) = @_;
  183. bless {
  184. a => $x // 0,
  185. b => $y // 0,
  186. }, $class;
  187. }
  188. *make = \&new;
  189. #
  190. ## cplx(a, b) = a + b*i
  191. #
  192. sub cplx {
  193. my ($x, $y) = @_;
  194. bless {
  195. a => $x // 0,
  196. b => $y // 0,
  197. },
  198. __PACKAGE__;
  199. }
  200. sub emake {
  201. my ($class, $r, $theta) = @_;
  202. bless {
  203. a => ($r // 0) * CORE::cos($theta // 0),
  204. b => ($r // 0) * CORE::sin($theta // 0),
  205. }, $class;
  206. }
  207. #
  208. ## cplxe(r, theta) = r*cos(theta) + r*sin(theta)*i
  209. #
  210. sub cplxe {
  211. my ($r, $theta) = @_;
  212. bless {
  213. a => ($r // 0) * CORE::cos($theta // 0),
  214. b => ($r // 0) * CORE::sin($theta // 0),
  215. },
  216. __PACKAGE__;
  217. }
  218. #
  219. ## i = sqrt(-1)
  220. #
  221. sub i {
  222. __PACKAGE__->new(0, 1);
  223. }
  224. #
  225. ## (a + b*i) + (x + y*i) = (a + x) + (b + y)*i
  226. #
  227. sub add {
  228. my ($x, $y) = @_;
  229. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  230. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  231. __PACKAGE__->new($x->{a} + $y->{a}, $x->{b} + $y->{b});
  232. }
  233. #
  234. ## (a + b*i) - (x + y*i) = (a - x) + (b - y)*i
  235. #
  236. sub sub {
  237. my ($x, $y) = @_;
  238. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  239. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  240. __PACKAGE__->new($x->{a} - $y->{a}, $x->{b} - $y->{b});
  241. }
  242. #
  243. ## (a + b*i) * (x + y*i) = i*(a*y + b*x) + a*x - b*y
  244. #
  245. sub mul {
  246. my ($x, $y) = @_;
  247. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  248. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  249. __PACKAGE__->new($x->{a} * $y->{a} - $x->{b} * $y->{b}, $x->{a} * $y->{b} + $x->{b} * $y->{a});
  250. }
  251. #
  252. ## (a + b*i) / (x + y*i) = (a*x + b*y)/(x*x + y*y) + (b*x - a*y)/(x*x + y*y) * i
  253. #
  254. sub div {
  255. my ($x, $y) = @_;
  256. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  257. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  258. my $d = $y->{a} * $y->{a} + $y->{b} * $y->{b};
  259. if ($d == 0) {
  260. return $x->log->sub($y->log)->exp;
  261. }
  262. __PACKAGE__->new(($x->{a} * $y->{a} + $x->{b} * $y->{b}) / $d, ($x->{b} * $y->{a} - $x->{a} * $y->{b}) / $d);
  263. }
  264. #
  265. ## mod(x, y) = x - y*floor(x/y)
  266. #
  267. sub mod {
  268. my ($x, $y) = @_;
  269. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  270. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  271. $x->sub($x->div($y)->floor->mul($y));
  272. }
  273. #
  274. ## inv(x) = 1/x
  275. #
  276. sub inv ($) {
  277. my ($x) = @_;
  278. state $one = __PACKAGE__->new(1, 0);
  279. $one->div($x);
  280. }
  281. #
  282. ## abs(a + b*i) = sqrt(a^2 + b^2)
  283. #
  284. sub abs {
  285. my ($x) = @_;
  286. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  287. CORE::sqrt($x->{a} * $x->{a} + $x->{b} * $x->{b});
  288. }
  289. #
  290. ## sgn(a + b*i) = (a + b*i) / abs(a + b*i)
  291. #
  292. sub sgn ($) {
  293. my ($x) = @_;
  294. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  295. if ($x->{a} == 0 and $x->{b} == 0) {
  296. return __PACKAGE__->new(0, 0);
  297. }
  298. $x->div($x->abs);
  299. }
  300. #
  301. ## neg(a + b*i) = -a - b*i
  302. #
  303. sub neg {
  304. my ($x) = @_;
  305. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  306. __PACKAGE__->new(-$x->{a}, -$x->{b});
  307. }
  308. #
  309. ## conj(a + b*i) = a - b*i
  310. #
  311. sub conj ($) {
  312. my ($x) = @_;
  313. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  314. __PACKAGE__->new($x->{a}, -$x->{b});
  315. }
  316. #
  317. ## norm(a + b*i) = a**2 + b**2
  318. #
  319. sub norm ($) {
  320. my ($x) = @_;
  321. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  322. $x->{a} * $x->{a} + $x->{b} * $x->{b};
  323. }
  324. #
  325. ## (a+b*i) AND (x+y*i) = (a AND x) + (b AND y)*i
  326. #
  327. sub and {
  328. my ($x, $y) = @_;
  329. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  330. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  331. __PACKAGE__->new($x->{a} & $y->{a}, $x->{b} & $y->{b});
  332. }
  333. #
  334. ## (a+b*i) OR (x+y*i) = (a OR x) + (b OR y)*i
  335. #
  336. sub or {
  337. my ($x, $y) = @_;
  338. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  339. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  340. __PACKAGE__->new($x->{a} | $y->{a}, $x->{b} | $y->{b});
  341. }
  342. #
  343. ## (a+b*i) XOR (x+y*i) = (a XOR x) + (b XOR y)*i
  344. #
  345. sub xor {
  346. my ($x, $y) = @_;
  347. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  348. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  349. __PACKAGE__->new($x->{a} ^ $y->{a}, $x->{b} ^ $y->{b});
  350. }
  351. #
  352. ## (a+b*i) << n = (a << n) + (b << n)*i
  353. ## (a+b*i) << (x+y*i) = int((a+b*i) * 2^(x+y*i))
  354. #
  355. sub lsft {
  356. my ($x, $y) = @_;
  357. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  358. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  359. if ($y->{b} == 0) {
  360. return __PACKAGE__->new($x->{a} << $y->{a}, $x->{b} << $y->{a});
  361. }
  362. state $two = __PACKAGE__->new(2, 0);
  363. $x->mul($two->pow($y))->int;
  364. }
  365. #
  366. ## (a+b*i) >> n = (a >> n) + (b >> n)*i
  367. ## (a+b*i) >> (x+y*i) = int((a+b*i) / 2^(x+y*i))
  368. #
  369. sub rsft {
  370. my ($x, $y) = @_;
  371. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  372. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  373. if ($y->{b} == 0) {
  374. return __PACKAGE__->new($x->{a} >> $y->{a}, $x->{b} >> $y->{a});
  375. }
  376. state $two = __PACKAGE__->new(2, 0);
  377. $x->div($two->pow($y))->int;
  378. }
  379. #
  380. ## log(a + b*i) = log(a^2 + b^2)/2 + atan2(b, a)*i -- where a,b are real
  381. #
  382. sub log {
  383. my ($x) = @_;
  384. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  385. my $t = $x->{a} * $x->{a} + $x->{b} * $x->{b};
  386. if (!ref($t) and $t == 0) {
  387. return __PACKAGE__->new(0 + '-Inf', 0);
  388. }
  389. __PACKAGE__->new(CORE::log($t) / 2, CORE::atan2($x->{b}, $x->{a}));
  390. }
  391. #
  392. ## logn(x, n) = log(x) / log(n)
  393. #
  394. sub logn ($$) {
  395. my ($x, $n) = @_;
  396. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  397. $n = __PACKAGE__->new($n) if ref($n) ne __PACKAGE__;
  398. $x->log->div($n->log);
  399. }
  400. #
  401. ## exp(a + b*i) = exp(a)*cos(b) + exp(a)*sin(b)*i
  402. #
  403. sub exp {
  404. my ($x) = @_;
  405. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  406. my $exp = CORE::exp($x->{a});
  407. __PACKAGE__->new($exp * CORE::cos($x->{b}), $exp * CORE::sin($x->{b}));
  408. }
  409. #
  410. ## x^y = exp(log(x) * y)
  411. #
  412. sub pow ($$) {
  413. my ($x, $y) = @_;
  414. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  415. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  416. if ($x->{a} == 0 and $x->{b} == 0) {
  417. if ($y->{a} < 0) {
  418. return $x->inv;
  419. }
  420. if ($y->{a} == 0 and $y->{b} == 0) {
  421. return __PACKAGE__->new($x->{a} + 1, $x->{b});
  422. }
  423. return $x;
  424. }
  425. $x->log->mul($y)->exp;
  426. }
  427. #
  428. ## x^n using the exponentiation by squaring method
  429. #
  430. sub pown ($$) {
  431. my ($x, $y) = @_;
  432. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  433. $y = CORE::int($y);
  434. my $neg = $y < 0;
  435. $y = CORE::int(CORE::abs($y));
  436. if ($x->{a} == 0 and $x->{b} == 0) {
  437. if ($neg) {
  438. return $x->inv;
  439. }
  440. if ($y == 0) {
  441. return __PACKAGE__->new($x->{a} + 1, $x->{b});
  442. }
  443. return $x;
  444. }
  445. my ($rx, $ry) = (1, 0);
  446. my ($ax, $bx) = (@{$x}{qw(a b)});
  447. while (1) {
  448. ($rx, $ry) = ($rx * $ax - $ry * $bx, $rx * $bx + $ry * $ax) if ($y & 1);
  449. ($y >>= 1) or last;
  450. ($ax, $bx) = ($ax * $ax - $bx * $bx, $ax * $bx + $bx * $ax);
  451. }
  452. $neg ? __PACKAGE__->new($rx, $ry)->inv : __PACKAGE__->new($rx, $ry);
  453. }
  454. #
  455. ## Greatest common divisor
  456. #
  457. sub gcd ($$) {
  458. my ($n, $k) = @_;
  459. $n = __PACKAGE__->new($n) if ref($n) ne __PACKAGE__;
  460. $k = __PACKAGE__->new($k) if ref($k) ne __PACKAGE__;
  461. my $norm_n = $n->{a} * $n->{a} + $n->{b} * $n->{b};
  462. my $norm_k = $k->{a} * $k->{a} + $k->{b} * $k->{b};
  463. if ($norm_n > $norm_k) {
  464. ($n, $k) = ($k, $n);
  465. }
  466. while (!($k->{a} == 0 and $k->{b} == 0)) {
  467. my $q = $n->div($k)->round;
  468. my $r = $n->sub($q->mul($k));
  469. ($n, $k) = ($k, $r);
  470. }
  471. $n;
  472. }
  473. #
  474. ## Modular multiplicative inverse: 1/x (mod m)
  475. #
  476. sub invmod ($$) {
  477. my ($x, $m) = @_;
  478. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  479. $m = __PACKAGE__->new($m) if ref($m) ne __PACKAGE__;
  480. my $g = $x->gcd($m);
  481. $g->abs == 1 or return undef;
  482. state $zero = __PACKAGE__->new(0, 0);
  483. my $inverse = sub {
  484. my ($x, $m, $k) = @_;
  485. my ($u, $w) = ($k, $zero);
  486. my ($q, $r);
  487. my $c = $m;
  488. while (!($c->{a} == 0 and $c->{b} == 0)) {
  489. $q = $x->div($c)->round;
  490. $r = $x->sub($q->mul($c));
  491. ($x, $c) = ($c, $r);
  492. ($u, $w) = ($w, $u->sub($q->mul($w)));
  493. }
  494. return $u;
  495. };
  496. state $one = __PACKAGE__->new(1, 0);
  497. state $mone = __PACKAGE__->new(-1, 0);
  498. state $i = __PACKAGE__->new(0, 1);
  499. state $mi = __PACKAGE__->new(0, -1);
  500. foreach my $k ($g->conj, $one, $mone, $i, $mi) {
  501. my $inv = $inverse->($x, $m, $k);
  502. my $t = $x->mul($inv)->mod($m);
  503. if ($t->{a} == 1 and $t->{b} == 0) {
  504. return $inv->mod($m);
  505. }
  506. }
  507. return undef;
  508. }
  509. #
  510. ## x^n mod m using the exponentiation by squaring method
  511. #
  512. sub powmod ($$$) {
  513. my ($x, $y, $m) = @_;
  514. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  515. $m = __PACKAGE__->new($m) if ref($m) ne __PACKAGE__;
  516. $y = CORE::int($y);
  517. my $neg = $y < 0;
  518. $y = CORE::int(CORE::abs($y));
  519. if ($x->{a} == 0 and $x->{b} == 0) {
  520. if ($neg) {
  521. return $x->invmod($m);
  522. }
  523. if ($y == 0) {
  524. return __PACKAGE__->new($x->{a} + 1, $x->{b})->mod($m);
  525. }
  526. return $x->mod($m);
  527. }
  528. $x = $x->invmod($m) if $neg;
  529. $x // return undef;
  530. my $r = __PACKAGE__->new(1, 0);
  531. while (1) {
  532. $r = $r->mul($x)->mod($m) if ($y & 1);
  533. ($y >>= 1) or last;
  534. $x = $x->mul($x)->mod($m);
  535. }
  536. $r->mod($m);
  537. }
  538. #
  539. ## root(x, y) = exp(log(x) / y)
  540. #
  541. sub root ($$) {
  542. my ($x, $y) = @_;
  543. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  544. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  545. $x->pow($y->inv);
  546. }
  547. #
  548. ## sqrt(a + b*i) = exp(log(a + b*i) / 2)
  549. #
  550. sub sqrt {
  551. my ($x) = @_;
  552. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  553. my $r = $x->log;
  554. $r->{a} /= 2;
  555. $r->{b} /= 2;
  556. $r->exp;
  557. }
  558. #
  559. ## cbrt(a + b*i) = exp(log(a + b*i) / 3)
  560. #
  561. sub cbrt ($) {
  562. my ($x) = @_;
  563. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  564. if ($x->{a} == 0 and $x->{b} == 0) {
  565. return __PACKAGE__->new(0, 0);
  566. }
  567. my $r = $x->log;
  568. $r->{a} /= 3;
  569. $r->{b} /= 3;
  570. $r->exp;
  571. }
  572. #
  573. ## int(a + b*i) = int(a) + int(b)*i
  574. #
  575. sub int {
  576. my ($x) = @_;
  577. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  578. my $t1 = CORE::int($x->{a});
  579. my $t2 = CORE::int($x->{b});
  580. __PACKAGE__->new($t1, $t2);
  581. }
  582. #
  583. ## round to the nearest Gaussian integer
  584. #
  585. sub _round ($) {
  586. my ($n) = @_;
  587. CORE::int(($n + $n + (($n < 0) ? -1 : 1)) / 2);
  588. }
  589. sub round ($) {
  590. my ($x) = @_;
  591. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  592. __PACKAGE__->new(_round($x->{a}), _round($x->{b}));
  593. }
  594. #
  595. ## floor(a + b*i) = floor(a) + floor(b)*i
  596. #
  597. sub floor ($) {
  598. my ($x) = @_;
  599. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  600. my $t1 = CORE::int($x->{a});
  601. $t1 -= 1 if ($x->{a} != $t1 and $x->{a} < 0);
  602. my $t2 = CORE::int($x->{b});
  603. $t2 -= 1 if ($x->{b} != $t2 and $x->{b} < 0);
  604. __PACKAGE__->new($t1, $t2);
  605. }
  606. #
  607. ## ceil(a + b*i) = -floor(-(a + b*i))
  608. #
  609. sub ceil ($) {
  610. my ($x) = @_;
  611. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  612. my $t = $x->neg->floor;
  613. $t->{a} = -$t->{a};
  614. $t->{b} = -$t->{b};
  615. $t;
  616. }
  617. ########################################################################
  618. # SIN / SINH / ASIN / ASINH
  619. ########################################################################
  620. #
  621. ## sin(a + b*i) = i*(exp(b - i*a) - exp(-b + i*a))/2
  622. #
  623. sub sin {
  624. my ($x) = @_;
  625. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  626. my $t1 = __PACKAGE__->new(+$x->{b}, -$x->{a})->exp;
  627. my $t2 = __PACKAGE__->new(-$x->{b}, +$x->{a})->exp;
  628. $t1->{a} -= $t2->{a};
  629. $t1->{b} -= $t2->{b};
  630. $t1->{a} /= 2;
  631. $t1->{b} /= 2;
  632. @{$t1}{qw(a b)} = (-$t1->{b}, $t1->{a});
  633. $t1;
  634. }
  635. #
  636. ## sinh(a + b*i) = (exp(2 * (a + b*i)) - 1) / (2*exp(a + b*i))
  637. #
  638. sub sinh ($) {
  639. my ($x) = @_;
  640. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  641. my $t1 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  642. $t1->{a} -= 1;
  643. my $t2 = $x->exp;
  644. $t2->{a} *= 2;
  645. $t2->{b} *= 2;
  646. $t1->div($t2);
  647. }
  648. #
  649. ## asin(a + b*i) = -i*log(sqrt(1 - (a + b*i)^2) + i*a - b)
  650. #
  651. sub asin ($) {
  652. my ($x) = @_;
  653. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  654. my $r = __PACKAGE__->new(1 - ($x->{a} * $x->{a} - $x->{b} * $x->{b}), -($x->{a} * $x->{b} + $x->{b} * $x->{a}))->sqrt;
  655. $r->{a} -= $x->{b};
  656. $r->{b} += $x->{a};
  657. $r = $r->log;
  658. @{$r}{qw(a b)} = ($r->{b}, -$r->{a});
  659. $r;
  660. }
  661. #
  662. ## asinh(a + b*i) = log(sqrt((a + b*i)^2 + 1) + (a + b*i))
  663. #
  664. sub asinh ($) {
  665. my ($x) = @_;
  666. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  667. my $r = __PACKAGE__->new($x->{a} * $x->{a} - $x->{b} * $x->{b} + 1, $x->{a} * $x->{b} + $x->{b} * $x->{a})->sqrt;
  668. $r->{a} += $x->{a};
  669. $r->{b} += $x->{b};
  670. $r->log;
  671. }
  672. ########################################################################
  673. # COS / COSH / ACOS / ACOSH
  674. ########################################################################
  675. #
  676. ## cos(a + b*i) = (exp(-b + i*a) + exp(b - i*a))/2
  677. #
  678. sub cos {
  679. my ($x) = @_;
  680. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  681. my $t1 = __PACKAGE__->new(-$x->{b}, +$x->{a})->exp;
  682. my $t2 = __PACKAGE__->new(+$x->{b}, -$x->{a})->exp;
  683. $t1->{a} += $t2->{a};
  684. $t1->{b} += $t2->{b};
  685. $t1->{a} /= 2;
  686. $t1->{b} /= 2;
  687. $t1;
  688. }
  689. #
  690. ## cosh(a + b*i) = (exp(2 * (a + b*i)) + 1) / (2*exp(a + b*i))
  691. #
  692. sub cosh ($) {
  693. my ($x) = @_;
  694. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  695. my $t1 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  696. $t1->{a} += 1;
  697. my $t2 = $x->exp;
  698. $t2->{a} *= 2;
  699. $t2->{b} *= 2;
  700. $t1->div($t2);
  701. }
  702. #
  703. ## acos(a + b*i) = -2*i*log(i*sqrt((1 - (a + b*i))/2) + sqrt((1 + (a + b*i))/2))
  704. #
  705. sub acos ($) {
  706. my ($x) = @_;
  707. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  708. my $t1 = __PACKAGE__->new((1 - $x->{a}) / 2, $x->{b} / -2)->sqrt;
  709. my $t2 = __PACKAGE__->new((1 + $x->{a}) / 2, $x->{b} / +2)->sqrt;
  710. @{$t1}{qw(a b)} = (-$t1->{b}, $t1->{a});
  711. $t1->{a} += $t2->{a};
  712. $t1->{b} += $t2->{b};
  713. my $r = $t1->log;
  714. $r->{a} *= -2;
  715. $r->{b} *= -2;
  716. @{$r}{qw(a b)} = (-$r->{b}, $r->{a});
  717. $r;
  718. }
  719. #
  720. ## acosh(a + b*i) = log((a + b*i) + sqrt((a + b*i) - 1) * sqrt((a + b*i) + 1))
  721. #
  722. sub acosh ($) {
  723. my ($x) = @_;
  724. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  725. my $t1 = __PACKAGE__->new($x->{a} - 1, $x->{b})->sqrt;
  726. my $t2 = __PACKAGE__->new($x->{a} + 1, $x->{b})->sqrt;
  727. my $t3 = $t1->mul($t2);
  728. $t3->{a} += $x->{a};
  729. $t3->{b} += $x->{b};
  730. $t3->log;
  731. }
  732. ########################################################################
  733. # TAN / TANH / ATAN / ATANH
  734. ########################################################################
  735. #
  736. ## tan(a + b*i) = (2*i)/(exp(2*i*(a + b*i)) + 1) - i
  737. #
  738. sub tan ($) {
  739. my ($x) = @_;
  740. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  741. my $r = __PACKAGE__->new(-2 * $x->{b}, 2 * $x->{a})->exp;
  742. $r->{a} += 1;
  743. my $den = $r->{a} * $r->{a} + $r->{b} * $r->{b};
  744. $r->{a} *= 2;
  745. $r->{b} *= 2;
  746. if (!ref($den) and $den == 0) {
  747. $r = $r->div($den);
  748. }
  749. else {
  750. $r->{a} /= $den;
  751. $r->{b} /= $den;
  752. }
  753. $r->{a} -= 1;
  754. @{$r}{qw(a b)} = ($r->{b}, $r->{a});
  755. $r;
  756. }
  757. #
  758. ## tanh(a + b*i) = (exp(2 * (a + b*i)) - 1) / (exp(2 * (a + b*i)) + 1)
  759. #
  760. sub tanh ($) {
  761. my ($x) = @_;
  762. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  763. my $t1 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  764. my $t2 = __PACKAGE__->new($t1->{a} - 1, $t1->{b});
  765. my $t3 = __PACKAGE__->new($t1->{a} + 1, $t1->{b});
  766. $t2->div($t3);
  767. }
  768. #
  769. ## atan(a + b*i) = i * (log(1 - i*(a + b*i)) - log(1 + i*(a + b*i))) / 2
  770. #
  771. sub atan ($) {
  772. my ($x) = @_;
  773. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  774. my $t1 = __PACKAGE__->new(+$x->{b} + 1, -$x->{a})->log;
  775. my $t2 = __PACKAGE__->new(-$x->{b} + 1, +$x->{a})->log;
  776. $t1->{a} -= $t2->{a};
  777. $t1->{b} -= $t2->{b};
  778. $t1->{a} /= 2;
  779. $t1->{b} /= 2;
  780. @{$t1}{qw(a b)} = (-$t1->{b}, $t1->{a});
  781. $t1;
  782. }
  783. #
  784. ## atan2(a, b) = -i * log((b + a*i) / sqrt(a^2 + b^2))
  785. #
  786. sub atan2 {
  787. my ($x, $y) = @_;
  788. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  789. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  790. my $t = __PACKAGE__->new($y->{a} - $x->{b}, $x->{a} + $y->{b});
  791. $t = $t->div($x->mul($x)->add($y->mul($y))->sqrt)->log;
  792. @{$t}{qw(a b)} = ($t->{b}, -$t->{a});
  793. $t;
  794. }
  795. #
  796. ## atanh(a + b*i) = (log(1 + (a + b*i)) - log(1 - (a + b*i))) / 2
  797. #
  798. sub atanh ($) {
  799. my ($x) = @_;
  800. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  801. my $t1 = __PACKAGE__->new(1 + $x->{a}, +$x->{b})->log;
  802. my $t2 = __PACKAGE__->new(1 - $x->{a}, -$x->{b})->log;
  803. $t1->{a} -= $t2->{a};
  804. $t1->{b} -= $t2->{b};
  805. $t1->{a} /= 2;
  806. $t1->{b} /= 2;
  807. $t1;
  808. }
  809. ########################################################################
  810. # COT / COTH / ACOT / ACOTH
  811. ########################################################################
  812. #
  813. ## cot(a + b*i) = (2*i)/(exp(2*i*(a + b*i)) - 1) + i
  814. #
  815. sub cot ($) {
  816. my ($x) = @_;
  817. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  818. my $r = __PACKAGE__->new(-2 * $x->{b}, 2 * $x->{a})->exp;
  819. $r->{a} -= 1;
  820. my $den = $r->{a} * $r->{a} + $r->{b} * $r->{b};
  821. $r->{a} *= 2;
  822. $r->{b} *= 2;
  823. if (!ref($den) and $den == 0) {
  824. $r = $r->div($den);
  825. }
  826. else {
  827. $r->{a} /= $den;
  828. $r->{b} /= $den;
  829. }
  830. $r->{a} += 1;
  831. @{$r}{qw(a b)} = ($r->{b}, $r->{a});
  832. $r;
  833. }
  834. #
  835. ## coth(a + b*i) = (exp(2 * (a + b*i)) + 1) / (exp(2 * (a + b*i)) - 1)
  836. #
  837. sub coth ($) {
  838. my ($x) = @_;
  839. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  840. my $t1 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  841. my $t2 = __PACKAGE__->new($t1->{a} + 1, $t1->{b});
  842. my $t3 = __PACKAGE__->new($t1->{a} - 1, $t1->{b});
  843. $t2->div($t3);
  844. }
  845. #
  846. ## acot(a + b*i) = atan(1/(a + b*i))
  847. #
  848. sub acot ($) {
  849. my ($x) = @_;
  850. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  851. $x->inv->atan;
  852. }
  853. #
  854. ## acoth(a + b*i) = atanh(1 / (a + b*i))
  855. #
  856. sub acoth ($) {
  857. my ($x) = @_;
  858. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  859. $x->inv->atanh;
  860. }
  861. ########################################################################
  862. # SEC / SECH / ASEC / ASECH
  863. ########################################################################
  864. #
  865. ## sec(a + b*i) = 2/(exp(-i*(a + b*i)) + exp(i*(a + b*i)))
  866. #
  867. sub sec ($) {
  868. my ($x) = @_;
  869. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  870. my $t1 = __PACKAGE__->new(+$x->{b}, -$x->{a})->exp;
  871. my $t2 = __PACKAGE__->new(-$x->{b}, +$x->{a})->exp;
  872. $t1->{a} += $t2->{a};
  873. $t1->{b} += $t2->{b};
  874. my $den = $t1->{a} * $t1->{a} + $t1->{b} * $t1->{b};
  875. $t1->{a} *= +2;
  876. $t1->{b} *= -2;
  877. if (!ref($den) and $den == 0) {
  878. $t1 = $t1->div($den);
  879. }
  880. else {
  881. $t1->{a} /= $den;
  882. $t1->{b} /= $den;
  883. }
  884. $t1;
  885. }
  886. #
  887. ## sech(a + b*i) = (2 * exp(a + b*i)) / (exp(2 * (a + b*i)) + 1)
  888. #
  889. sub sech ($) {
  890. my ($x) = @_;
  891. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  892. my $t1 = $x->exp;
  893. my $t2 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  894. $t1->{a} *= 2;
  895. $t1->{b} *= 2;
  896. $t2->{a} += 1;
  897. $t1->div($t2);
  898. }
  899. #
  900. ## asec(a + b*i) = acos(1/(a + b*i))
  901. #
  902. sub asec ($) {
  903. my ($x) = @_;
  904. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  905. $x->inv->acos;
  906. }
  907. #
  908. ## asech(a + b*i) = acosh(1/(a + b*i))
  909. #
  910. sub asech ($) {
  911. my ($x) = @_;
  912. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  913. $x->inv->acosh;
  914. }
  915. ########################################################################
  916. # CSC / CSCH / ACSC / ACSCH
  917. ########################################################################
  918. #
  919. ## csc(a + b*i) = -(2*i)/(exp(-i * (a + b*i)) - exp(i * (a + b*i)))
  920. #
  921. sub csc ($) {
  922. my ($x) = @_;
  923. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  924. my $t1 = __PACKAGE__->new(+$x->{b}, -$x->{a})->exp;
  925. my $t2 = __PACKAGE__->new(-$x->{b}, +$x->{a})->exp;
  926. $t1->{a} -= $t2->{a};
  927. $t1->{b} -= $t2->{b};
  928. my $den = $t1->{a} * $t1->{a} + $t1->{b} * $t1->{b};
  929. $t1->{a} *= -2;
  930. $t1->{b} *= -2;
  931. if (!ref($den) and $den == 0) {
  932. $t1 = $t1->div($den);
  933. }
  934. else {
  935. $t1->{a} /= $den;
  936. $t1->{b} /= $den;
  937. }
  938. @{$t1}{qw(a b)} = ($t1->{b}, $t1->{a});
  939. $t1;
  940. }
  941. #
  942. ## csch(a + b*i) = (2*exp(a + b*i)) / (exp(2 * (a + b*i)) - 1)
  943. #
  944. sub csch ($) {
  945. my ($x) = @_;
  946. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  947. my $t1 = $x->exp;
  948. my $t2 = __PACKAGE__->new($x->{a} * 2, $x->{b} * 2)->exp;
  949. $t1->{a} *= 2;
  950. $t1->{b} *= 2;
  951. $t2->{a} -= 1;
  952. $t1->div($t2);
  953. }
  954. #
  955. ## acsc(a + b*i) = asin(1/(a + b*i))
  956. #
  957. sub acsc ($) {
  958. my ($x) = @_;
  959. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  960. $x->inv->asin;
  961. }
  962. #
  963. ## acsch(a + b*i) = asinh(1/(a + b*i))
  964. #
  965. sub acsch ($) {
  966. my ($x) = @_;
  967. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  968. $x->inv->asinh;
  969. }
  970. #
  971. ## deg2rad(x) = x / 180 * atan2(0, -abs(x))
  972. #
  973. sub deg2rad ($) {
  974. my ($x) = @_;
  975. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  976. my $t = __PACKAGE__->new($x->{a} / 180, $x->{b} / 180);
  977. my $pi = CORE::atan2(0, -($x->{a} * $x->{a} + $x->{b} * $x->{b}));
  978. if (!ref($pi)) {
  979. $t->{a} *= $pi;
  980. $t->{b} *= $pi;
  981. return $t;
  982. }
  983. $t->mul($pi);
  984. }
  985. #
  986. ## rad2deg(x) = x * 180 / atan2(0, -abs(x))
  987. #
  988. sub rad2deg ($) {
  989. my ($x) = @_;
  990. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  991. my $r = __PACKAGE__->new($x->{a} * 180, $x->{b} * 180);
  992. my $t = $x->{a} * $x->{a} + $x->{b} * $x->{b};
  993. if ($t == 0) {
  994. return $r;
  995. }
  996. my $pi = CORE::atan2(0, -$t);
  997. if (!ref($pi) and $pi != 0) {
  998. $r->{a} /= $pi;
  999. $r->{b} /= $pi;
  1000. return $r;
  1001. }
  1002. $r->div($pi);
  1003. }
  1004. ########################### MISC FUNCTIONS ###########################
  1005. #
  1006. ## real(a + b*i) = a
  1007. #
  1008. sub real ($) {
  1009. my ($x) = @_;
  1010. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1011. $x->{a};
  1012. }
  1013. #
  1014. ## imag(a + b*i) = b
  1015. #
  1016. sub imag ($) {
  1017. my ($x) = @_;
  1018. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1019. $x->{b};
  1020. }
  1021. #
  1022. ## reals(a + b*i) = (a, b)
  1023. #
  1024. sub reals ($) {
  1025. my ($x) = @_;
  1026. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1027. ($x->{a}, $x->{b});
  1028. }
  1029. #
  1030. ## Equality
  1031. #
  1032. sub eq {
  1033. my ($x, $y) = @_;
  1034. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1035. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1036. $x->{a} == $y->{a}
  1037. and $x->{b} == $y->{b};
  1038. }
  1039. #
  1040. ## Inequality
  1041. #
  1042. sub ne {
  1043. my ($x, $y) = @_;
  1044. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1045. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1046. $x->{a} != $y->{a}
  1047. or $x->{b} != $y->{b};
  1048. }
  1049. #
  1050. ## Comparisons
  1051. #
  1052. sub cmp {
  1053. my ($x, $y) = @_;
  1054. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1055. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1056. (($x->{a} <=> $y->{a}) // return undef)
  1057. or (($x->{b} <=> $y->{b}) // return undef);
  1058. }
  1059. sub acmp ($$) {
  1060. my ($x, $y) = @_;
  1061. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1062. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1063. $x->abs <=> $y->abs;
  1064. }
  1065. sub lt {
  1066. my ($x, $y) = @_;
  1067. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1068. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1069. ($x->cmp($y) // return undef) < 0;
  1070. }
  1071. sub le {
  1072. my ($x, $y) = @_;
  1073. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1074. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1075. ($x->cmp($y) // return undef) <= 0;
  1076. }
  1077. sub gt {
  1078. my ($x, $y) = @_;
  1079. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1080. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1081. ($x->cmp($y) // return undef) > 0;
  1082. }
  1083. sub ge {
  1084. my ($x, $y) = @_;
  1085. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1086. $y = __PACKAGE__->new($y) if ref($y) ne __PACKAGE__;
  1087. ($x->cmp($y) // return undef) >= 0;
  1088. }
  1089. sub stringify {
  1090. my ($x) = @_;
  1091. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1092. "($x->{a} $x->{b})";
  1093. }
  1094. sub boolify {
  1095. my ($x) = @_;
  1096. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1097. !!$x->{a} or !!$x->{b};
  1098. }
  1099. sub numify {
  1100. my ($x) = @_;
  1101. $x = __PACKAGE__->new($x) if ref($x) ne __PACKAGE__;
  1102. $x->{a};
  1103. }
  1104. 1; # End of Math::GComplex