2 # Perl5 Package for complex numbers
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?)
10 # The functions "Re", "Im", and "arg" are provided.
11 # "~" is used as the conjugation operator and "abs" is overloaded.
13 # Transcendental functions overloaded: so far only sin, cos, and exp.
16 package Math::Complex;
22 # just to make use happy
25 '+' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
26 bless [ $x1+$x2, $y1+$y2];
29 '-' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
30 bless [ $x1-$x2, $y1-$y2];
33 '*' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
34 bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1];
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];
42 'neg' => sub { my($x,$y) = @{$_[0]}; bless [ -$x, -$y];
45 '~' => sub { my($x,$y) = @{$_[0]}; bless [ $x, -$y];
48 'abs' => sub { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y;
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];
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];
63 'exp' => sub { my($x,$y) = @{$_[0]};
64 my ($ab,$c,$s) = (exp $x, cos $y, sin $y);
65 bless [ $ab*$c, $ab*$s ];
69 my($zr,$zi) = @{$_[0]};
71 my $c = new Math::Complex (0,0);
72 if (($zr == 0) && ($zi == 0)) {
73 # nothing, $c already set
80 $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r)));
84 $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r)));
87 @$c = ($w, $zi/(2 * $w) );
90 $c->[1] = ($zi >= 0) ? $w : -$w;
91 $c->[0] = $zi/(2.0* $c->[1]);
107 my($x,$y) = @{$_[0]};
112 my($x,$y) = @{$_[0]};
117 my($x,$y) = @{$_[0]};
122 my($x,$y) = @{$_[0]};
126 if ($y == 1) {$im = 'i';}
127 elsif ($y == -1){$im = '-i';}
128 elsif ($y) {$im = "${y}i"; }
130 local $_ = $re.'+'.$im;
134 $_ = 0 if ($_ eq '');