sub plus {
my ($z1, $z2, $regular) = @_;
my ($re1, $im1) = @{$z1->cartesian};
+ $z2 = cplx($z2) unless ref $z2;
my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
unless (defined $regular) {
$z1->set_cartesian([$re1 + $re2, $im1 + $im2]);
sub minus {
my ($z1, $z2, $inverted) = @_;
my ($re1, $im1) = @{$z1->cartesian};
- my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+ $z2 = cplx($z2) unless ref $z2;
+ my ($re2, $im2) = @{$z2->cartesian};
unless (defined $inverted) {
$z1->set_cartesian([$re1 - $re2, $im1 - $im2]);
return $z1;
return $inverted ?
(ref $z1)->make($re2 - $re1, $im2 - $im1) :
(ref $z1)->make($re1 - $re2, $im1 - $im2);
+
}
#
sub multiply {
my ($z1, $z2, $regular) = @_;
my ($r1, $t1) = @{$z1->polar};
- my ($r2, $t2) = ref $z2 ?
- @{$z2->polar} : (abs($z2), $z2 >= 0 ? 0 : pi);
+ $z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
+ my ($r2, $t2) = @{$z2->polar};
unless (defined $regular) {
$z1->set_polar([$r1 * $r2, $t1 + $t2]);
return $z1;
}
#
-# divbyzero
+# _divbyzero
#
# Die on division by zero.
#
-sub divbyzero {
+sub _divbyzero {
my $mess = "$_[0]: Division by zero.\n";
if (defined $_[1]) {
}
#
-# zerotozero
-#
-# Die on zero raised to the zeroth.
-#
-sub zerotozero {
- my $mess = "The zero raised to the zeroth power is not defined.\n";
-
- my @up = caller(1);
-
- $mess .= "Died at $up[1] line $up[2].\n";
-
- die $mess;
-}
-
-#
# (divide)
#
# Computes z1/z2.
sub divide {
my ($z1, $z2, $inverted) = @_;
my ($r1, $t1) = @{$z1->polar};
- my ($r2, $t2) = ref $z2 ?
- @{$z2->polar} : (abs($z2), $z2 >= 0 ? 0 : pi);
+ $z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
+ my ($r2, $t2) = @{$z2->polar};
unless (defined $inverted) {
- divbyzero "$z1/0" if ($r2 == 0);
+ _divbyzero "$z1/0" if ($r2 == 0);
$z1->set_polar([$r1 / $r2, $t1 - $t2]);
return $z1;
}
if ($inverted) {
- divbyzero "$z2/0" if ($r1 == 0);
+ _divbyzero "$z2/0" if ($r1 == 0);
return (ref $z1)->emake($r2 / $r1, $t2 - $t1);
} else {
- divbyzero "$z1/0" if ($r2 == 0);
+ _divbyzero "$z1/0" if ($r2 == 0);
return (ref $z1)->emake($r1 / $r2, $t1 - $t2);
}
}
#
+# _zerotozero
+#
+# Die on zero raised to the zeroth.
+#
+sub _zerotozero {
+ my $mess = "The zero raised to the zeroth power is not defined.\n";
+
+ my @up = caller(1);
+
+ $mess .= "Died at $up[1] line $up[2].\n";
+
+ die $mess;
+}
+
+#
# (power)
#
# Computes z1**z2 = exp(z2 * log z1)).
#
sub power {
my ($z1, $z2, $inverted) = @_;
- zerotozero if ($z1 == 0 and $z2 == 0);
- return exp($z1 * log $z2) if defined $inverted && $inverted;
- return exp($z2 * log $z1);
+ my $z1z = $z1 == 0;
+ my $z2z = $z2 == 0;
+ _zerotozero if ($z1z and $z2z);
+ if ($inverted) {
+ return 0 if ($z2z);
+ return 1 if ($z1z or $z2 == 1);
+ } else {
+ return 0 if ($z1z);
+ return 1 if ($z2z or $z1 == 1);
+ }
+ $z2 = cplx($z2) unless ref $z2;
+ unless (defined $inverted) {
+ my $z3 = exp($z2 * log $z1);
+ $z1->set_cartesian([@{$z3->cartesian}]);
+ return $z1;
+ }
+ return exp($z2 * log $z1) unless $inverted;
+ return exp($z1 * log $z2);
}
#
}
#
+# _rootbad
+#
+# Die on bad root.
+#
+sub _rootbad {
+ my $mess = "Root $_[0] not defined, root must be positive integer.\n";
+
+ my @up = caller(1);
+
+ $mess .= "Died at $up[1] line $up[2].\n";
+
+ die $mess;
+}
+
+#
# root
#
# Computes all nth root for z, returning an array whose size is n.
#
sub root {
my ($z, $n) = @_;
- $n = int($n + 0.5);
- return undef unless $n > 0;
+ _rootbad($n) if ($n < 1 or int($n) != $n);
my ($r, $t) = ref $z ? @{$z->polar} : (abs($z), $z >= 0 ? 0 : pi);
my @root;
my $k;
sub tan {
my ($z) = @_;
my $cz = cos($z);
- divbyzero "tan($z)", "cos($z)" if ($cz == 0);
+ _divbyzero "tan($z)", "cos($z)" if ($cz == 0);
return sin($z) / $cz;
}
sub sec {
my ($z) = @_;
my $cz = cos($z);
- divbyzero "sec($z)", "cos($z)" if ($cz == 0);
+ _divbyzero "sec($z)", "cos($z)" if ($cz == 0);
return 1 / $cz;
}
sub csc {
my ($z) = @_;
my $sz = sin($z);
- divbyzero "csc($z)", "sin($z)" if ($sz == 0);
+ _divbyzero "csc($z)", "sin($z)" if ($sz == 0);
return 1 / $sz;
}
sub cot {
my ($z) = @_;
my $sz = sin($z);
- divbyzero "cot($z)", "sin($z)" if ($sz == 0);
+ _divbyzero "cot($z)", "sin($z)" if ($sz == 0);
return cos($z) / $sz;
}
sub atan {
my ($z) = @_;
$z = cplx($z, 0) unless ref $z;
- divbyzero "atan($z)", "i - $z" if ($z == i);
+ _divbyzero "atan($z)", "i - $z" if ($z == i);
return i/2*log((i + $z) / (i - $z));
}
#
sub asec {
my ($z) = @_;
- divbyzero "asec($z)", $z if ($z == 0);
+ _divbyzero "asec($z)", $z if ($z == 0);
return acos(1 / $z);
}
#
sub acsc {
my ($z) = @_;
- divbyzero "acsc($z)", $z if ($z == 0);
+ _divbyzero "acsc($z)", $z if ($z == 0);
return asin(1 / $z);
}
sub acot {
my ($z) = @_;
$z = cplx($z, 0) unless ref $z;
- divbyzero "acot($z)", "$z - i" if ($z == i);
+ _divbyzero "acot($z)", "$z - i" if ($z == i);
return i/-2 * log((i + $z) / ($z - i));
}
#
sub cosh {
my ($z) = @_;
- my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+ my $real;
+ unless (ref $z) {
+ $z = cplx($z, 0);
+ $real = 1;
+ }
+ my ($x, $y) = @{$z->cartesian};
my $ex = exp($x);
my $ex_1 = 1 / $ex;
- return ($ex + $ex_1)/2 unless ref $z;
+ return cplx(0.5 * ($ex + $ex_1), 0) if $real;
return (ref $z)->make(cos($y) * ($ex + $ex_1)/2,
sin($y) * ($ex - $ex_1)/2);
}
#
sub sinh {
my ($z) = @_;
- my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+ my $real;
+ unless (ref $z) {
+ $z = cplx($z, 0);
+ $real = 1;
+ }
+ my ($x, $y) = @{$z->cartesian};
my $ex = exp($x);
my $ex_1 = 1 / $ex;
- return ($ex - $ex_1)/2 unless ref $z;
+ return cplx(0.5 * ($ex - $ex_1), 0) if $real;
return (ref $z)->make(cos($y) * ($ex - $ex_1)/2,
sin($y) * ($ex + $ex_1)/2);
}
sub tanh {
my ($z) = @_;
my $cz = cosh($z);
- divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
+ _divbyzero "tanh($z)", "cosh($z)" if ($cz == 0);
return sinh($z) / $cz;
}
sub sech {
my ($z) = @_;
my $cz = cosh($z);
- divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
+ _divbyzero "sech($z)", "cosh($z)" if ($cz == 0);
return 1 / $cz;
}
sub csch {
my ($z) = @_;
my $sz = sinh($z);
- divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
+ _divbyzero "csch($z)", "sinh($z)" if ($sz == 0);
return 1 / $sz;
}
sub coth {
my ($z) = @_;
my $sz = sinh($z);
- divbyzero "coth($z)", "sinh($z)" if ($sz == 0);
+ _divbyzero "coth($z)", "sinh($z)" if ($sz == 0);
return cosh($z) / $sz;
}
#
sub atanh {
my ($z) = @_;
- divbyzero 'atanh(1)', "1 - $z" if ($z == 1);
+ _divbyzero 'atanh(1)', "1 - $z" if ($z == 1);
$z = cplx($z, 0) unless ref $z;
my $cz = (1 + $z) / (1 - $z);
return log($cz) / 2;
#
sub asech {
my ($z) = @_;
- divbyzero 'asech(0)', $z if ($z == 0);
+ _divbyzero 'asech(0)', $z if ($z == 0);
return acosh(1 / $z);
}
#
sub acsch {
my ($z) = @_;
- divbyzero 'acsch(0)', $z if ($z == 0);
+ _divbyzero 'acsch(0)', $z if ($z == 0);
return asinh(1 / $z);
}
#
sub acoth {
my ($z) = @_;
- divbyzero 'acoth(1)', "$z - 1" if ($z == 1);
+ _divbyzero 'acoth(1)', "$z - 1" if ($z == 1);
$z = cplx($z, 0) unless ref $z;
my $cz = (1 + $z) / ($z - 1);
return log($cz) / 2;
(root(z, n))[k] = r**(1/n) * exp(i * (t + 2*k*pi)/n)
-The I<spaceship> comparison operator is also defined. In order to
-ensure its restriction to real numbers is conform to what you would
-expect, the comparison is run on the real part of the complex number
-first, and imaginary parts are compared only when the real parts
-match.
+The I<spaceship> comparison operator, E<lt>=E<gt>, is also defined. In
+order to ensure its restriction to real numbers is conform to what you
+would expect, the comparison is run on the real part of the complex
+number first, and imaginary parts are compared only when the real
+parts match.
=head1 CREATION
=head1 AUTHORS
- Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>>
- Jarkko Hietaniemi <F<jhi@iki.fi>>
+Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
+Jarkko Hietaniemi <F<jhi@iki.fi>>.
=cut