lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
+lib/Math/BigInt/t/bare_mbi.t Test Math::BigInt::CareCalc
lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t
lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works
lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works
pod/perl.pod Top level perl documentation
pod/perl5004delta.pod Changes from 5.003 to 5.004
pod/perl5005delta.pod Changes from 5.004 to 5.005
-pod/perl56delta.pod Changes from 5.005 to 5.6
pod/perl561delta.pod Changes from 5.6.0 to 5.6.1
+pod/perl56delta.pod Changes from 5.005 to 5.6
pod/perl570delta.pod Changes from 5.6 to 5.7.0
pod/perl571delta.pod Changes from 5.7.0 to 5.7.1
pod/perl572delta.pod Changes from 5.7.1 to 5.7.2
t/lib/locale/latin1 Part of locale.t in Latin 1
t/lib/locale/utf8 Part of locale.t in UTF8
t/lib/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test
+t/lib/Math/BigInt/BareCalc.pm Bigint's simulation of Calc
t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test
t/lib/sample-tests/bailout Test data for Test::Harness
t/lib/sample-tests/combined Test data for Test::Harness
# _a: accuracy
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-# _cow: Copy-On-Write (NRY)
package Math::BigFloat;
-$VERSION = '1.25';
+$VERSION = '1.26';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
@ISA = qw( Exporter Math::BigInt);
-# can not export bneg/babs since the are only in MBI
-@EXPORT_OK = qw(
- bcmp
- badd bmul bdiv bmod bnorm bsub
- bgcd blcm bround bfround
- bpow bnan bzero bfloor bceil
- bacmp bstr binc bdec binf
- is_odd is_even is_nan is_inf is_positive is_negative
- is_zero is_one sign
- );
-
-#@EXPORT = qw( );
+#@EXPORT_OK = qw(
+# bcmp
+# badd bmul bdiv bmod bnorm bsub
+# bgcd blcm bround bfround
+# bpow bnan bzero bfloor bceil
+# bacmp bstr binc bdec binf
+# is_odd is_even is_nan is_inf is_positive is_negative
+# is_zero is_one sign
+# );
+
use strict;
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
my $class = "Math::BigFloat";
# valid method aliases for AUTOLOAD
my %methods = map { $_ => 1 }
qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
- fneg fint facmp fcmp fzero fnan finf finc fdec
- fceil ffloor
+ fint facmp fcmp fzero fnan finf finc fdec
+ fceil ffloor frsft flsft fone
/;
# valid method's that need to be hand-ed up (for AUTOLOAD)
my %hand_ups = map { $_ => 1 }
qw / is_nan is_inf is_negative is_positive
- accuracy precision div_scale round_mode fabs babs
+ accuracy precision div_scale round_mode fneg fabs babs fnot
/;
sub method_alias { return exists $methods{$_[0]||''}; }
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bzero();
$self->{sign} = $nan;
+ ($self->{_a},$self->{_p}) = @_ if @_ > 0;
return $self;
}
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bzero();
$self->{sign} = $sign.'inf';
+ ($self->{_a},$self->{_p}) = @_ if @_ > 0;
return $self;
}
$self->{_m} = Math::BigInt->bone();
$self->{_e} = Math::BigInt->bzero();
$self->{sign} = $sign;
+ ($self->{_a},$self->{_p}) = @_ if @_ > 0;
return $self;
}
$self->{_m} = Math::BigInt->bzero();
$self->{_e} = Math::BigInt->bone();
$self->{sign} = '+';
+ ($self->{_a},$self->{_p}) = @_ if @_ > 0;
return $self;
}
##############################################################################
# public stuff (usually prefixed with "b")
-# really? Just for exporting them is not what I had in mind
-#sub babs
-# {
-# $class->SUPER::babs($class,@_);
-# }
-#sub bneg
-# {
-# $class->SUPER::bneg($class,@_);
-# }
-
# tels 2001-08-04
# todo: this must be overwritten and return NaN for non-integer values
# band(), bior(), bxor(), too
my $lx = $lxm + $x->{_e};
my $ly = $lym + $y->{_e};
# print "x $x y $y lx $lx ly $ly\n";
- my $l = $lx - $ly; # $l = -$l if $x->{sign} eq '-';
+ my $l = $lx - $ly;
# print "$l $x->{sign}\n";
return $l <=> 0 if $l != 0;
# lengths (corrected by exponent) are equal
- # so make mantissa euqal length by padding with zero (shift left)
+ # so make mantissa equal-length by padding with zero (shift left)
my $diff = $lxm - $lym;
my $xm = $x->{_m}; # not yet copy it
my $ym = $y->{_m};
$xm = $x->{_m}->copy()->blsft(-$diff,10);
}
my $rc = $xm->bcmp($ym);
- # $rc = -$rc if $x->{sign} eq '-'; # -124 < -123
return $rc <=> 0;
-
-# # signs are ignored, so check length
-# # length(x) is length(m)+e aka length of non-fraction part
-# # the longer one is bigger
-# my $l = $x->length() - $y->length();
-# #print "$l\n";
-# return $l if $l != 0;
-# #print "equal lengths\n";
-#
-# # if both are equal long, make full compare
-# # first compare only the mantissa
-# # if mantissa are equal, compare fractions
-#
-# return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
}
sub badd
}
# aEb * cEd = (a*c)E(b+d)
- $x->{_m} = $x->{_m} * $y->{_m};
- #print "m: $x->{_m}\n";
- $x->{_e} = $x->{_e} + $y->{_e};
- #print "e: $x->{_m}\n";
+ $x->{_m}->bmul($y->{_m});
+ $x->{_e}->badd($y->{_e});
# adjust sign:
$x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
- #print "s: $x->{sign}\n";
- $x->bnorm();
- return $x->round($a,$p,$r,$y);
+ return $x->bnorm()->round($a,$p,$r,$y);
}
sub bdiv
? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
- # promote BigInts and it's subclasses (except when already a BigFloat)
- $y = $self->new($y) unless $y->isa('Math::BigFloat');
-
- # old, broken way
- # $y = $class->new($y) if ref($y) ne $self; # promote bigints
+ # x== 0 or y == 1 or y == -1
+ return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
- # print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n";
# we need to limit the accuracy to protect against overflow
-
my $fallback = 0;
my $scale = 0;
-# print "s=$scale a=",$a||'undef'," p=",$p||'undef'," r=",$r||'undef',"\n";
my @params = $x->_find_round_parameters($a,$p,$r,$y);
# no rounding at all, so must use fallback
# enough...
$scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
}
- # print "s=$scale a=",$params[1]||'undef'," p=",$params[2]||'undef'," f=$fallback\n";
my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
$scale = $lx if $lx > $scale;
$scale = $ly if $ly > $scale;
-# print "scale $scale $lx $ly\n";
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
- return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
-
$x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
# check for / +-1 ( +/- 1E0)
- if ($y->is_one())
+ if (!$y->is_one())
{
- return wantarray ? ($x,$self->bzero()) : $x;
+ # promote BigInts and it's subclasses (except when already a BigFloat)
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # calculate the result to $scale digits and then round it
+ # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+ $x->{_m}->blsft($scale,10);
+ $x->{_m}->bdiv( $y->{_m} ); # a/c
+ $x->{_e}->bsub( $y->{_e} ); # b-d
+ $x->{_e}->bsub($scale); # correct for 10**scale
+ $x->bnorm(); # remove trailing 0's
}
- # calculate the result to $scale digits and then round it
- # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
- #$scale = 82;
- #print "self: $self x: $x ref(x) ", ref($x)," m: $x->{_m}\n";
- $x->{_m}->blsft($scale,10);
- #print "m: $x->{_m} $y->{_m}\n";
- $x->{_m}->bdiv( $y->{_m} ); # a/c
- #print "m: $x->{_m}\n";
- #print "e: $x->{_e} $y->{_e} ",$scale,"\n";
- $x->{_e}->bsub($y->{_e}); # b-d
- #print "e: $x->{_e}\n";
- $x->{_e}->bsub($scale); # correct for 10**scale
- #print "after div: m: $x->{_m} e: $x->{_e}\n";
- $x->bnorm(); # remove trailing 0's
- #print "after norm: m: $x->{_m} e: $x->{_e}\n";
-
# shortcut to not run trough _find_round_parameters again
if (defined $params[1])
{
if (wantarray)
{
- my $rem = $x->copy();
- $rem->bmod($y,$params[1],$params[2],$params[3]);
+ my $rem;
+ if (!$y->is_one())
+ {
+ $rem = $x->copy();
+ $rem->bmod($y,$params[1],$params[2],$params[3]);
+ }
+ else
+ {
+ $rem = $self->bzero();
+ }
if ($fallback)
{
# clear a/p after round, since user did not request it
return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN
return $x if $x->{sign} eq '+inf'; # +inf
- return $x if $x->is_zero() || $x == 1;
+ return $x if $x->is_zero() || $x->is_one();
# we need to limit the accuracy to protect against overflow (ignore $p)
my ($scale) = $x->_scale_a($self->accuracy(),$self->round_mode,$a,$r);
$a = $self->div_scale(); # and round to it
$fallback = 1; # to clear a/p afterwards
}
+ my $xas = $x->as_number();
+ my $gs = $xas->copy()->bsqrt(); # some guess
+ if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are
+ # digits after the dot
+ && ($xas->bcmp($gs * $gs) == 0)) # guess hit the nail on the head?
+ {
+ # exact result
+ $x->{_m} = $gs;
+ # leave alone if _e is already right
+ $x->{_e} = Math::BigInt->bzero();
+ return $x->bnorm()->round($a,$p,$r)
+ }
+ $gs = $self->new( $gs );
+
my $lx = $x->{_m}->length();
$scale = $lx if $scale < $lx;
- my $e = Math::BigFloat->new("1E-$scale"); # make test variable
+ my $e = $self->new("1E-$scale"); # make test variable
return $x->bnan() if $e->sign() eq 'NaN';
# start with some reasonable guess
- #$x *= 10 ** ($len - $org->{_e}); $x /= 2; # !?!?
- $lx = $lx+$x->{_e};
- $lx = 1 if $lx < 1;
- my $gs = Math::BigFloat->new('1'. ('0' x $lx));
-
-# print "first guess: $gs (x $x) scale $scale\n";
-
+# $lx = $lx+$x->{_e};
+# $lx = $lx / 2;
+# $lx = 1 if $lx < 1;
+ # my $gs = Math::BigFloat->new("1E$lx");
+
+# print "first guess: $gs (x $x) scale $scale\n";
+# # use BigInt:sqrt as reasonabe guess
+# print "second guess: $gs (x $x) scale $scale\n";
+
my $diff = $e;
my $y = $x->copy();
- my $two = Math::BigFloat->new(2);
+ my $two = $self->new(2);
# promote BigInts and it's subclasses (except when already a BigFloat)
$y = $self->new($y) unless $y->isa('Math::BigFloat');
- # old, broken way
- # $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts
my $rem;
- # $scale = 2;
+# my $steps = 0;
while ($diff >= $e)
{
- return $x->bnan() if $gs->is_zero();
- $rem = $y->copy(); $rem->bdiv($gs,$scale);
- #print "y $y gs $gs ($gs->{_a}) rem (y/gs)\n $rem\n";
- $x = ($rem + $gs);
- #print "x $x rem $rem gs $gs gsa: $gs->{_a}\n";
- $x->bdiv($two,$scale);
- #print "x $x (/2)\n";
+ # return $x->bnan() if $gs->is_zero();
+
+ $x = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale);
$diff = $x->copy()->bsub($gs)->babs();
$gs = $x->copy();
+# $steps++;
}
-# print "before $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
+# print "steps $steps\n";
$x->round($a,$p,$r);
-# print "after $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
if ($fallback)
{
# clear a/p after round, since user did not request it
return $x->bone() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
my $y1 = $y->as_number(); # make bigint (trunc)
- if ($x == -1)
+ # if ($x == -1)
+ if ($x->{sign} eq '-' && $x->{_m}->is_one() && $x->{_e}->is_zero())
{
# if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
return $y1->is_odd() ? $x : $x->babs(1);
return $x->round($a,$p,$r);
}
+sub brsft
+ {
+ # shift right by $y (divide by power of 2)
+ my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+
+ return $x if $x->modify('brsft');
+ return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
+
+ $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
+ $x->bdiv($n ** $y,$a,$p,$r,$y);
+ }
+
+sub blsft
+ {
+ # shift right by $y (divide by power of 2)
+ my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
+
+ return $x if $x->modify('brsft');
+ return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
+
+ $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
+ $x->bmul($n ** $y,$a,$p,$r,$y);
+ }
+
###############################################################################
sub DESTROY
require Carp;
Carp::croak ("Can't call a method without name");
}
- # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
if (!method_hand_up($name))
{
# delayed load of Carp and avoid recursion
# 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
$x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef;
$x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef;
- return $x; # MBI bnorm is no-op
+ return $x; # MBI bnorm is no-op, so dont call it
}
##############################################################################
sub as_number
{
- # return a bigint representation of this BigFloat number
- my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x);
+ # return copy as a bigint representation of this BigFloat number
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
my $z;
if ($x->{_e}->is_zero())
#!/usr/bin/perl -w
-# Qs: what exactly happens on numify of HUGE numbers? overflow?
-# $a = -$a is much slower (making copy of $a) than $a->bneg(), hm!?
-# (copy_on_write will help there, but that is not yet implemented)
-
# The following hash values are used:
# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
# sign : +,-,NaN,+inf,-inf
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.47';
+$VERSION = '1.48';
use Exporter;
@ISA = qw( Exporter );
-@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
- bgcd blcm bround
- blsft brsft band bior bxor bnot bpow bnan bzero
- bacmp bstr bsstr binc bdec binf bfloor bceil
- is_odd is_even is_zero is_one is_nan is_inf sign
- is_positive is_negative
- length as_number objectify _swap
+# no longer export stuff (it doesn't work with subclasses anyway)
+# bneg babs bcmp badd bmul bdiv bmod bnorm bsub
+# bgcd blcm bround
+# blsft brsft band bior bxor bnot bpow bnan bzero
+# bacmp bstr bsstr binc bdec binf bfloor bceil
+# is_odd is_even is_zero is_one is_nan is_inf sign
+# is_positive is_negative
+# length as_number
+@EXPORT_OK = qw(
+ objectify _swap
+ bgcd blcm
);
-#@EXPORT = qw( );
use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
use strict;
return unless ref($x); # only for objects
my $self = {}; bless $self,$c;
+ my $r;
foreach my $k (keys %$x)
{
if ($k eq 'value')
{
- $self->{value} = $CALC->_copy($x->{value});
+ $self->{value} = $CALC->_copy($x->{value}); next;
+ }
+ if (!($r = ref($x->{$k})))
+ {
+ $self->{$k} = $x->{$k}; next;
}
- elsif (ref($x->{$k}) eq 'SCALAR')
+ if ($r eq 'SCALAR')
{
$self->{$k} = \${$x->{$k}};
}
- elsif (ref($x->{$k}) eq 'ARRAY')
+ elsif ($r eq 'ARRAY')
{
$self->{$k} = [ @{$x->{$k}} ];
}
- elsif (ref($x->{$k}) eq 'HASH')
+ elsif ($r eq 'HASH')
{
# only one level deep!
foreach my $h (keys %{$x->{$k}})
$self->{$k}->{$h} = $x->{$k}->{$h};
}
}
- elsif (ref($x->{$k}))
+ else # normal ref
{
- my $c = ref($x->{$k});
- $self->{$k} = $c->new($x->{$k}); # no copy() due to deep rec
- }
- else
- {
- $self->{$k} = $x->{$k};
+ my $xk = $x->{$k};
+ if ($xk->can('copy'))
+ {
+ $self->{$k} = $xk->copy();
+ }
+ else
+ {
+ $self->{$k} = $xk->new($xk);
+ }
}
}
$self;
return if $self->modify('bnan');
$self->{value} = $CALC->_zero();
$self->{sign} = $nan;
+ delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
return $self;
}
return if $self->modify('binf');
$self->{value} = $CALC->_zero();
$self->{sign} = $sign.'inf';
+ ($self->{_a},$self->{_p}) = @_; # take over requested rounding
return $self;
}
return if $self->modify('bzero');
$self->{value} = $CALC->_zero();
$self->{sign} = '+';
+ ($self->{_a},$self->{_p}) = @_; # take over requested rounding
return $self;
}
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;
return if $self->modify('bone');
$self->{value} = $CALC->_one();
$self->{sign} = $sign;
+ ($self->{_a},$self->{_p}) = @_; # take over requested rounding
return $self;
}
sub numify
{
- # Make a number from a BigInt object
+ # Make a "normal" scalar from a BigInt object
my $x = shift; $x = $class->new($x) unless ref $x;
return $x->{sign} if $x->{sign} !~ /^[+-]$/;
my $num = $CALC->_num($x->{value});
# A and P settings.
# This does not yet handle $x with A, and $y with P (which should be an
# error).
- my $self = shift;
- my $a = shift; # accuracy, if given by caller
- my $p = shift; # precision, if given by caller
- my $r = shift; # round_mode, if given by caller
- my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops)
+ my ($self,$a,$p,$r,@args) = @_;
+ # $a accuracy, if given by caller
+ # $p precision, if given by caller
+ # $r round_mode, if given by caller
+ # @args all 'other' arguments (0 for unary, 1 for binary ops)
- $self = new($self) unless ref($self); # if not object, make one
- my $c = ref($self); # find out class of argument(s)
- unshift @args,$self; # add 'first' argument
+ # $self = new($self) unless ref($self); # if not object, make one
# leave bigfloat parts alone
return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+ unshift @args,$self; # add 'first' argument
+ my $c = ref($self); # find out class of argument(s)
no strict 'refs';
# now pick $a or $p, but only if we have got "arguments"
return $x if $x->modify('bneg');
# for +0 dont negate (to have always normalized)
return $x if $x->is_zero();
- $x->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $x->{sign} =~ tr/+-/-+/; # does nothing for NaN
$x;
}
$sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
- return $CALC->_is_one($x->{value});
+ $CALC->_is_one($x->{value});
}
sub is_odd
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return $CALC->_is_odd($x->{value});
+ $CALC->_is_odd($x->{value});
}
sub is_even
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return $CALC->_is_even($x->{value});
+ $CALC->_is_even($x->{value});
}
sub is_positive
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if $x->{sign} =~ /^\+/;
- return 0;
+ 0;
}
sub is_negative
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if ($x->{sign} =~ /^-/);
- return 0;
+ 0;
}
###############################################################################
my $xsign = $x->{sign}; # keep
$x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
# check for / +-1 (cant use $y->is_one due to '-'
- if (($y == 1) || ($y == -1)) # slow!
+ if ($CALC->_is_one($y->{value}))
{
return wantarray ? ($x,$self->bzero()) : $x;
}
- # call div here
- my $rem = $self->bzero();
- ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
- # do not leave result "-0";
- $x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $x->round($a,$p,$r,$y);
-
+ my $rem;
if (wantarray)
{
+ my $rem = $self->bzero();
+ ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value});
+ $x->round($a,$p,$r,$y);
if (! $CALC->_is_zero($rem->{value}))
{
$rem->{sign} = $y->{sign};
$rem->round($a,$p,$r,$x,$y);
return ($x,$rem);
}
- return $x;
+
+ $x->{value} = $CALC->_div($x->{value},$y->{value});
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value});
+ $x->round($a,$p,$r,$y);
}
sub bmod
{
$x = (&bdiv($self,$x,$y))[1]; # slow way
}
- $x->bround($a,$p,$r);
+ $x->round($a,$p,$r);
}
sub bpow
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
return $x->__one() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
- #if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1)
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
# if $x == -1 and odd/even y => +1/-1
return $x if $x->modify('band');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- return $x->bzero() if $y->is_zero();
+ return $x->bzero() if $y->is_zero() || $x->is_zero();
my $sign = 0; # sign of result
$sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
return $x->round($a,$p,$r);
}
- my $m = new Math::BigInt 1; my ($xr,$yr);
+ my $m = Math::BigInt->bone(); my ($xr,$yr);
my $x10000 = new Math::BigInt (0x1000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
return $x->round($a,$p,$r);
}
- my $m = new Math::BigInt 1; my ($xr,$yr);
- my $x10000 = new Math::BigInt (0x10000);
+ my $m = Math::BigInt->bone(); my ($xr,$yr);
+ my $x10000 = Math::BigInt->new(0x10000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x if $y->is_zero();
- return $x->bzero() if $x == $y; # shortcut
my $sign = 0; # sign of result
$sign = 1 if $x->{sign} ne $y->{sign};
return $x->round($a,$p,$r);
}
- my $m = new Math::BigInt 1; my ($xr,$yr);
- my $x10000 = new Math::BigInt (0x10000);
+ my $m = $self->bone(); my ($xr,$yr);
+ my $x10000 = Math::BigInt->new(0x10000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
sub bsqrt
{
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN
- return $x->bzero() if $x->is_zero(); # 0 => 0
- return $x if $x == 1; # 1 => 1
+ return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
+ return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
+ return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
+ return $x->bone($a,$p) if $x < 4; # 2,3 => 1
- my $y = $x->copy(); # give us one more digit accur.
+ if ($CALC->can('_sqrt'))
+ {
+ $x->{value} = $CALC->_sqrt($x->{value});
+ return $x->round($a,$p,$r);
+ }
+
+ my $y = $x->copy();
my $l = int($x->length()/2);
- $x->bzero();
- $x->binc(); # keep ref($x), but modify it
- $x *= 10 ** $l;
-
- # print "x: $y guess $x\n";
+ $x->bone(); # keep ref($x), but modify it
+ $x->blsft($l,10);
my $last = $self->bzero();
- while ($last != $x)
+ my $two = $self->new(2);
+ my $lastlast = $x+$two;
+ while ($last != $x && $lastlast != $x)
{
- $last = $x;
+ $lastlast = $last; $last = $x;
$x += $y / $x;
- $x /= 2;
+ $x /= $two;
}
- return $x;
+ $x-- if $x * $x > $y; # overshot?
+ return $x->round($a,$p,$r);
}
sub exponent
# args, hence the copy().
# You can override this method in a subclass, the overload section will call
# $object->_swap() to make sure it arrives at the proper subclass, with some
- # exceptions like '+' and '-'.
+ # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
+ # specify your own overload for them.
# object, (object|scalar) => preserve first and make copy
# scalar, object => swapped, re-swap and create new from first
# (using class of second object, not $class!!)
my $self = shift; # for override in subclass
- #print "swap $self 0:$_[0] 1:$_[1] 2:$_[2]\n";
if ($_[2])
{
my $c = ref ($_[0]) || $class; # fallback $class should not happen
my $hs = shift;
my $x = Math::BigInt->bzero();
+
+ # strip underscores
+ $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+ $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+
return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
my $bs = shift;
my $x = Math::BigInt->bzero();
+ # strip underscores
+ $$bs =~ s/([01])_([01])/$1$2/g;
+ $$bs =~ s/([01])_([01])/$1$2/g;
return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
my $mul = Math::BigInt->bzero(); $mul++;
$val = substr($$bs,$i,8);
$val =~ s/^[+-]?0b// if $len == 0; # for last part only
#$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
- $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
- $val = ord(pack('B8',$val));
- # print "$val ",substr($$bs,$i,16),"\n";
+ # slower:
+ # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
+ $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
$i -= 8; $len --;
$x += $mul * $val if $val != 0;
$mul *= $x256 if $len >= 0; # skip last mul
# invalid starting char?
return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
- $$x =~ s/(\d)_(\d)/$1$2/g; # strip underscores between digits
- $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
-
return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+
+ # strip underscores between digits
+ $$x =~ s/(\d)_(\d)/$1$2/g;
+ $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
# some possible inputs:
# 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
=head1 EXAMPLES
- use Math::BigInt qw(bstr);
+ use Math::BigInt;
sub bint { Math::BigInt->new(shift); }
- $x = bstr("1234") # string "1234"
+ $x = Math::BigInt->bstr("1234") # string "1234"
$x = "$x"; # same as bstr()
- $x = bneg("1234") # Bigint "-1234"
$x = Math::BigInt->bneg("1234"); # Bigint "-1234"
$x = Math::BigInt->babs("-12345"); # Bigint "12345"
$x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
$x = $x + 5 / 2; # BigInt "3"
$x = $x ** 3; # BigInt "27"
$x *= 2; # BigInt "54"
- $x = new Math::BigInt; # BigInt "0"
+ $x = Math::BigInt->new(0); # BigInt "0"
$x--; # BigInt "-1"
$x = Math::BigInt->badd(4,5) # BigInt "9"
- $x = Math::BigInt::badd(4,5) # BigInt "9"
print $x->bsstr(); # 9e+0
Examples for rounding:
$x = Math::BigFloat->new(123.4567);
$y = Math::BigFloat->new(123.456789);
- $Math::BigFloat::accuracy = 4; # no more A than 4
+ Math::BigFloat->accuracy(4); # no more A than 4
ok ($x->copy()->fround(),123.4); # even rounding
print $x->copy()->fround(),"\n"; # 123.4
Math::BigFloat->round_mode('odd'); # round to odd
print $x->copy()->fround(),"\n"; # 123.5
- $Math::BigFloat::accuracy = 5; # no more A than 5
+ Math::BigFloat->accuracy(5); # no more A than 5
Math::BigFloat->round_mode('odd'); # round to odd
print $x->copy()->fround(),"\n"; # 123.46
$y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
- $Math::BigFloat::accuracy = undef; # A not important
- $Math::BigFloat::precision = 2; # P important
- print $x->copy()->bnorm(),"\n"; # 123.46
- print $x->copy()->fround(),"\n"; # 123.46
+ Math::BigFloat->accuracy(undef); # A not important now
+ Math::BigFloat->precision(2); # P important
+ print $x->copy()->bnorm(),"\n"; # 123.46
+ print $x->copy()->fround(),"\n"; # 123.46
Examples for converting:
+ '123456789123456789';
do not work. You need an explicit Math::BigInt->new() around one of the
-operands.
+operands. You should also quote large constants to protect loss of precision:
+
+ use Math::Bigint;
+
+ $x = Math::BigInt->new('1234567889123456789123456789123456789');
+
+Without the quotes Perl would convert the large number to a floating point
+constant at compile time and then hand the result to BigInt, which results in
+an truncated result or a NaN.
=head1 PERFORMANCE
more time then the actual addition.
With a technique called copy-on-write, the cost of copying with overload could
-be minimized or even completely avoided. This is currently not implemented.
+be minimized or even completely avoided. A test implementation of COW did show
+performance gains for overloaded math, but introduced a performance loss due
+to a constant overhead for all other operatons.
+
+The rewritten version of this module is slower on certain operations, like
+new(), bstr() and numify(). The reason are that it does now more work and
+handles more cases. The time spent in these operations is usually gained in
+the other operations so that programs on the average should get faster. If
+they don't, please contect the author.
-The new version of this module is slower on new(), bstr() and numify(). Some
-operations may be slower for small numbers, but are significantly faster for
-big numbers. Other operations are now constant (O(1), like bneg(), babs()
-etc), instead of O(N) and thus nearly always take much less time.
+Some operations may be slower for small numbers, but are significantly faster
+for big numbers. Other operations are now constant (O(1), like bneg(), babs()
+etc), instead of O(N) and thus nearly always take much less time. These
+optimizations were done on purpose.
If you find the Calc module to slow, try to install any of the replacement
modules and see if they help you.
use Math::BigInt lib => 'Module';
-The default is called Math::BigInt::Calc and is a pure-perl implementation
-that consists mainly of the standard routine present in earlier versions of
-Math::BigInt.
-
-There are also Math::BigInt::Scalar (primarily for testing) and
-Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
-All these can be found via L<http://search.cpan.org/>:
-
- use Math::BigInt lib => 'BitVect';
-
- my $x = Math::BigInt->new(2);
- print $x ** (1024*1024);
+See L<MATH LIBRARY> for more information.
-For more benchmark results see http://bloodgate.com/perl/benchmarks.html
+For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
=head1 BUGS
$y = Math::BigInt->new($y);
ok ($x,$y); # okay
-There is not yet a way to get a number automatically represented in exactly
-the way Perl represents it.
+Alternatively, simple use <=> for comparisations, that will get it always
+right. There is not yet a way to get a number automatically represented as
+a string that matches exactly the way Perl represents it.
=item int()
needs to preserve $x since it does not know that it later will get overwritten.
This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
-With Copy-On-Write, this issue will be gone. Stay tuned...
+With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
+since it is slower for all other things.
=item Mixing different object types
$integer = $mbi2 / $mbf; # $mbi2->bdiv()
This is because math with overloaded operators follows the first (dominating)
-operand, this one's operation is called and returns thus the result. So,
+operand, and the operation of that is called and returns thus the result. So,
Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
the result should be a Math::BigFloat or the second operant is one.
=item bsqrt()
-C<bsqrt()> works only good if the result is an big integer, e.g. the square
+C<bsqrt()> works only good if the result is a big integer, e.g. the square
root of 144 is 12, but from 12 the square root is 3, regardless of rounding
mode.
If you want a better approximation of the square root, then use:
$x = Math::BigFloat->new(12);
- $Math::BigFloat::precision = 0;
+ Math::BigFloat->precision(0);
Math::BigFloat->round_mode('even');
print $x->copy->bsqrt(),"\n"; # 4
- $Math::BigFloat::precision = 2;
+ Math::BigFloat->precision(2);
print $x->bsqrt(),"\n"; # 3.46
print $x->bsqrt(3),"\n"; # 3.464
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.16';
+$VERSION = '0.17';
# Package to store unsigned big integers in decimal and do math with them
# constants for easier life
my $nan = 'NaN';
-my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL);
+my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2);
+my ($AND_BITS,$XOR_BITS,$OR_BITS);
+my ($AND_MASK,$XOR_MASK,$OR_MASK);
sub _base_len
{
# set/get the BASE_LEN and assorted other, connected values
# used only be the testsuite, set is used only by the BEGIN block below
+ shift;
+
my $b = shift;
if (defined $b)
{
- $b = 8 if $b > 8; # cap, for VMS, OS/390 and other 64 bit
- $BASE_LEN = $b;
+ $b = 5 if $^O =~ /^uts/; # UTS needs 5, because 6 and 7 break
+ $BASE_LEN = $b+1;
+ my $caught;
+ while (--$BASE_LEN > 5)
+ {
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ $caught = 0;
+ $caught += 1 if (int($BASE * $RBASE) != 1); # should be 1
+ $caught += 2 if (int($BASE / $BASE) != 1); # should be 1
+ # print "caught $caught\n";
+ last if $caught != 3;
+ }
$BASE = int("1e".$BASE_LEN);
- $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
$MAX_VAL = $BASE-1;
- # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL\n";
- # print "int: ",int($BASE * $RBASE),"\n";
- if (int($BASE * $RBASE) == 0) # should be 1
+ $BASE_LEN2 = int($BASE_LEN / 2); # for mul shortcut
+ # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE\n";
+
+ if ($caught & 1 != 0)
{
# must USE_MUL
*{_mul} = \&_mul_use_mul;
*{_div} = \&_div_use_mul;
}
- else
+ else # $caught must be 2, since it can't be 1 nor 3
{
# can USE_DIV instead
*{_mul} = \&_mul_use_div;
*{_div} = \&_div_use_div;
}
}
+ if (wantarray)
+ {
+ return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS);
+ }
$BASE_LEN;
}
do
{
$num = ('9' x ++$e) + 0;
- $num *= $num + 1;
+ $num *= $num + 1.0;
# print "$num $e\n";
- } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern
- # last test failed, so retract one step:
- _base_len($e-1);
+ } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern
+ $e--; # last test failed, so retract one step
+ # the limits below brush the problems with the test above under the rug:
+ # the test should be able to find the proper $e automatically
+ $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment
+ $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work
+ # there, but we play safe)
+ $e = 8 if $e > 8; # cap, for VMS, OS/390 and other 64 bit systems
+
+ __PACKAGE__->_base_len($e); # set and store
+
+ # find out how many bits _and, _or and _xor can take (old default = 16)
+ # I don't think anybody has yet 128 bit scalars, so let's play safe.
+ use integer;
+ local $^W = 0; # don't warn about 'nonportable number'
+ $AND_BITS = 15; $XOR_BITS = 15; $OR_BITS = 15;
+
+ # find max bits, we will not go higher than numberofbits that fit into $BASE
+ # to make _and etc simpler (and faster for smaller, slower for large numbers)
+ my $max = 16;
+ while (2 ** $max < $BASE) { $max++; }
+ my ($x,$y,$z);
+ do {
+ $AND_BITS++;
+ $x = oct('0b' . '1' x $AND_BITS); $y = $x & $x;
+ $z = (2 ** $AND_BITS) - 1;
+ } while ($AND_BITS < $max && $x == $z && $y == $x);
+ $AND_BITS --; # retreat one step
+ do {
+ $XOR_BITS++;
+ $x = oct('0b' . '1' x $XOR_BITS); $y = $x ^ 0;
+ $z = (2 ** $XOR_BITS) - 1;
+ } while ($XOR_BITS < $max && $x == $z && $y == $x);
+ $XOR_BITS --; # retreat one step
+ do {
+ $OR_BITS++;
+ $x = oct('0b' . '1' x $OR_BITS); $y = $x | $x;
+ $z = (2 ** $OR_BITS) - 1;
+ } while ($OR_BITS < $max && $x == $z && $y == $x);
+ $OR_BITS --; # retreat one step
+
+ # print "AND $AND_BITS XOR $XOR_BITS OR $OR_BITS\n";
}
##############################################################################
sub _new
{
- # (string) return ref to num_array
+ # (ref to string) return ref to num_array
# Convert a number from string format to internal base 100000 format.
# Assumes normalized value as input.
my $d = $_[1];
return [ reverse(unpack("a" . ($il % $BASE_LEN+1)
. ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
}
+
+BEGIN
+ {
+ $AND_MASK = __PACKAGE__->_new( \( 2 ** $AND_BITS ));
+ $XOR_MASK = __PACKAGE__->_new( \( 2 ** $XOR_BITS ));
+ $OR_MASK = __PACKAGE__->_new( \( 2 ** $OR_BITS ));
+ }
sub _zero
{
$i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++;
}
# might leave leading zeros, so fix that
- __strip_zeros($sx);
- return $sx;
+ return __strip_zeros($sx);
}
- else
+ #print "case 1 (swap)\n";
+ for $i (@$sx)
{
- #print "case 1 (swap)\n";
- for $i (@$sx)
- {
- last unless defined $sy->[$j] || $car;
- $sy->[$j] += $BASE
- if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0);
- $j++;
- }
- # might leave leading zeros, so fix that
- __strip_zeros($sy);
- return $sy;
+ last unless defined $sy->[$j] || $car;
+ $sy->[$j] += $BASE
+ if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0);
+ $j++;
}
+ # might leave leading zeros, so fix that
+ __strip_zeros($sy);
}
sub _mul_use_mul
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
+ # shortcut for two very short numbers
+ # +0 since part maybe string '00001' from new()
+ if ((@$xv == 1) && (@$yv == 1)
+ && (length($xv->[0]+0) <= $BASE_LEN2)
+ && (length($yv->[0]+0) <= $BASE_LEN2))
+ {
+ $xv->[0] *= $yv->[0];
+ return $xv;
+ }
+
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if "$xv" eq "$yv"; # same references?
}
push @$xv, @prod;
__strip_zeros($xv);
- # normalize (handled last to save check for $y->is_zero()
- return $xv;
}
sub _mul_use_div
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
+ # shortcut for two very short numbers
+ # +0 since part maybe string '00001' from new()
+ if ((@$xv == 1) && (@$yv == 1)
+ && (length($xv->[0]+0) <= $BASE_LEN2)
+ && (length($yv->[0]+0) <= $BASE_LEN2))
+ {
+ $xv->[0] *= $yv->[0];
+ return $xv;
+ }
+
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if "$xv" eq "$yv"; # same references?
}
push @$xv, @prod;
__strip_zeros($xv);
- # normalize (handled last to save check for $y->is_zero()
- return $xv;
}
sub _div_use_mul
{
# ref to array, ref to array, modify first array and return remainder if
# in list context
- # no longer handles sign
my ($c,$x,$yorg) = @_;
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
@$x = @q;
__strip_zeros($x);
__strip_zeros(\@d);
+ _check('',$x);
+ _check('',\@d);
return ($x,\@d);
}
@$x = @q;
__strip_zeros($x);
- return $x;
+ _check('',$x);
}
sub _div_use_div
{
# ref to array, ref to array, modify first array and return remainder if
# in list context
- # no longer handles sign
my ($c,$x,$yorg) = @_;
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
}
@$x = @q;
__strip_zeros($x);
- return $x;
}
+##############################################################################
+# testing
+
+sub _acmp
+ {
+ # internal absolute post-normalized compare (ignore signs)
+ # ref to array, ref to array, return <0, 0, >0
+ # arrays must have at least one entry; this is not checked for
+
+ my ($c,$cx,$cy) = @_;
+
+ # fat comp based on array elements
+ my $lxy = scalar @$cx - scalar @$cy;
+ return -1 if $lxy < 0; # already differs, ret
+ return 1 if $lxy > 0; # ditto
+
+ # now calculate length based on digits, not parts
+ $lxy = _len($c,$cx) - _len($c,$cy); # difference
+ return -1 if $lxy < 0;
+ return 1 if $lxy > 0;
+
+ # hm, same lengths, but same contents?
+ my $i = 0; my $a;
+ # first way takes 5.49 sec instead of 4.87, but has the early out advantage
+ # so grep is slightly faster, but more inflexible. hm. $_ instead of $k
+ # yields 5.6 instead of 5.5 sec huh?
+ # manual way (abort if unequal, good for early ne)
+ my $j = scalar @$cx - 1;
+ while ($j >= 0)
+ {
+ last if ($a = $cx->[$j] - $cy->[$j]); $j--;
+ }
+ return 1 if $a > 0;
+ return -1 if $a < 0;
+ return 0; # equal
+ # while it early aborts, it is even slower than the manual variant
+ #grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
+ # grep way, go trough all (bad for early ne)
+ #grep { $a = $_ - $cy->[$i++]; } @$cx;
+ #return $a;
+ }
+
+sub _len
+ {
+ # compute number of digits in bigint, minus the sign
+
+ # int() because add/sub sometimes leaves strings (like '00005') instead of
+ # '5' in this place, thus causing length() to report wrong length
+ my $cx = $_[1];
+
+ return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
+ }
+
+sub _digit
+ {
+ # return the nth digit, negative values count backward
+ # zero is rightmost, so _digit(123,0) will give 3
+ my ($c,$x,$n) = @_;
+
+ my $len = _len('',$x);
+
+ $n = $len+$n if $n < 0; # -1 last, -2 second-to-last
+ $n = abs($n); # if negative was too big
+ $len--; $n = $len if $n > $len; # n to big?
+
+ my $elem = int($n / $BASE_LEN); # which array element
+ my $digit = $n % $BASE_LEN; # which digit in this element
+ $elem = '0000'.@$x[$elem]; # get element padded with 0's
+ return substr($elem,-$digit-1,1);
+ }
+
+sub _zeros
+ {
+ # return amount of trailing zeros in decimal
+ # check each array elem in _m for having 0 at end as long as elem == 0
+ # Upon finding a elem != 0, stop
+ my $x = $_[1];
+ my $zeros = 0; my $elem;
+ foreach my $e (@$x)
+ {
+ if ($e != 0)
+ {
+ $elem = "$e"; # preserve x
+ $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
+ $zeros *= $BASE_LEN; # elems * 5
+ $zeros += CORE::length($elem); # count trailing zeros
+ last; # early out
+ }
+ $zeros ++; # real else branch: 50% slower!
+ }
+ return $zeros;
+ }
+
+##############################################################################
+# _is_* routines
+
+sub _is_zero
+ {
+ # return true if arg (BINT or num_str) is zero (array '+', '0')
+ my $x = $_[1];
+ return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
+ }
+
+sub _is_even
+ {
+ # return true if arg (BINT or num_str) is even
+ my $x = $_[1];
+ return (!($x->[0] & 1)) <=> 0;
+ }
+
+sub _is_odd
+ {
+ # return true if arg (BINT or num_str) is even
+ my $x = $_[1];
+ return (($x->[0] & 1)) <=> 0;
+ }
+
+sub _is_one
+ {
+ # return true if arg (BINT or num_str) is one (array '+', '1')
+ my $x = $_[1];
+ return (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
+ }
+
+sub __strip_zeros
+ {
+ # internal normalization function that strips leading zeros from the array
+ # args: ref to array
+ my $s = shift;
+
+ my $cnt = scalar @$s; # get count of parts
+ my $i = $cnt-1;
+ push @$s,0 if $i < 0; # div might return empty results, so fix it
+
+ #print "strip: cnt $cnt i $i\n";
+ # '0', '3', '4', '0', '0',
+ # 0 1 2 3 4
+ # cnt = 5, i = 4
+ # i = 4
+ # i = 3
+ # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
+ # >= 1: skip first part (this can be zero)
+ while ($i > 0) { last if $s->[$i] != 0; $i--; }
+ $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
+ $s;
+ }
+
+###############################################################################
+# check routine to test internal state of corruptions
+
+sub _check
+ {
+ # used by the test suite
+ my $x = $_[1];
+
+ return "$x is not a reference" if !ref($x);
+
+ # are all parts are valid?
+ my $i = 0; my $j = scalar @$x; my ($e,$try);
+ while ($i < $j)
+ {
+ $e = $x->[$i]; $e = 'undef' unless defined $e;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)";
+ last if $e !~ /^[+]?[0-9]+$/;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)";
+ last if "$e" !~ /^[+]?[0-9]+$/;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)";
+ last if '' . "$e" !~ /^[+]?[0-9]+$/;
+ $try = ' < 0 || >= $BASE; '."($x, $e)";
+ last if $e <0 || $e >= $BASE;
+ # this test is disabled, since new/bnorm and certain ops (like early out
+ # in add/sub) are allowed/expected to leave '00000' in some elements
+ #$try = '=~ /^00+/; '."($x, $e)";
+ #last if $e =~ /^00+/;
+ $i++;
+ }
+ return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
+ return 0;
+ }
+
+
+###############################################################################
+###############################################################################
+# some optional routines to make BigInt faster
+
sub _mod
{
# if possible, use mod shortcut
return $cx;
}
-##############################################################################
-# testing
-
-sub _acmp
+sub _sqrt
{
- # internal absolute post-normalized compare (ignore signs)
- # ref to array, ref to array, return <0, 0, >0
- # arrays must have at least one entry; this is not checked for
+ # square-root of $x
+ # ref to array, return ref to array
+ my ($c,$x) = @_;
- my ($c,$cx, $cy) = @_;
+ if (scalar @$x == 1)
+ {
+ # fit's into one Perl scalar
+ $x->[0] = int(sqrt($x->[0]));
+ return $x;
+ }
+ my $y = _copy($c,$x);
+ my $l = [ _len($c,$x) / 2 ];
- my ($i,$a,$x,$y,$k);
- # calculate length based on digits, not parts
- $x = _len('',$cx); $y = _len('',$cy);
- my $lxy = $x - $y; # if different in length
- return -1 if $lxy < 0;
- return 1 if $lxy > 0;
- $i = 0; $a = 0;
- # first way takes 5.49 sec instead of 4.87, but has the early out advantage
- # so grep is slightly faster, but more inflexible. hm. $_ instead of $k
- # yields 5.6 instead of 5.5 sec huh?
- # manual way (abort if unequal, good for early ne)
- my $j = scalar @$cx - 1;
- while ($j >= 0)
- {
- # print "$cx->[$j] $cy->[$j] $a",$cx->[$j]-$cy->[$j],"\n";
- last if ($a = $cx->[$j] - $cy->[$j]); $j--;
- }
- return 1 if $a > 0;
- return -1 if $a < 0;
- return 0; # equal
- # while it early aborts, it is even slower than the manual variant
- #grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
- # grep way, go trough all (bad for early ne)
- #grep { $a = $_ - $cy->[$i++]; } @$cx;
- #return $a;
- }
+ splice @$x,0; $x->[0] = 1; # keep ref($x), but modify it
-sub _len
- {
- # compute number of digits in bigint, minus the sign
- # int() because add/sub sometimes leaves strings (like '00005') instead of
- # int ('5') in this place, thus causing length() to report wrong length
- my $cx = $_[1];
+ _lsft($c,$x,$l,10);
- return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
+ my $two = _two();
+ my $last = _zero();
+ my $lastlast = _zero();
+ while (_acmp($c,$last,$x) != 0 && _acmp($c,$lastlast,$x) != 0)
+ {
+ $lastlast = _copy($c,$last);
+ $last = _copy($c,$x);
+ _add($c,$x, _div($c,_copy($c,$y),$x));
+ _div($c,$x, $two );
+ }
+ _dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot?
+ $x;
}
-sub _digit
- {
- # return the nth digit, negative values count backward
- # zero is rightmost, so _digit(123,0) will give 3
- my ($c,$x,$n) = @_;
+##############################################################################
+# binary stuff
- my $len = _len('',$x);
+sub _and
+ {
+ my ($c,$x,$y) = @_;
- $n = $len+$n if $n < 0; # -1 last, -2 second-to-last
- $n = abs($n); # if negative was too big
- $len--; $n = $len if $n > $len; # n to big?
+ # the shortcut makes equal, large numbers _really_ fast, and makes only a
+ # very small performance drop for small numbers (e.g. something with less
+ # than 32 bit) Since we optimize for large numbers, this is enabled.
+ return $x if _acmp($c,$x,$y) == 0; # shortcut
- my $elem = int($n / $BASE_LEN); # which array element
- my $digit = $n % $BASE_LEN; # which digit in this element
- $elem = '0000'.@$x[$elem]; # get element padded with 0's
- return substr($elem,-$digit-1,1);
+ my $m = _one(); my ($xr,$yr);
+ my $mask = $AND_MASK;
+
+ my $x1 = $x;
+ my $y1 = _copy($c,$y); # make copy
+ $x = _zero();
+ my ($b,$xrr,$yrr);
+ use integer;
+ while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
+ {
+ ($x1, $xr) = _div($c,$x1,$mask);
+ ($y1, $yr) = _div($c,$y1,$mask);
+
+ # make ints() from $xr, $yr
+ # this is when the AND_BITS are greater tahn $BASE and is slower for
+ # small (<256 bits) numbers, but faster for large numbers. Disabled
+ # due to KISS principle
+
+# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
+# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
+# _add($c,$x, _mul($c, _new( $c, \($xrr & $yrr) ), $m) );
+
+ _add($c,$x, _mul($c, [ $xr->[0] & $yr->[0] ], $m) );
+ _mul($c,$m,$mask);
+ }
+ $x;
}
-sub _zeros
+sub _xor
{
- # return amount of trailing zeros in decimal
- # check each array elem in _m for having 0 at end as long as elem == 0
- # Upon finding a elem != 0, stop
- my $x = $_[1];
- my $zeros = 0; my $elem;
- foreach my $e (@$x)
+ my ($c,$x,$y) = @_;
+
+ return _zero() if _acmp($c,$x,$y) == 0; # shortcut (see -and)
+
+ my $m = _one(); my ($xr,$yr);
+ my $mask = $XOR_MASK;
+
+ my $x1 = $x;
+ my $y1 = _copy($c,$y); # make copy
+ $x = _zero();
+ my ($b,$xrr,$yrr);
+ use integer;
+ while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
{
- if ($e != 0)
- {
- $elem = "$e"; # preserve x
- $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
- $zeros *= $BASE_LEN; # elems * 5
- $zeros += CORE::length($elem); # count trailing zeros
- last; # early out
- }
- $zeros ++; # real else branch: 50% slower!
+ ($x1, $xr) = _div($c,$x1,$mask);
+ ($y1, $yr) = _div($c,$y1,$mask);
+ # make ints() from $xr, $yr (see _and())
+ #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
+ #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
+ #_add($c,$x, _mul($c, _new( $c, \($xrr ^ $yrr) ), $m) );
+
+ _add($c,$x, _mul($c, [ $xr->[0] ^ $yr->[0] ], $m) );
+ _mul($c,$m,$mask);
}
- return $zeros;
+ # the loop stops when the shorter of the two numbers is exhausted
+ # the remainder of the longer one will survive bit-by-bit, so we simple
+ # multiply-add it in
+ _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1);
+ _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1);
+
+ $x;
}
-##############################################################################
-# _is_* routines
-
-sub _is_zero
+sub _or
{
- # return true if arg (BINT or num_str) is zero (array '+', '0')
- my $x = $_[1];
- return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
- }
+ my ($c,$x,$y) = @_;
-sub _is_even
- {
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
- return (!($x->[0] & 1)) <=> 0;
- }
+ return $x if _acmp($c,$x,$y) == 0; # shortcut (see _and)
-sub _is_odd
- {
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
- return (($x->[0] & 1)) <=> 0;
- }
+ my $m = _one(); my ($xr,$yr);
+ my $mask = $OR_MASK;
-sub _is_one
- {
- # return true if arg (BINT or num_str) is one (array '+', '1')
- my $x = $_[1];
- return (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
+ my $x1 = $x;
+ my $y1 = _copy($c,$y); # make copy
+ $x = _zero();
+ my ($b,$xrr,$yrr);
+ use integer;
+ while (!_is_zero($c,$x1) && !_is_zero($c,$y1))
+ {
+ ($x1, $xr) = _div($c,$x1,$mask);
+ ($y1, $yr) = _div($c,$y1,$mask);
+ # make ints() from $xr, $yr (see _and())
+# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
+# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
+# _add($c,$x, _mul($c, _new( $c, \($xrr | $yrr) ), $m) );
+
+ _add($c,$x, _mul($c, [ $xr->[0] | $yr->[0] ], $m) );
+ _mul($c,$m,$mask);
+ }
+ # the loop stops when the shorter of the two numbers is exhausted
+ # the remainder of the longer one will survive bit-by-bit, so we simple
+ # multiply-add it in
+ _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1);
+ _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1);
+
+ $x;
}
-sub __strip_zeros
+sub _from_hex
{
- # internal normalization function that strips leading zeros from the array
- # args: ref to array
- my $s = shift;
-
- my $cnt = scalar @$s; # get count of parts
- my $i = $cnt-1;
- #print "strip: cnt $cnt i $i\n";
- # '0', '3', '4', '0', '0',
- # 0 1 2 3 4
- # cnt = 5, i = 4
- # i = 4
- # i = 3
- # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
- # >= 1: skip first part (this can be zero)
- while ($i > 0) { last if $s->[$i] != 0; $i--; }
- $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
- return $s;
- }
+ # convert a hex number to decimal (ref to string, return ref to array)
+ my ($c,$hs) = @_;
-###############################################################################
-# check routine to test internal state of corruptions
+ my $mul = _one();
+ my $m = [ 0x10000 ]; # 16 bit at a time
+ my $x = _zero();
-sub _check
+ my $len = CORE::length($$hs)-2;
+ $len = int($len/4); # 4-digit parts, w/o '0x'
+ my $val; my $i = -4;
+ while ($len >= 0)
+ {
+ $val = substr($$hs,$i,4);
+ $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
+ $val = hex($val); # hex does not like wrong chars
+ $i -= 4; $len --;
+ _add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0;
+ _mul ($c, $mul, $m ) if $len >= 0; # skip last mul
+ }
+ $x;
+ }
+
+sub _from_bin
{
- # used by the test suite
- my $x = $_[1];
+ # convert a hex number to decimal (ref to string, return ref to array)
+ my ($c,$bs) = @_;
- return "$x is not a reference" if !ref($x);
+ my $mul = _one();
+ my $m = [ 0x100 ]; # 8 bit at a time
+ my $x = _zero();
- # are all parts are valid?
- my $i = 0; my $j = scalar @$x; my ($e,$try);
- while ($i < $j)
+ my $len = CORE::length($$bs)-2;
+ $len = int($len/8); # 4-digit parts, w/o '0x'
+ my $val; my $i = -8;
+ while ($len >= 0)
{
- $e = $x->[$i]; $e = 'undef' unless defined $e;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)";
- last if $e !~ /^[+]?[0-9]+$/;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)";
- last if "$e" !~ /^[+]?[0-9]+$/;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)";
- last if '' . "$e" !~ /^[+]?[0-9]+$/;
- $try = ' < 0 || >= $BASE; '."($x, $e)";
- last if $e <0 || $e >= $BASE;
- # this test is disabled, since new/bnorm and certain ops (like early out
- # in add/sub) are allowed/expected to leave '00000' in some elements
- #$try = '=~ /^00+/; '."($x, $e)";
- #last if $e =~ /^00+/;
- $i++;
+ $val = substr($$bs,$i,8);
+ $val =~ s/^[+-]?0b// if $len == 0; # for last part only
+
+ #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
+ # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
+ $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
+
+ $i -= 8; $len --;
+ _add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0;
+ _mul ($c, $mul, $m ) if $len >= 0; # skip last mul
}
- return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
- return 0;
+ $x;
}
+##############################################################################
+##############################################################################
+
1;
__END__
_or(obj1,obj2) OR (bit-wise) object 1 with object 2
_mod(obj,obj) Return remainder of div of the 1st by the 2nd object
- _sqrt(obj) return the square root of object
+ _sqrt(obj) return the square root of object (truncate to int)
_pow(obj,obj) return object 1 to the power of object 2
_gcd(obj,obj) return Greatest Common Divisor of two objects
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/bare_mbi.t//i;
+ print "loc $location\n";
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 1865;
+ }
+
+use Math::BigInt lib => 'BareCalc';
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
+$class = "Math::BigInt";
+$CL = "Math::BigInt::BareCalc";
+
+my $version = '1.48'; # for $VERSION tests, match current release (by hand!)
+
+require 'bigintpm.inc'; # perform same tests as bigintpm
+
$try .= "\$x->length();";
# some unary ops (test the bxxx form, since that is done by AUTOLOAD)
} elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) {
- $try .= "\$x->b$1();";
+ $try .= "\$x->f$1();";
# some is_xxx test function
} elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan)$/) {
$try .= "\$x->$f();";
$try .= '$x * $y;';
} elsif ($f eq "fdiv") {
$try .= "$setup; \$x / \$y;";
+ } elsif ($f eq "frsft") {
+ $try .= '$x >> $y;';
+ } elsif ($f eq "flsft") {
+ $try .= '$x << $y;';
} elsif ($f eq "fmod") {
$try .= '$x % $y;';
} else { warn "Unknown op '$f'"; }
}
} # end while
-# check whether new() for BigInts destroys them ($y == 12 in this case)
+# check whether $class->new( Math::BigInt->new()) destroys it
+# ($y == 12 in this case)
$x = Math::BigInt->new(1200); $y = $class->new($x);
ok ($y,1200); ok ($x,1200);
$x = $class->bzero(); ($x,$y) = $x->fdiv(1);
ok ($x,0); ok ($y,0);
-# all done
+$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+1; # all done
###############################################################################
# Perl 5.005 does not like ok ($x,undef)
}
__DATA__
+&frsft
+#NaNfrsft:NaN
+0:2:0
+1:1:0.5
+2:1:1
+4:1:2
+123:1:61.5
+32:3:4
+&flsft
+#NaNflsft:NaN
+2:1:4
+4:3:32
+5:3:40
+1:2:4
+0:5:0
&fnorm
1:1
-0:0
+106500000:+339:314159.2920353982300884955752212389380531
+1000000000:+3:333333333.3333333333333333333333333333333
2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447
+123456:1:123456
$div_scale = 20
+1000000000:+9:111111111.11111111111
+2000000000:+9:222222222.22222222222
1:10000:0.0001
1:504:0.001984126984126984127
2:1.987654321:1.0062111801179738436
+123456789.123456789123456789123456789:1:123456789.12345678912
# the next two cases are the "old" behaviour, but are now (>v0.01) different
#+35500000:+113:314159.292035398230088
#+71000000:+226:314159.292035398230088
$div_scale = 1
# round to accuracy 1 after bdiv
+124:+3:40
+123456789.1234:1:100000000
# reset scale for further tests
$div_scale = 40
&fmod
nanfsqrt:NaN
+inf:inf
-inf:NaN
-+1:1
-+2:1.41421356237309504880168872420969807857
-+4:2
-+16:4
-+100:10
-+123.456:11.11107555549866648462149404118219234119
-+15241.38393:123.4559999756998444766131352122991626468
-+1.44:1.2
+1:1
+2:1.41421356237309504880168872420969807857
+4:2
+9:3
+16:4
+100:10
+123.456:11.11107555549866648462149404118219234119
+15241.38393:123.4559999756998444766131352122991626468
+1.44:1.2
+# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4
+1.44E10:120000
+2e10:141421.356237309504880168872420969807857
&is_nan
123:0
abc:1
# unshift @INC, $location; # to locate the testing files
# # chdir 't' if -d 't';
- plan tests => 1325;
+ plan tests => 1367;
}
use Math::BigInt;
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 56;
+ plan tests => 63;
}
# testing of Math::BigInt::Calc, primarily for interface/api and not for the
# should not happen:
# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
+# _mod
+$x = $C->_new(\"1000"); $y = $C->_new(\"3");
+ok (${$C->_str(scalar $C->_mod($x,$y))},1);
+$x = $C->_new(\"1000"); $y = $C->_new(\"2");
+ok (${$C->_str(scalar $C->_mod($x,$y))},0);
+
+# _and, _or, _xor
+$x = $C->_new(\"5"); $y = $C->_new(\"2");
+ok (${$C->_str(scalar $C->_xor($x,$y))},7);
+$x = $C->_new(\"5"); $y = $C->_new(\"2");
+ok (${$C->_str(scalar $C->_or($x,$y))},7);
+$x = $C->_new(\"5"); $y = $C->_new(\"3");
+ok (${$C->_str(scalar $C->_and($x,$y))},1);
+
+# _from_hex, _from_bin
+ok (${$C->_str(scalar $C->_from_hex(\"0xFf"))},255);
+ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11);
+
# _check
$x = $C->_new(\"123456789");
ok ($C->_check($x),0);
##############################################################################
package main;
-my $CALC = $class->_core_lib(); ok ($CALC,'Math::BigInt::Calc');
+my $CALC = $class->_core_lib(); ok ($CALC,$CL);
my ($f,$z,$a,$exp,@a,$m,$e,$round_mode);
$try = "\$x = $class->new(\"$args[0]\"); \$x->digit($args[1]);";
} else { warn "Unknown op '$f'"; }
}
- # print "trying $try\n";
+ # print "trying $try\n";
$ans1 = eval $try;
- $ans =~ s/^[+]([0-9])/$1/; # remove leading '+'
+ # remove leading '+' from target
+ $ans =~ s/^[+]([0-9])/$1/;
+ # convert hex/binary targets to decimal
+ if ($ans =~ /^(0x0x|0b0b)/)
+ {
+ $ans =~ s/^0[xb]//;
+ $ans = Math::BigInt->new($ans)->bstr();
+ }
if ($ans eq "")
{
ok_undef ($ans1);
###############################################################################
###############################################################################
-# the followin tests only make sense with Math::BigInt::Calc
+# the followin tests only make sense with Math::BigInt::Calc or BareCalc
-exit if $CALC ne 'Math::BigInt::Calc'; # for Pari et al.
+exit if $CALC !~ /^Math::BigInt::(Calc|BareCalc)$/; # for Pari et al.
###############################################################################
# check proper length of internal arrays
-my $bl = Math::BigInt::Calc::_base_len();
+my $bl = $CL->_base_len();
my $BASE = '9' x $bl;
my $MAX = $BASE;
$BASE++;
###############################################################################
# test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead of 1
-$x = Math::BigInt->new(99998); $x++; $x++; $x++; $x++;
-if ($x > 100000) { ok (1,1) } else { ok ("$x < 100000","$x > 100000"); }
+$x = $class->new($BASE-2); $x++; $x++; $x++; $x++;
+if ($x > $BASE) { ok (1,1) } else { ok ("$x < $BASE","$x > $BASE"); }
+
+$x = $class->new($BASE+3); $x++;
+if ($x > $BASE) { ok (1,1) } else { ok ("$x > $BASE","$x < $BASE"); }
-$x = Math::BigInt->new(100003); $x++;
-$y = Math::BigInt->new(1000000);
-if ($x < 1000000) { ok (1,1) } else { ok ("$x > 1000000","$x < 1000000"); }
+# test for +0 instead of int():
+$x = $class->new($MAX); ok ($x->length(), length($MAX));
###############################################################################
# bug in sub where number with at least 6 trailing zeros after any op failed
-$x = Math::BigInt->new(123456); $z = Math::BigInt->new(10000); $z *= 10;
-$x -= $z;
+$x = $class->new(123456); $z = $class->new(10000); $z *= 10; $x -= $z;
ok ($z, 100000);
ok ($x, 23456);
# construct a number with a zero-hole of BASE_LEN
$x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
$y = '1' x (2*$bl);
-$x = Math::BigInt->new($x)->bmul($y);
+$x = $class->new($x)->bmul($y);
# result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl
$y = ''; my $d = '';
for (my $i = 1; $i <= $bl; $i++)
ok ($x,$y);
###############################################################################
+# see if mul shortcut for small numbers works
+
+$x = '9' x $bl;
+$x = $class->new($x);
+# 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
+ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+
+###############################################################################
# bug with rest "-0" in div, causing further div()s to fail
-$x = Math::BigInt->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
+$x = $class->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
ok ($y,'0','not -0'); # not '-0'
is_valid($y);
+###############################################################################
+# test whether bone/bzero take additional A & P, or reset it etc
+
+$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
### all tests done ############################################################
1;
0b1000000000000000000000000000000:1073741824
0b_101:NaN
0b1_0_1:5
+0b0_0_0_1:1
# hex input
-0x0:0
0xabcdefgh:NaN
-0x1234:-4660
0x12345678:305419896
0x1_2_3_4_56_78:305419896
+0xa_b_c_d_e_f:11259375
0x_123:NaN
# inf input
inf:inf
-7:-4:-8
-7:4:0
-4:7:4
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F
&bior
abc:abc:NaN
abc:0:NaN
-6:-6:-6
-7:4:-3
-4:7:-1
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
&bxor
abc:abc:NaN
abc:0:NaN
-4:7:-5
4:-7:-3
-4:-7:5
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0
+0xFFFFFF:0xFFFFFF:0
+0xFFFFFFFF:0xFFFFFFFF:0
+0xFFFFFFFFFF:0xFFFFFFFFFF:0
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0
+0x0F0F:0x0F0F:0
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0
+0x0F0F0F:0x0F0F0F:0
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0
+0x0F0F0F0F:0x0F0F0F0F:0
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
&bnot
abc:NaN
+0:-1
-123:3
215960156869840440586892398248:30
&bsqrt
+145:12
144:12
+143:11
16:4
+170:13
+169:13
+168:12
4:2
+3:1
2:1
+9:3
12:3
256:16
100000000:10000
4000000000000:2000000
+152399026:12345
+152399025:12345
+152399024:12344
1:1
0:0
-2:NaN
+-123:NaN
Nan:NaN
++inf:NaN
&bround
$round_mode('trunc')
0:12:0
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 1669;
+ plan tests => 1865;
}
use Math::BigInt;
-use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt";
+$CL = "Math::BigInt::Calc";
require 'bigintpm.inc'; # all tests here for sharing
}
print "# INC = @INC\n";
- plan tests => 1325 + 4; # + 4 own tests
+ plan tests => 1367 + 4; # + 4 own tests
}
use Math::BigFloat::Subclass;
}
print "# INC = @INC\n";
- plan tests => 1669 + 4; # +4 own tests
+ plan tests => 1865
+ + 4; # +4 own tests
}
use Math::BigInt::Subclass;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt::Subclass";
+$CL = "Math::BigInt::Calc";
-my $version = '0.01'; # for $VERSION tests, match current release (by hand!)
+my $version = '0.02'; # for $VERSION tests, match current release (by hand!)
-require 'bigintpm.inc'; # perform same tests as bigfltpm
+require 'bigintpm.inc'; # perform same tests as bigintpm
# Now do custom tests for Subclass itself
my $ms = $class->new(23);
my $proto = shift;
my $class = ref($proto) || $proto;
- my $value = shift || 0; # Set to 0 if not provided
- my $decimal = shift;
- my $radix = 0;
+ my $value = shift;
+ # Set to 0 if not provided, but don't use || (this would trigger for
+ # a passed objects to see if they are zero)
+ $value = 0 if !defined $value;
# Store the floating point value
my $self = bless Math::BigFloat->new($value), $class;
--- /dev/null
+package Math::BigInt::BareCalc;
+
+use 5.005;
+use strict;
+# use warnings; # dont use warnings for older Perls
+
+require Exporter;
+use vars qw/@ISA $VERSION/;
+@ISA = qw(Exporter);
+
+$VERSION = '0.02';
+
+# Package to to test Bigint's simulation of Calc
+
+# uses Calc, but only features the strictly necc. methods.
+
+use Math::BigInt::Calc v0.17;
+
+BEGIN
+ {
+ foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec
+ acmp len digit zeros
+ is_zero is_one is_odd is_even is_one check
+ /)
+ {
+ my $name = "Math::BigInt::Calc::_$_";
+ no strict 'refs';
+ *{"Math::BigInt::BareCalc::_$_"} = \&$name;
+ }
+ }
+
+# catch and throw away
+sub import { }
+
+1;
my $proto = shift;
my $class = ref($proto) || $proto;
- my $value = shift; # no || 0 here!
- my $decimal = shift;
- my $radix = 0;
+ my $value = shift;
+ $value = 0 if !defined $value; # no || 0 here!
# Store the floating point value
my $self = bless Math::BigInt->new($value), $class;
projects / p5sagit/p5-mst-13.2.git / commitdiff