--- loncom/xml/LCMathComplex.pm 2013/10/29 21:01:21 1.1 +++ loncom/xml/LCMathComplex.pm 2019/11/10 23:52:07 1.2 @@ -4,18 +4,40 @@ # -- Jarkko Hietaniemi Since Mar 1997 # -- Daniel S. Lewart Since Sep 1997 # -# -- Stuart Raeburn: renamed package as LCMathComplex Oct 2013 +# -- Stuart Raeburn: renamed package (rev. 1.55) as LCMathComplex Oct 2013 +# renamed package (rev. 1.59_01) as LCMathComplex Nov 2019 # with minor changes to allow use in Safe Space # package LONCAPA::LCMathComplex; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $Inf $ExpInf); +{ use 5.006; } +use strict; + +our $VERSION = 1.59_01; -$VERSION = 1.55; +our ($Inf, $ExpInf); +our ($vax_float, $has_inf, $has_nan); BEGIN { - my %DBL_MAX = + $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/); + $has_inf = !$vax_float; + $has_nan = !$vax_float; + + unless ($has_inf) { + # For example in vax, there is no Inf, + # and just mentioning the DBL_MAX (1.70141183460469229e+38) + # causes SIGFPE. + + # These are pretty useless without a real infinity, + # but setting them makes for less warnings about their + # undefined values. + $Inf = "Inf"; + $ExpInf = "Inf"; + return; + } + + my %DBL_MAX = # These are IEEE 754 maxima. ( 4 => '1.70141183460469229e+38', 8 => '1.7976931348623157e+308', @@ -25,8 +47,9 @@ BEGIN { 12 => '1.1897314953572317650857593266280070162E+4932', 16 => '1.1897314953572317650857593266280070162E+4932', ); + my $nvsize = 8; - die "LONCAPA::LCMathComplex: Could not figure out nvsize\n" + die "Math::Complex: Could not figure out nvsize\n" unless defined $nvsize; die "LONCAPA::LCMathComplex: Cannot not figure out max nv (nvsize = $nvsize)\n" unless defined $DBL_MAX{$nvsize}; @@ -37,7 +60,7 @@ BEGIN { if ($^O eq 'unicosmk') { $Inf = $DBL_MAX; } else { - local $SIG{FPE} = { }; + local $SIG{FPE} = sub { }; local $!; # We do want an arithmetic overflow, Inf INF inf Infinity. for my $t ( @@ -56,16 +79,17 @@ BEGIN { $Inf = $i; last; } - } + } $Inf = $DBL_MAX unless defined $Inf; # Oh well, close enough. die "LONCAPA::LCMathComplex: Could not get Infinity" unless $Inf > $BIGGER_THAN_THIS; - $ExpInf = exp(99999); - } + $ExpInf = eval 'exp(99999)'; + } # print "# On this machine, Inf = '$Inf'\n"; } -use strict; +use warnings; +no warnings 'syntax'; # To avoid the (_) warnings. my $i; my %LOGN; @@ -76,7 +100,7 @@ my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_ require Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); my @trig = qw( pi @@ -90,7 +114,7 @@ my @trig = qw( acsch acosech asech acoth acotanh ); -@EXPORT = (qw( +our @EXPORT = (qw( i Re Im rho theta arg sqrt log ln log10 logn cbrt root @@ -101,18 +125,24 @@ my @trig = qw( my @pi = qw(pi pi2 pi4 pip2 pip4 Inf); -@EXPORT_OK = @pi; +our @EXPORT_OK = @pi; -%EXPORT_TAGS = ( +our %EXPORT_TAGS = ( 'trig' => [@trig], 'pi' => [@pi], ); use overload + '=' => \&_copy, + '+=' => \&_plus, '+' => \&_plus, + '-=' => \&_minus, '-' => \&_minus, + '*=' => \&_multiply, '*' => \&_multiply, + '/=' => \&_divide, '/' => \&_divide, + '**=' => \&_power, '**' => \&_power, '==' => \&_numeq, '<=>' => \&_spaceship, @@ -124,7 +154,6 @@ use overload 'log' => \&log, 'sin' => \&sin, 'cos' => \&cos, - 'tan' => \&tan, 'atan2' => \&atan2, '""' => \&_stringify; @@ -165,9 +194,9 @@ sub _make { if (defined $p) { $p =~ s/^\+//; - $p =~ s/^(-?)inf$/"${1}9**9**9"/e; + $p =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf; $q =~ s/^\+//; - $q =~ s/^(-?)inf$/"${1}9**9**9"/e; + $q =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf; } return ($p, $q); @@ -190,13 +219,26 @@ sub _emake { if (defined $p) { $p =~ s/^\+//; $q =~ s/^\+//; - $p =~ s/^(-?)inf$/"${1}9**9**9"/e; - $q =~ s/^(-?)inf$/"${1}9**9**9"/e; + $p =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf; + $q =~ s/^(-?)inf$/"${1}9**9**9"/e if $has_inf; } return ($p, $q); } +sub _copy { + my $self = shift; + my $clone = {%$self}; + if ($self->{'cartesian'}) { + $clone->{'cartesian'} = [@{$self->{'cartesian'}}]; + } + if ($self->{'polar'}) { + $clone->{'polar'} = [@{$self->{'polar'}}]; + } + bless $clone,__PACKAGE__; + return $clone; +} + # # ->make # @@ -610,7 +652,7 @@ sub _conjugate { # Compute or set complex's norm (rho). # sub abs { - my ($z, $rho) = @_; + my ($z, $rho) = @_ ? @_ : $_; unless (ref $z) { if (@_ == 2) { $_[0] = $_[1]; @@ -671,7 +713,7 @@ sub arg { # Therefore if you want the two solutions use the root(). # sub sqrt { - my ($z) = @_; + my ($z) = @_ ? $_[0] : $_; my ($re, $im) = ref $z ? @{$z->_cartesian} : ($z, 0); return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) if $im == 0; @@ -804,9 +846,10 @@ sub theta { # Computes exp(z). # sub exp { - my ($z) = @_; - my ($x, $y) = @{$z->_cartesian}; - return (ref $z)->emake(CORE::exp($x), $y); + my ($z) = @_ ? @_ : $_; + return CORE::exp($z) unless ref $z; + my ($x, $y) = @{$z->_cartesian}; + return (ref $z)->emake(CORE::exp($x), $y); } # @@ -836,7 +879,7 @@ sub _logofzero { # Compute log(z). # sub log { - my ($z) = @_; + my ($z) = @_ ? @_ : $_; unless (ref $z) { _logofzero("log") if $z == 0; return $z > 0 ? CORE::log($z) : cplx(CORE::log(-$z), pi); @@ -884,7 +927,7 @@ sub logn { # Compute cos(z) = (exp(iz) + exp(-iz))/2. # sub cos { - my ($z) = @_; + my ($z) = @_ ? @_ : $_; return CORE::cos($z) unless ref $z; my ($x, $y) = @{$z->_cartesian}; my $ey = CORE::exp($y); @@ -901,7 +944,7 @@ sub cos { # Compute sin(z) = (exp(iz) - exp(-iz))/2. # sub sin { - my ($z) = @_; + my ($z) = @_ ? @_ : $_; return CORE::sin($z) unless ref $z; my ($x, $y) = @{$z->_cartesian}; my $ey = CORE::exp($y); @@ -1518,7 +1561,7 @@ sub _stringify_polar { if (defined $format) { $r = sprintf($format, $r); - $theta = sprintf($format, $theta) unless defined $theta; + $theta = sprintf($format, $t) unless defined $theta; } else { $theta = $t unless defined $theta; } @@ -1553,20 +1596,40 @@ Derived from Math::Complex. Modified for use in Safe Space in LON-CAPA by removing the dependency on Config.pm introduced in rev. 1.51 (which contains calls that are disallowed -in Safe Space). +in Safe Space). In addition, Scalar::Util::set_prototype() is not used for +abs(), cos(), exp(), log(), sin(), and sqrt(), to avoid warnings in logs: +of type: "Use of uninitialized value" (Config.pm line 62). In this LON-CAPA-specific version, the following code changes were made. 15,16d17 < use Config; -< -29,31c30 +< +49,51c50 < my $nvsize = $Config{nvsize} || < ($Config{uselongdouble} && $Config{longdblsize}) || < $Config{doublesize}; --- > my $nvsize = 8; +91,92d89 +< use Scalar::Util qw(set_prototype); +< +96,109d92 +< BEGIN { +< # For certain functions that we override, in 5.10 or better +< # we can set a smarter prototype that will handle the lexical $_ +< # (also a 5.10+ feature). +< if ($] >= 5.010000) { +< set_prototype \&abs, '_'; +< set_prototype \&cos, '_'; +< set_prototype \&exp, '_'; +< set_prototype \&log, '_'; +< set_prototype \&sin, '_'; +< set_prototype \&sqrt, '_'; +< } +< } + Note: the value assigned to $nvsize is 8 by default. Whenever ./UPDATE is run to install or update LON-CAPA, the code which @@ -2060,7 +2123,7 @@ messages like the following LONCAPA::LCMathComplex::make: Cannot take real part of ... LONCAPA::LCMathComplex::make: Cannot take real part of ... - LONCAPA::LCMathComplex:emake: Cannot take rho of ... + LONCAPA::LCMathComplex::emake: Cannot take rho of ... LONCAPA::LCMathComplex::emake: Cannot take theta of ... =head1 BUGS @@ -2084,9 +2147,10 @@ L =head1 AUTHORS -Daniel S. Lewart > -Jarkko Hietaniemi > -Raphael Manfredi > +Daniel S. Lewart >, +Jarkko Hietaniemi >, +Raphael Manfredi >, +Zefram =head1 LICENSE