Sys::Syslog patch to allow unix domain sockets

[p5sagit/p5-mst-13.2.git] / lib / Math / Complex.pm

diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm
index 20762bd..7a4617c 100644 (file)
--- a/lib/Math/Complex.pm
+++ b/lib/Math/Complex.pm
@@ -207,6 +207,7 @@ sub update_polar {
 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]);
@@ -223,7 +224,8 @@ sub plus {
 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;
@@ -231,6 +233,7 @@ sub minus {
        return $inverted ?
                (ref $z1)->make($re2 - $re1, $im2 - $im1) :
                (ref $z1)->make($re1 - $re2, $im1 - $im2);
+
 }
 
 #
@@ -241,8 +244,8 @@ sub minus {
 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;
@@ -251,11 +254,11 @@ sub multiply {
 }
 
 #
-# divbyzero
+# _divbyzero
 #
 # Die on division by zero.
 #
-sub divbyzero {
+sub _divbyzero {
     my $mess = "$_[0]: Division by zero.\n";
 
     if (defined $_[1]) {
@@ -279,31 +282,62 @@ sub divbyzero {
 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);
 }
 
 #
@@ -400,6 +434,21 @@ sub cbrt {
 }
 
 #
+# _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.
@@ -411,8 +460,7 @@ sub cbrt {
 #
 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;
@@ -549,7 +597,7 @@ sub sin {
 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;
 }
 
@@ -561,7 +609,7 @@ sub tan {
 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;
 }
 
@@ -573,7 +621,7 @@ sub sec {
 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;
 }
 
@@ -592,7 +640,7 @@ sub cosec { Math::Complex::csc(@_) }
 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;
 }
 
@@ -633,7 +681,7 @@ sub asin {
 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));
 }
 
@@ -644,7 +692,7 @@ sub atan {
 #
 sub asec {
        my ($z) = @_;
-       divbyzero "asec($z)", $z if ($z == 0);
+       _divbyzero "asec($z)", $z if ($z == 0);
        return acos(1 / $z);
 }
 
@@ -655,7 +703,7 @@ sub asec {
 #
 sub acsc {
        my ($z) = @_;
-       divbyzero "acsc($z)", $z if ($z == 0);
+       _divbyzero "acsc($z)", $z if ($z == 0);
        return asin(1 / $z);
 }
 
@@ -674,7 +722,7 @@ sub acosec { Math::Complex::acsc(@_) }
 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));
 }
 
@@ -692,10 +740,15 @@ sub acotan { Math::Complex::acot(@_) }
 #
 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);
 }
@@ -707,10 +760,15 @@ sub cosh {
 #
 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);
 }
@@ -723,7 +781,7 @@ sub sinh {
 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;
 }
 
@@ -735,7 +793,7 @@ sub tanh {
 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;
 }
 
@@ -747,7 +805,7 @@ sub sech {
 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;
 }
 
@@ -766,7 +824,7 @@ sub cosech { Math::Complex::csch(@_) }
 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;
 }
 
@@ -806,7 +864,7 @@ sub asinh {
 #
 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;
@@ -819,7 +877,7 @@ sub atanh {
 #
 sub asech {
        my ($z) = @_;
-       divbyzero 'asech(0)', $z if ($z == 0);
+       _divbyzero 'asech(0)', $z if ($z == 0);
        return acosh(1 / $z);
 }
 
@@ -830,7 +888,7 @@ sub asech {
 #
 sub acsch {
        my ($z) = @_;
-       divbyzero 'acsch(0)', $z if ($z == 0);
+       _divbyzero 'acsch(0)', $z if ($z == 0);
        return asinh(1 / $z);
 }
 
@@ -848,7 +906,7 @@ sub acosech { Math::Complex::acsch(@_) }
 #
 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;
@@ -1275,11 +1333,11 @@ The I<k>th root for C<z = [r,t]> is given by:
 
        (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
 
@@ -1413,8 +1471,8 @@ operation (for instance) between two overloaded entities.
 
 =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