+package Math::BigFloat;
+
+#
+# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in Before and After
+#
+
# The following hash values are internally used:
# _e: exponent (BigInt)
# _m: mantissa (absolute BigInt)
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-package Math::BigFloat;
-
-$VERSION = '1.28';
+$VERSION = '1.29';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
ref($_[0])->bcmp($_[1],$_[0]) :
ref($_[0])->bcmp($_[0],$_[1])},
'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
-'log' => sub { $_[0]->blog() },
;
##############################################################################
my %hand_ups = map { $_ => 1 }
qw / is_nan is_inf is_negative is_positive
accuracy precision div_scale round_mode fneg fabs babs fnot
+ objectify
+ bone binf bnan bzero
/;
sub method_alias { return exists $methods{$_[0]||''}; }
$self->bnorm()->round(@r); # first normalize, then round
}
-sub bnan
+sub _bnan
{
- # create a bigfloat 'NaN', if given a BigFloat, set it to 'NaN'
+ # used by parent class bone() to initialize number to 1
my $self = shift;
- $self = $class if !defined $self;
- if (!ref($self))
- {
- my $c = $self; $self = {}; bless $self, $c;
- }
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bzero();
- $self->{sign} = $nan;
- $self->{_a} = undef; $self->{_p} = undef;
- $self;
}
-sub binf
+sub _binf
{
- # create a bigfloat '+-inf', if given a BigFloat, set it to '+-inf'
+ # used by parent class bone() to initialize number to 1
my $self = shift;
- my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
-
- $self = $class if !defined $self;
- if (!ref($self))
- {
- my $c = $self; $self = {}; bless $self, $c;
- }
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bzero();
- $self->{sign} = $sign.'inf';
- $self->{_a} = undef; $self->{_p} = undef;
- $self;
}
-sub bone
+sub _bone
{
- # create a bigfloat '+-1', if given a BigFloat, set it to '+-1'
+ # used by parent class bone() to initialize number to 1
my $self = shift;
- my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
-
- $self = $class if !defined $self;
- if (!ref($self))
- {
- my $c = $self; $self = {}; bless $self, $c;
- }
$self->{_m} = Math::BigInt->bone();
$self->{_e} = Math::BigInt->bzero();
- $self->{sign} = $sign;
- if (@_ > 0)
- {
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
- }
- return $self;
}
-sub bzero
+sub _bzero
{
- # create a bigfloat '+0', if given a BigFloat, set it to 0
+ # used by parent class bone() to initialize number to 1
my $self = shift;
- $self = $class if !defined $self;
- if (!ref($self))
- {
- my $c = $self; $self = {}; bless $self, $c;
- }
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bone();
- $self->{sign} = '+';
- if (@_ > 0)
- {
- $self->{_a} = $_[0]
- if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
- }
- return $self;
}
##############################################################################
{
# NaN first
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # inf handline
+ # inf handling
if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
{
- # + and + => +, - and - => -, + and - => 0, - and + => 0
- return $x->bzero() if $x->{sign} ne $y->{sign};
- return $x;
+ # +inf++inf or -inf+-inf => same, rest is NaN
+ return $x if $x->{sign} eq $y->{sign};
+ return $x->bnan();
}
# +-inf + something => +inf
# something +-inf => +-inf
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
-# return 1 if $x->{_m}->is_zero(); # 0e1 is even
return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never
&& $x->{_m}->is_even()); # but 1200 is
0;
# (BINT or num_str, BINT or num_str) return BINT
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- # print "mbf bmul $x->{_m}e$x->{_e} $y->{_m}e$y->{_e}\n";
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # handle result = 0
- return $x->bzero() if $x->is_zero() || $y->is_zero();
# inf handling
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
{
+ return $x->bnan() if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
+ # handle result = 0
+ return $x->bzero() if $x->is_zero() || $y->is_zero();
# aEb * cEd = (a*c)E(b+d)
$x->{_m}->bmul($y->{_m});
# (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- # x / +-inf => 0, reminder x
- return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
- if $y->{sign} =~ /^[+-]inf$/;
+ return $self->_div_inf($x,$y)
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
- # NaN if x == NaN or y == NaN or x==y==0
- return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if (($x->is_nan() || $y->is_nan()) ||
- ($x->is_zero() && $y->is_zero()));
-
- # 5 / 0 => +inf, -6 / 0 => -inf
- return wantarray
- ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
- if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
-
- # x== 0 or y == 1 or y == -1
+ # x== 0 # also: or y == 1 or y == -1
return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
+ # upgrade
+ return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
+
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my $scale = 0;
+package Math::BigInt;
+
+#
+# "Mike had an infinite amount to do and a negative amount of time in which
+# to do it." - Before and After
+#
+
# The following hash values are used:
# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
# sign : +,-,NaN,+inf,-inf
# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
# underlying lib might change the reference!
-package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.51';
+$VERSION = '1.52';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
}
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('bnan');
+ my $c = ref($self);
+ if ($self->can('_bnan'))
+ {
+ # use subclass to initialize
+ $self->_bnan();
+ }
+ else
+ {
+ # otherwise do our own thing
+ $self->{value} = $CALC->_zero();
+ }
$self->{value} = $CALC->_zero();
$self->{sign} = $nan;
delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
}
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('binf');
- $self->{value} = $CALC->_zero();
+ my $c = ref($self);
+ if ($self->can('_binf'))
+ {
+ # use subclass to initialize
+ $self->_binf();
+ }
+ else
+ {
+ # otherwise do our own thing
+ $self->{value} = $CALC->_zero();
+ }
$self->{sign} = $sign.'inf';
($self->{_a},$self->{_p}) = @_; # take over requested rounding
return $self;
}
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('bzero');
- $self->{value} = $CALC->_zero();
+
+ if ($self->can('_bzero'))
+ {
+ # use subclass to initialize
+ $self->_bzero();
+ }
+ else
+ {
+ # otherwise do our own thing
+ $self->{value} = $CALC->_zero();
+ }
$self->{sign} = '+';
if (@_ > 0)
{
}
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('bone');
- $self->{value} = $CALC->_one();
+
+ if ($self->can('_bone'))
+ {
+ # use subclass to initialize
+ $self->_bone();
+ }
+ else
+ {
+ # otherwise do our own thing
+ $self->{value} = $CALC->_one();
+ }
$self->{sign} = $sign;
if (@_ > 0)
{
{
# NaN first
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # inf handline
- if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ # inf handling
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
{
# +inf++inf or -inf+-inf => same, rest is NaN
return $x if $x->{sign} eq $y->{sign};
return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
}
- my $rem;
if (wantarray)
{
my $rem = $self->bzero();
$x->{value} = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
$x->round(@r);
- $x;
}
sub bmod
$mul *= $x65536 if $len >= 0; # skip last mul
}
}
- $x->{sign} = $sign if !$x->is_zero(); # no '-0'
- return $x;
+ $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
+ $x;
}
sub __from_bin
$$bs =~ s/([01])_([01])/$1$2/g;
return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
- my $mul = Math::BigInt->bzero(); $mul++;
- my $x256 = Math::BigInt->new(256);
-
my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
$$bs =~ s/^[+-]//; # strip sign
if ($CALC->can('_from_bin'))
}
else
{
+ my $mul = Math::BigInt->bzero(); $mul++;
+ my $x256 = Math::BigInt->new(256);
my $len = CORE::length($$bs)-2;
$len = int($len/8); # 8-digit parts, w/o '0b'
my $val; my $i = -8;
$mul *= $x256 if $len >= 0; # skip last mul
}
}
- $x->{sign} = $sign if !$x->is_zero();
- return $x;
+ $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
+ $x;
}
sub _split
$A, $P and $R are accuracy, precision and round_mode. Please see more in the
section about ACCURACY and ROUNDIND.
+=head2 accuracy
+
+ $x->accuracy(5); # local for $x
+ $class->accuracy(5); # global for all members of $class
+
+Set or get the global or local accuracy, aka how many significant digits the
+results have. Please see the section about L<ACCURACY AND PRECISION> for
+further details.
+
+Value must be greater than zero. Pass an undef value to disable it:
+
+ $x->accuracy(undef);
+ Math::BigInt->accuracy(undef);
+
+Returns the current accuracy. For C<$x->accuracy()> it will return either the
+local accuracy, or if not defined, the global. This means the return value
+represents the accuracy that will be in effect for $x:
+
+ $y = Math::BigInt->new(1234567); # unrounded
+ print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
+ $x = Math::BigInt->new(123456); # will be automatically rounded
+ print "$x $y\n"; # '123500 1234567'
+ print $x->accuracy(),"\n"; # will be 4
+ print $y->accuracy(),"\n"; # also 4, since global is 4
+ print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
+ print $x->accuracy(),"\n"; # still 4
+ print $y->accuracy(),"\n"; # 5, since global is 5
+
=head2 brsft
$x->brsft($y,$n);
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.22';
+$VERSION = '0.23';
# Package to store unsigned big integers in decimal and do math with them
if (@$x == 1 && @$yorg == 1)
{
- # shortcut, $y is smaller than $x
+ # shortcut, $yorg and $x are two small numbers
if (wantarray)
{
my $r = [ $x->[0] % $yorg->[0] ];
return $x;
}
}
+ #if (@$yorg == 1)
+ # {
+ # # shortcut, $y is < $BASE
+ #
+ # }
+
my $y = [ @$yorg ];
if ($LEN_CONVERT != 0)
if (@$x == 1 && @$yorg == 1)
{
- # shortcut, $y is smaller than $x
+ # shortcut, $yorg and $x are two small numbers
if (wantarray)
{
my $r = [ $x->[0] % $yorg->[0] ];
return $x;
}
}
+# if (@$yorg == 1)
+# {
+# # shortcut, $y is < $BASE
+#
+# }
my $y = [ @$yorg ];
if ($LEN_CONVERT != 0)
# convert a hex number to decimal (ref to string, return ref to array)
my ($c,$bs) = @_;
+ # instead of converting 8 bit at a time, it is faster to convert the
+ # number to hex, and then call _from_hex.
+
+ my $hs = $$bs;
+ $hs =~ s/^[+-]?0b//; # remove sign and 0b
+ my $l = length($hs); # bits
+ $hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0
+ my $h = unpack('H*', pack ('B*', $hs)); # repack as hex
+ return $c->_from_hex(\('0x'.$h));
+
my $mul = _one();
my $m = [ 0x100 ]; # 8 bit at a time
my $x = _zero();
}
print "# INC = @INC\n";
- plan tests => 1585;
+ plan tests => 1586;
}
use Math::BigInt lib => 'BareCalc';
$class->accuracy(undef); $class->precision(undef); # reset for further tests
+###############################################################################
+# can we call objectify (broken until v1.52)
+
+$try = '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);';
+$ans = eval $try;
+ok ($ans,"$class 4 5");
+
1; # all done
###############################################################################
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
-+inf:-inf:0
--inf:+inf:0
++inf:-inf:NaN
+-inf:+inf:NaN
+inf:+inf:inf
-inf:-inf:-inf
baddNaN:+inf:NaN
+0:abc:NaN
+inf:-inf:inf
-inf:+inf:-inf
-+inf:+inf:0
--inf:-inf:0
++inf:+inf:NaN
+-inf:-inf:NaN
baddNaN:+inf:NaN
baddNaN:+inf:NaN
+inf:baddNaN:NaN
}
print "# INC = @INC\n";
- plan tests => 1585;
+ plan tests => 1586;
}
use Math::BigInt;
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
-ok ($cfg->{lib_version},'0.22');
+ok ($cfg->{lib_version},'0.23');
ok ($cfg->{class},'Math::BigInt');
ok ($cfg->{upgrade}||'','');
ok ($cfg->{div_scale},40);
#!/usr/bin/perl -w
+# test inf/NaN handling all in one place
+# Thanx to Jarkko for the excellent explanations and the tables
+
use Test;
use strict;
BEGIN
{
- $| = 1;
- plan tests => 7*6*4;
+ $| = 1; # 7 values 6 groups 4 oprators 2 classes
+ plan tests => 7 * 6 * 4 * 2;
chdir 't' if -d 't';
unshift @INC, '../lib';
}
use Math::BigInt;
+use Math::BigFloat;
my (@args,$x,$y,$z);
/)
{
@args = split /:/,$_;
- $x = Math::BigInt->new($args[0]);
- $y = Math::BigInt->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $args[0] + $args[1] should be $args[2] but is ",$x->bstr(),"\n"
- if !ok ($x->badd($y)->bstr(),$args[2]);
+ for my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
+ print "# $class $args[0] + $args[1] should be $args[2] but is $x\n",
+ if !ok ($x->badd($y)->bstr(),$args[2]);
+ }
}
# -
/)
{
@args = split /:/,$_;
- $x = Math::BigInt->new($args[0]);
- $y = Math::BigInt->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $args[0] - $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bsub($y)->bstr(),$args[2]);
+ for my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
+ print "# $class $args[0] - $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bsub($y)->bstr(),$args[2]);
+ }
}
# *
/)
{
@args = split /:/,$_;
- $x = Math::BigInt->new($args[0]);
- $y = Math::BigInt->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $args[0] * $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bmul($y)->bstr(),$args[2]);
+ for my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
+ print "# $class $args[0] * $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bmul($y)->bstr(),$args[2]);
+ }
}
# /
/)
{
@args = split /:/,$_;
- $x = Math::BigInt->new($args[0]);
- $y = Math::BigInt->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- print "# $args[0] / $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bdiv($y)->bstr(),$args[2]);
-
+ for my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
+ print "# $class $args[0] / $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bdiv($y)->bstr(),$args[2]);
+ }
}
-
}
print "# INC = @INC\n";
- plan tests => 1585
+ plan tests => 1586
+ 4; # + 4 own tests
}
return $self;
}
+BEGIN
+ {
+ *objectify = \&Math::BigInt::objectify;
+ }
+
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff