#
# Complex numbers and associated mathematical functions
# -- Raphael Manfredi, September 1996
-# -- Jarkko Hietaniemi, March 1997
+# -- Jarkko Hietaniemi, March-April 1997
require Exporter;
package Math::Complex;
use vars qw($VERSION @ISA
@EXPORT %EXPORT_TAGS
$package $display
- $pi $i $ilog10 $logn %logn);
+ $i $logn %logn);
@ISA = qw(Exporter);
my @trig = qw(
pi
- tan
+ sin cos tan
csc cosec sec cot cotan
asin acos atan
acsc acosec asec acot acotan
#
# The number defined as 2 * pi = 360 degrees
#
-sub pi () {
- $pi = 4 * atan2(1, 1) unless $pi;
- return $pi;
-}
+
+use constant pi => 4 * atan2(1, 1);
+
+#
+# log2inv
+#
+# Used in log10().
+#
+
+use constant log10inv => 1 / log(10);
#
# i
# The number defined as i*i = -1;
#
sub i () {
- $i = bless {} unless $i; # There can be only one i
+ return $i if ($i);
+ $i = bless {};
$i->{'cartesian'} = [0, 1];
- $i->{'polar'} = [1, pi/2];
+ $i->{'polar'} = [1, pi/2];
$i->{c_dirty} = 0;
$i->{p_dirty} = 0;
return $i;
#
sub plus {
my ($z1, $z2, $regular) = @_;
- $z2 = cplx($z2, 0) unless ref $z2;
my ($re1, $im1) = @{$z1->cartesian};
- my ($re2, $im2) = @{$z2->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]);
return $z1;
#
sub minus {
my ($z1, $z2, $inverted) = @_;
- $z2 = cplx($z2, 0) unless ref $z2;
my ($re1, $im1) = @{$z1->cartesian};
+ $z2 = cplx($z2) unless ref $z2;
my ($re2, $im2) = @{$z2->cartesian};
unless (defined $inverted) {
$z1->set_cartesian([$re1 - $re2, $im1 - $im2]);
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 {
- warn "$_[0]: Division by zero.\n";
- warn "(Because in the definition of $_[0], $_[1] is 0)\n"
- if (defined $_[1]);
+sub _divbyzero {
+ my $mess = "$_[0]: Division by zero.\n";
+
+ if (defined $_[1]) {
+ $mess .= "(Because in the definition of $_[0], the divisor ";
+ $mess .= "$_[1] " unless ($_[1] eq '0');
+ $mess .= "is 0)\n";
+ }
+
my @up = caller(1);
- my $dmess = "Died at $up[1] line $up[2].\n";
- die $dmess;
+
+ $mess .= "Died at $up[1] line $up[2].\n";
+
+ die $mess;
}
#
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) = @_;
- 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);
}
#
#
sub spaceship {
my ($z1, $z2, $inverted) = @_;
- $z2 = cplx($z2, 0) unless ref $z2;
- my ($re1, $im1) = @{$z1->cartesian};
- my ($re2, $im2) = @{$z2->cartesian};
+ my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+ my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
my $sgn = $inverted ? -1 : 1;
return $sgn * ($re1 <=> $re2) if $re1 != $re2;
return $sgn * ($im1 <=> $im2);
}
#
+# _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 log {
my ($z) = @_;
$z = cplx($z, 0) unless ref $z;
- my ($r, $t) = @{$z->polar};
my ($x, $y) = @{$z->cartesian};
+ my ($r, $t) = @{$z->polar};
$t -= 2 * pi if ($t > pi() and $x < 0);
$t += 2 * pi if ($t < -pi() and $x < 0);
return (ref $z)->make(log($r), $t);
#
# Compute log10(z).
#
+
sub log10 {
my ($z) = @_;
- my $ilog10 = 1 / log(10) unless defined $ilog10;
- return log(cplx($z, 0)) * $ilog10 unless ref $z;
+
+ return log(cplx($z, 0)) * log10inv unless ref $z;
my ($r, $t) = @{$z->polar};
- return (ref $z)->make(log($r) * $ilog10, $t * $ilog10);
+ return (ref $z)->make(log($r) * log10inv, $t * log10inv);
}
#
#
sub cos {
my ($z) = @_;
+ $z = cplx($z, 0) unless ref $z;
my ($x, $y) = @{$z->cartesian};
my $ey = exp($y);
my $ey_1 = 1 / $ey;
#
sub sin {
my ($z) = @_;
+ $z = cplx($z, 0) unless ref $z;
my ($x, $y) = @{$z->cartesian};
my $ey = exp($y);
my $ey_1 = 1 / $ey;
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) = @_;
- divbyzero "atan($z)", "i - $z" if ($z == i);
+ $z = cplx($z, 0) unless ref $z;
+ _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);
return acos(1 / $z);
}
#
-# acosec
+# acsc
#
# Computes the arc cosecant sec(z) = asin(1 / z).
#
-sub acosec {
+sub acsc {
my ($z) = @_;
+ _divbyzero "acsc($z)", $z if ($z == 0);
return asin(1 / $z);
}
#
-# acsc
+# acosec
#
-# Alias for acosec().
+# Alias for acsc().
#
-sub acsc { Math::Complex::acosec(@_) }
+sub acosec { Math::Complex::acsc(@_) }
#
# acot
#
sub acot {
my ($z) = @_;
- divbyzero "acot($z)", "$z - i" if ($z == i);
+ $z = cplx($z, 0) unless ref $z;
+ _divbyzero "acot($z)", "$z - i" if ($z == i);
return i/-2 * log((i + $z) / ($z - i));
}
#
sub cosh {
my ($z) = @_;
- $z = cplx($z, 0) unless ref $z;
+ 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) = @_;
- $z = cplx($z, 0) unless ref $z;
+ 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 acosh {
my ($z) = @_;
- $z = cplx($z, 0) unless ref $z; # asinh(-2)
+ $z = cplx($z, 0) unless ref $z;
return log($z + sqrt($z*$z - 1));
}
#
sub asinh {
my ($z) = @_;
- $z = cplx($z, 0) unless ref $z; # asinh(-2)
+ $z = cplx($z, 0) unless ref $z;
return log($z + sqrt($z*$z + 1));
}
#
sub atanh {
my ($z) = @_;
- $z = cplx($z, 0) unless ref $z; # atanh(-2)
- 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) = @_;
- $z = cplx($z, 0) unless ref $z; # acoth(-2)
- 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;
}
#
sub atan2 {
my ($z1, $z2, $inverted) = @_;
- my ($re1, $im1) = @{$z1->cartesian};
- my ($re2, $im2) = @{$z2->cartesian};
+ my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
+ my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
my $tan;
if (defined $inverted && $inverted) { # atan(z2/z1)
return pi * ($re2 > 0 ? 1 : -1) if $re1 == 0 && $im1 == 0;
(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
$k = exp(i * 2*pi/3);
print "$j - $k = ", $j - $k, "\n";
-=head1 CAVEATS
+=head1 ERRORS DUE TO DIVISION BY ZERO
The division (/) and the following functions
sec
csc
cot
+ asec
+ acsc
atan
acot
tanh
by zero. These situations cause fatal runtime errors looking like this
cot(0): Division by zero.
- (Because in the definition of cot(0), sin(0) is 0)
+ (Because in the definition of cot(0), the divisor sin(0) is 0)
Died at ...
+For the C<csc>, C<cot>, C<asec>, C<acsc>, C<csch>, C<coth>, C<asech>,
+C<acsch>, the argument cannot be C<0> (zero). For the C<atanh>,
+C<acoth>, the argument cannot be C<1> (one). For the C<atan>, C<acot>,
+the argument cannot be C<i> (the imaginary unit). For the C<tan>,
+C<sec>, C<tanh>, C<sech>, the argument cannot be I<pi/2 + k * pi>, where
+I<k> is any integer.
+
=head1 BUGS
-Saying C<use Math::Complex;> exports many mathematical routines in the caller
-environment. This is construed as a feature by the Author, actually... ;-)
+Saying C<use Math::Complex;> exports many mathematical routines in the
+caller environment and even overrides some (C<sin>, C<cos>, C<sqrt>,
+C<log>, C<exp>). This is construed as a feature by the Authors,
+actually... ;-)
The code is not optimized for speed, although we try to use the cartesian
form for addition-like operators and the trigonometric form for all
=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
+
+# eof
projects / p5sagit/p5-mst-13.2.git / blobdiff