# Package "privates"
#
-my $package = 'Math::Complex'; # Package name
-my $display = 'cartesian'; # Default display format
-my $eps = 1e-14; # Epsilon
+my $package = 'Math::Complex'; # Package name
+my %DISPLAY_FORMAT = ('style' => 'cartesian',
+ 'polar_pretty_print' => 1);
+my $eps = 1e-14; # Epsilon
#
# Object attributes (internal):
#
sub cplx {
my ($re, $im) = @_;
- return $package->make($re, defined $im ? $im : 0);
+ return __PACKAGE__->make($re, defined $im ? $im : 0);
}
#
#
sub cplxe {
my ($rho, $theta) = @_;
- return $package->emake($rho, defined $theta ? $theta : 0);
+ return __PACKAGE__->emake($rho, defined $theta ? $theta : 0);
}
#
my $u = CORE::atan2(CORE::sqrt(1-$beta*$beta), $beta);
my $v = CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
$v = -$v if $y > 0 || ($y == 0 && $x < -1);
- return $package->make($u, $v);
+ return __PACKAGE__->make($u, $v);
}
#
my $u = CORE::atan2($beta, CORE::sqrt(1-$beta*$beta));
my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1));
$v = -$v if $y > 0 || ($y == 0 && $x < -1);
- return $package->make($u, $v);
+ return __PACKAGE__->make($u, $v);
}
#
# display_format
# ->display_format
#
-# Set (fetch if no argument) display format for all complex numbers that
+# Set (get if no argument) the display format for all complex numbers that
# don't happen to have overridden it via ->display_format
#
-# When called as a method, this actually sets the display format for
+# When called as an object method, this actually sets the display format for
# the current object.
#
# Valid object formats are 'c' and 'p' for cartesian and polar. The first
# letter is used actually, so the type can be fully spelled out for clarity.
#
sub display_format {
- my $self = shift;
- my $format = undef;
+ my $self = shift;
+ my %display_format = %DISPLAY_FORMAT;
- if (ref $self) { # Called as a method
- $format = shift;
- } else { # Regular procedure call
- $format = $self;
- undef $self;
+ if (ref $self) { # Called as an object method
+ if (exists $self->{display_format}) {
+ my %obj = %{$self->{display_format}};
+ @display_format{keys %obj} = values %obj;
+ }
+ if (@_ == 1) {
+ $display_format{style} = shift;
+ } else {
+ my %new = @_;
+ @display_format{keys %new} = values %new;
+ }
+ } else { # Called as a class method
+ if (@_ = 1) {
+ $display_format{style} = $self;
+ } else {
+ my %new = @_;
+ @display_format{keys %new} = values %new;
+ }
+ undef $self;
}
if (defined $self) {
- return defined $self->{display} ? $self->{display} : $display
- unless defined $format;
- return $self->{display} = $format;
+ $self->{display_format} = { %display_format };
+ return
+ wantarray ?
+ %{$self->{display_format}} :
+ $self->{display_format}->{style};
}
- return $display unless defined $format;
- return $display = $format;
+ %DISPLAY_FORMAT = %display_format;
+ return
+ wantarray ?
+ %DISPLAY_FORMAT :
+ $DISPLAY_FORMAT{style};
}
#
#
sub stringify {
my ($z) = shift;
- my $format;
- $format = $display;
- $format = $z->{display} if defined $z->{display};
+ my $style = $z->display_format;
+
+ $style = $DISPLAY_FORMAT{style} unless defined $style;
- return $z->stringify_polar if $format =~ /^p/i;
+ return $z->stringify_polar if $style =~ /^p/i;
return $z->stringify_cartesian;
}
if int(CORE::abs($y)) != int(CORE::abs($y) + $eps);
$re = "$x" if CORE::abs($x) >= $eps;
- if ($y == 1) { $im = 'i' }
- elsif ($y == -1) { $im = '-i' }
- elsif (CORE::abs($y) >= $eps) { $im = $y . "i" }
+
+ my %format = $z->display_format;
+ my $format = $format{format};
+
+ if ($y == 1) { $im = 'i' }
+ elsif ($y == -1) { $im = '-i' }
+ elsif (CORE::abs($y) >= $eps) {
+ $im = (defined $format ? sprintf($format, $y) : $y) . "i";
+ }
my $str = '';
- $str = $re if defined $re;
- $str .= "+$im" if defined $im;
- $str =~ s/\+-/-/;
- $str =~ s/^\+//;
- $str =~ s/([-+])1i/$1i/; # Not redundant with the above 1/-1 tests.
- $str = '0' unless $str;
+ $str = defined $format ? sprintf($format, $re) : $re
+ if defined $re;
+ if (defined $im) {
+ if ($y < 0) {
+ $str .= $im;
+ } elsif ($y > 0) {
+ $str .= "+" if defined $re;
+ $str .= $im;
+ }
+ }
return $str;
}
return '[0,0]' if $r <= $eps;
+ my %format = $z->display_format;
+
my $nt = $t / pit2;
$nt = ($nt - int($nt)) * pit2;
$nt += pit2 if $nt < 0; # Range [0, 2pi]
$nt -= pit2 if $nt > pi;
- if (CORE::abs($nt) >= deg1) {
+ if ($format{polar_pretty_print} && CORE::abs($nt) >= deg1) {
my ($n, $k, $kpi);
for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) {
if ($theta !~ m(^-?\d*pi/\d+$) and
int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps));
+ my $format = $format{format};
+ if (defined $format) {
+ $r = sprintf($format, $r);
+ $theta = sprintf($format, $theta);
+ }
+
return "\[$r,$theta\]";
}
$x = cplxe(-3, pi/4);
-but that will be silently converted into C<[3,-3pi/4]>, since the modulus
-must be non-negative (it represents the distance to the origin in the complex
-plane).
+but that will be silently converted into C<[3,-3pi/4]>, since the
+modulus must be non-negative (it represents the distance to the origin
+in the complex plane).
It is also possible to have a complex number as either argument of
either the C<make> or C<emake>: the appropriate component of
=head1 STRINGIFICATION
When printed, a complex number is usually shown under its cartesian
-form I<a+bi>, but there are legitimate cases where the polar format
+style I<a+bi>, but there are legitimate cases where the polar style
I<[r,t]> is more appropriate.
-By calling the routine C<Math::Complex::display_format> and supplying either
-C<"polar"> or C<"cartesian">, you override the default display format,
-which is C<"cartesian">. Not supplying any argument returns the current
-setting.
+In the polar style Math::Complex will try to recognize certain common
+numbers such as multiples or small rationals of pi (2pi, pi/2) and
+prettyprint those numbers.
+
+By calling the class method C<Math::Complex::display_format> and
+supplying either C<"polar"> or C<"cartesian"> as an argument, you
+override the default display format, which is C<"cartesian">. Not
+supplying any argument returns the current settings.
This default can be overridden on a per-number basis by calling the
C<display_format> method instead. As before, not supplying any argument
use Math::Complex;
Math::Complex::display_format('polar');
- $j = ((root(1, 3))[1];
- print "j = $j\n"; # Prints "j = [1,2pi/3]
+ $j = (root(1, 3))[1];
+ print "j = $j\n"; # Prints "j = [1,2pi/3]"
$j->display_format('cartesian');
print "j = $j\n"; # Prints "j = -0.5+0.866025403784439i"
The polar format attempts to emphasize arguments like I<k*pi/n>
(where I<n> is a positive integer and I<k> an integer within [-9,+9]).
+=head2 CHANGED IN PERL 5.6
+
+The C<display_format> class method and the corresponding
+C<display_format> object method can now be called using
+a parameter hash instead of just a one parameter.
+
+The old display format style, which can have values C<"cartesian"> or
+C<"polar">, can be changed using the C<"style"> parameter. (The one
+parameter calling convention also still works.)
+
+There are two new display parameters.
+
+The first one is C<"format">, which is a sprintf()-style format
+string to be used for both parts of the complex number(s). The
+default is C<undef>, which corresponds usually (this is somewhat
+system-dependent) to C<"%.15g">. You can revert to the default by
+setting the format string to C<undef>.
+
+ # the $j from the above example
+
+ $j->display_format('format' => '%.5f');
+ print "j = $j\n"; # Prints "j = -0.50000+0.86603i"
+ $j->display_format('format' => '%.6f');
+ print "j = $j\n"; # Prints "j = -0.5+0.86603i"
+
+Notice that this affects also the return values of the
+C<display_format> methods: in list context the whole parameter hash
+will be returned, as opposed to only the style parameter value. If
+you want to know the whole truth for a complex number, you must call
+both the class method and the object method:
+
+The second new display parameter is C<"polar_pretty_print">, which can be
+set to true or false, the default being true. See above for what this
+means.
+
=head1 USAGE
Thanks to overloading, the handling of arithmetics with complex numbers
my $z = cplx( 1, 1);
$z->Re(2);
$z->Im(3);
+ print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
print 'not ' unless Re($z) == 2 and Im($z) == 3;
EOT
push(@script, qq(print "ok $test\\n"}\n));
{
my $z = cplx( 1, 1);
$z->abs(3 * sqrt(2));
+ print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
(arg($z) - pi / 4 ) < $eps and
(Re($z) - 3 ) < $eps and
{
my $z = cplx( 1, 1);
$z->arg(-3 / 4 * pi);
+ print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
(abs($z) - sqrt(2) ) < $eps and
(Re($z) + 1 ) < $eps and
sub test_dbz {
for my $op (@_) {
$test++;
-
push(@script, <<EOT);
-eval '$op';
-print 'not ' unless (\$@ =~ /Division by zero/);
+ eval '$op';
+ (\$bad) = (\$@ =~ /(.+)/);
+ print "# $test op = $op divbyzero? \$bad...\n";
+ print 'not ' unless (\$@ =~ /Division by zero/);
EOT
push(@script, qq(print "ok $test\\n";\n));
}
sub test_loz {
for my $op (@_) {
$test++;
-
push(@script, <<EOT);
-eval '$op';
-print 'not ' unless (\$@ =~ /Logarithm of zero/);
+ eval '$op';
+ (\$bad) = (\$@ =~ /(.+)/);
+ print "# $test op = $op logofzero? \$bad...\n";
+ print 'not ' unless (\$@ =~ /Logarithm of zero/);
EOT
push(@script, qq(print "ok $test\\n";\n));
}
sub test_broot {
for my $op (@_) {
$test++;
-
push(@script, <<EOT);
-eval 'root(2, $op)';
-print 'not ' unless (\$@ =~ /root must be/);
+ eval 'root(2, $op)';
+ (\$bad) = (\$@ =~ /(.+)/);
+ print "# $test op = $op badroot? \$bad...\n";
+ print 'not ' unless (\$@ =~ /root must be/);
EOT
push(@script, qq(print "ok $test\\n";\n));
}
test_broot(qw(-3 -2.1 0 0.99));
+sub test_display_format {
+ push @script, <<EOS;
+ my \$j = (root(1,3))[1];
+
+ \$j->display_format('polar');
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# display_format polar?\n";
+ print "not " unless \$j->display_format eq 'polar';
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# j = \$j\n";
+ print "not " unless "\$j" eq "[1,2pi/3]";
+ print "ok $test\n";
+
+ my %display_format;
+
+ %display_format = \$j->display_format;
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# display_format{style} polar?\n";
+ print "not " unless \$display_format{style} eq 'polar';
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# keys %display_format == 2?\n";
+ print "not " unless keys %display_format == 2;
+ print "ok $test\n";
+
+ \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# j = \$j\n";
+ print "not " unless "\$j" eq "-0.50000+0.86603i";
+ print "ok $test\n";
+
+ %display_format = \$j->display_format;
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# display_format{format} %.5f?\n";
+ print "not " unless \$display_format{format} eq '%.5f';
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# keys %display_format == 3?\n";
+ print "not " unless keys %display_format == 3;
+ print "ok $test\n";
+
+ \$j->display_format('format' => undef);
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# j = \$j\n";
+ print "not " unless "\$j" eq "-0.5+0.866025403784439i";
+ print "ok $test\n";
+
+ \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# j = \$j\n";
+ print "not " unless "\$j" eq "[1,2.0943951023932]";
+ print "ok $test\n";
+
+ \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
+EOS
+ $test++;
+ push @script, <<EOS;
+ print "# j = \$j\n";
+ print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
+ print "ok $test\n";
+EOS
+}
+
+test_display_format();
+
print "1..$test\n";
eval join '', @script;
die $@ if $@;
sub check {
my ($test, $try, $got, $expected, @z) = @_;
-# print "# @_\n";
+ print "# @_\n";
if ("$got" eq "$expected"
||
projects / p5sagit/p5-mst-13.2.git / commitdiff