home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / Math / Complex.pm < prev   
Text File  |  1994-10-18  |  3KB  |  137 lines
  1. #
  2. #  Perl5 Package for complex numbers
  3. #
  4. #  1994 by David Nadler
  5. #  Coding know-how provided by Tom Christiansen, Tim Bunce, and Larry Wall
  6. #    sqrt() added by Tom Christiansen; beware should have two roots, 
  7. #            but only returns one.  (use wantarray?)
  8. #  
  9. #
  10. # The functions "Re", "Im", and "arg" are provided.
  11. # "~" is used as the conjugation operator and "abs" is overloaded.
  12. #
  13. # Transcendental functions overloaded: so far only sin, cos, and exp.
  14. #  
  15.  
  16. package Math::Complex;
  17.  
  18. require Exporter;
  19.  
  20. @ISA = ('Exporter');
  21.  
  22. # just to make use happy
  23.  
  24. %OVERLOAD= (
  25.     '+'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
  26.                       bless [ $x1+$x2, $y1+$y2];
  27.              },
  28.  
  29.     '-'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
  30.                       bless [ $x1-$x2, $y1-$y2];
  31.              },
  32.  
  33.     '*'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
  34.                     bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1];
  35.              },
  36.  
  37.     '/'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
  38.                     my $q = $x2*$x2+$y2*$y2;
  39.                     bless [($x1*$x2+$y1*$y2)/$q, ($y1*$x2-$y2*$x1)/$q];
  40.              },
  41.  
  42.     'neg' => sub  { my($x,$y) = @{$_[0]}; bless [ -$x, -$y];
  43.              },
  44.  
  45.     '~'   => sub  { my($x,$y) = @{$_[0]}; bless [ $x, -$y];
  46.              },
  47.  
  48.     'abs'   => sub  { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y;
  49.              },
  50.  
  51.     'cos' => sub { my($x,$y) = @{$_[0]};
  52.                    my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
  53.                    my $abr = 1/(2*$ab); $ab /= 2;
  54.                    bless [ ($abr+$ab)*$c, ($abr-$ab)*$s];
  55.              },
  56.  
  57.     'sin' => sub { my($x,$y) = @{$_[0]};
  58.                    my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
  59.                    my $abr = 1/(2*$ab); $ab /= 2;
  60.                    bless [ (-$abr-$ab)*$s, ($abr-$ab)*$c];
  61.              },
  62.  
  63.     'exp' => sub { my($x,$y) = @{$_[0]};
  64.                    my ($ab,$c,$s) = (exp $x, cos $y, sin $y);
  65.                    bless [ $ab*$c, $ab*$s ];
  66.               },
  67.  
  68.     'sqrt' => sub { 
  69.     my($zr,$zi) = @{$_[0]};
  70.     my ($x, $y, $r, $w);
  71.     my $c = new Math::Complex (0,0);
  72.         if (($zr == 0) && ($zi == 0)) { 
  73.         # nothing, $c already set
  74.     }
  75.         else {
  76.       $x = abs($zr);
  77.       $y = abs($zi);
  78.       if ($x >= $y) { 
  79.           $r = $y/$x; 
  80.           $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r))); 
  81.       }
  82.       else { 
  83.           $r = $x/$y; 
  84.           $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r))); 
  85.       }
  86.       if ( $zr >= 0) { 
  87.           @$c = ($w, $zi/(2 * $w) ); 
  88.       }
  89.       else { 
  90.           $c->[1] = ($zi >= 0) ? $w : -$w;
  91.           $c->[0] = $zi/(2.0* $c->[1]); 
  92.       }
  93.         } 
  94.         return $c;
  95.       },
  96.  
  97.     qw("" stringify)
  98. );
  99.  
  100. sub new {
  101.     shift;
  102.     my @C = @_;
  103.     bless \@C;
  104. }
  105.  
  106. sub Re {
  107.     my($x,$y) = @{$_[0]};
  108.     $x;
  109. }
  110.  
  111. sub Im {
  112.     my($x,$y) = @{$_[0]};
  113.     $y;
  114. }
  115.  
  116. sub arg {
  117.     my($x,$y) = @{$_[0]};
  118.     atan2($y,$x);
  119. }
  120.  
  121. sub stringify {
  122.     my($x,$y) = @{$_[0]};
  123.     my($re,$im);
  124.  
  125.     $re = $x if ($x);
  126.     if ($y == 1) {$im = 'i';}  
  127.     elsif ($y == -1){$im = '-i';} 
  128.     elsif ($y) {$im = "${y}i"; }
  129.  
  130.     local $_ = $re.'+'.$im;
  131.     s/\+-/-/;
  132.     s/^\+//;
  133.     s/[\+-]$//;
  134.     $_ = 0 if ($_ eq '');
  135.     return $_;
  136. }
  137.