package Math::BigFloat;
-$VERSION = '1.20';
+$VERSION = '1.21';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
my $class = "Math::BigFloat";
use overload
-'<=>' => sub {
- $_[2] ?
- $class->bcmp($_[1],$_[0]) :
- $class->bcmp($_[0],$_[1])},
+'<=>' => sub { $_[2] ?
+ ref($_[0])->bcmp($_[1],$_[0]) :
+ ref($_[0])->bcmp($_[0],$_[1])},
'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
;
return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# adjust so that exponents are equal
- my $lx = $x->{_m}->length() + $x->{_e};
- my $ly = $y->{_m}->length() + $y->{_e};
+ my $lxm = $x->{_m}->length();
+ my $lym = $y->{_m}->length();
+ 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 '-';
# print "$l $x->{sign}\n";
- return $l if $l != 0;
+ return $l <=> 0 if $l != 0;
- # lengths are equal, so compare mantissa, if equal, compare exponents
- # this assumes normalized numbers (no trailing zeros etc!)
- my $rc = $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
+ # lengths (corrected by exponent) are equal
+ # so make mantissa euqal length by padding with zero (shift left)
+ my $diff = $lxm - $lym;
+ my $xm = $x->{_m}; # not yet copy it
+ my $ym = $y->{_m};
+ if ($diff > 0)
+ {
+ $ym = $y->{_m}->copy()->blsft($diff,10);
+ }
+ elsif ($diff < 0)
+ {
+ $xm = $x->{_m}->copy()->blsft(-$diff,10);
+ }
+ my $rc = $xm->bcmp($ym);
$rc = -$rc if $x->{sign} eq '-'; # -124 < -123
- return $rc;
+ return $rc <=> 0;
}
sub bacmp
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.41';
+$VERSION = '1.42';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
'**=' => sub { $_[0]->bpow($_[1]); },
'<=>' => sub { $_[2] ?
- $class->bcmp($_[1],$_[0]) :
- $class->bcmp($_[0],$_[1])},
+ ref($_[0])->bcmp($_[1],$_[0]) :
+ ref($_[0])->bcmp($_[0],$_[1])},
'cmp' => sub {
$_[2] ?
$_[1] cmp $_[0]->bstr() :
my $x = shift;
$x = $class->new($x) unless ref $x;
+ #return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
# used in the same script, or eval inside import().
(my $mod = $lib . '.pm') =~ s!::!/!g;
# require does not automatically :: => /, so portability problems arise
- eval { require $mod; $lib->import(); }
+ eval { require $mod; $lib->import( @c ); }
}
else
{
- eval "use $lib;";
+ eval "use $lib @c;";
}
- $CALC = $lib, last if $@ eq '';
+ $CALC = $lib, last if $@ eq ''; # no error in loading lib?
}
}
$self->copy();
}
+sub as_hex
+ {
+ # return as hex string, with prefixed 0x
+ my $x = shift; $x = $class->new($x) if !ref($x);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return '0x0' if $x->is_zero();
+
+ my $es = ''; my $s = '';
+ $s = $x->{sign} if $x->{sign} eq '-';
+ $s .= '0x';
+ if ($CALC->can('_as_hex'))
+ {
+ $es = $CALC->_as_hex($x->{value});
+ }
+ else
+ {
+ my $x1 = $x->copy()->babs(); my $xr;
+ my $x100 = Math::BigInt->new (0x100);
+ while (!$x1->is_zero())
+ {
+ ($x1, $xr) = bdiv($x1,$x100);
+ $es .= unpack('h2',pack('C',$xr->numify()));
+ }
+ $es = reverse $es;
+ $es =~ s/^[0]+//; # strip leading zeros
+ }
+ $s . $es;
+ }
+
+sub as_bin
+ {
+ # return as binary string, with prefixed 0b
+ my $x = shift; $x = $class->new($x) if !ref($x);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return '0b0' if $x->is_zero();
+
+ my $es = ''; my $s = '';
+ $s = $x->{sign} if $x->{sign} eq '-';
+ $s .= '0b';
+ if ($CALC->can('_as_bin'))
+ {
+ $es = $CALC->_as_bin($x->{value});
+ }
+ else
+ {
+ my $x1 = $x->copy()->babs(); my $xr;
+ my $x100 = Math::BigInt->new (0x100);
+ while (!$x1->is_zero())
+ {
+ ($x1, $xr) = bdiv($x1,$x100);
+ $es .= unpack('b8',pack('C',$xr->numify()));
+ }
+ $es = reverse $es;
+ $es =~ s/^[0]+//; # strip leading zeros
+ }
+ $s . $es;
+ }
+
##############################################################################
# internal calculation routines (others are in Math::BigInt::Calc etc)
bgcd(@values); # greatest common divisor
blcm(@values); # lowest common multiplicator
-
- $x->bstr(); # normalized string
- $x->bsstr(); # normalized string in scientific notation
+
$x->length(); # return number of digits in number
- ($x,$f) = $x->length(); # length of number and length of fraction part
+ ($x,$f) = $x->length(); # length of number and length of fraction part,
+ # latter is always 0 digits long for BigInt's
$x->exponent(); # return exponent as BigInt
$x->mantissa(); # return mantissa as BigInt
$x->parts(); # return (mantissa,exponent) as BigInt
$x->copy(); # make a true copy of $x (unlike $y = $x;)
$x->as_number(); # return as BigInt (in BigInt: same as copy())
+
+ # conversation to string
+ $x->bstr(); # normalized string
+ $x->bsstr(); # normalized string in scientific notation
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+ $x->as_bin(); # as signed binary string with prefixed 0b
+
=head1 DESCRIPTION
print $x->copy()->bnorm(),"\n"; # 123.46
print $x->copy()->fround(),"\n"; # 123.46
+Examples for converting:
+
+ my $x = Math::BigInt->new('0b1'.'01' x 123);
+ print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
+
=head1 Autocreating constants
After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
The following will probably not do what you expect:
+ $c = Math::BigInt->new(123);
+ print $c->length(),"\n"; # prints 30
+
+It prints both the number of digits in the number and in the fraction part
+since print calls C<length()> in list context. Use something like:
+
+ print scalar $c->length(),"\n"; # prints 3
+
+=item bdiv
+
+The following will probably not do what you expect:
+
print $c->bdiv(10000),"\n";
It prints both quotient and reminder since print calls C<bdiv()> in list
# use warnings; # dont use warnings for older Perls
require Exporter;
-
-use vars qw/ @ISA @EXPORT $VERSION/;
+use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-@EXPORT = qw(
- _add _mul _div _mod _sub
- _new
- _str _num _acmp _len
- _digit
- _is_zero _is_one
- _is_even _is_odd
- _check _zero _one _copy _zeros
- _rsft _lsft
-);
-$VERSION = '0.09';
+$VERSION = '0.10';
# Package to store unsigned big integers in decimal and do math with them
# todo:
# - fully remove funky $# stuff (maybe)
-# - use integer; vs 1e7 as base
# USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
-# instead of "/ 1e5" at some places, (marked with USE_MUL). But instead of
-# using the reverse only on problematic machines, I used it everytime to avoid
-# the costly comparisons. This _should_ work everywhere. Thanx Peter Prymmer
+# instead of "/ 1e5" at some places, (marked with USE_MUL).
+# The BEGIN block is used to determine which of the two variants gives the
+# correct result.
##############################################################################
# global constants, flags and accessory
BEGIN
{
- # Daniel Pfeiffer: determine largest group of digits that is precisely
+ # from Daniel Pfeiffer: determine largest group of digits that is precisely
# multipliable with itself plus carry
my ($e, $num) = 4;
- do {
- $num = ('9' x ++$e) + 0;
+ do
+ {
+ $num = ('9' x ++$e) + 0;
$num *= $num + 1;
- } until ($num == $num - 1 or $num - 1 == $num - 2);
+ } until ($num == $num - 1 or $num - 1 == $num - 2);
$BASE_LEN = $e-1;
$BASE = int("1e".$BASE_LEN);
$RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
return [ @{$_[1]} ];
}
+# catch and throw away
+sub import { }
+
##############################################################################
# convert back to string and number
sub _check
{
- # no checks yet, pull it out from the test suite
+ # used by the test suite
my $x = $_[1];
return "$x is not a reference" if !ref($x);
=head1 EXPORT
-The following functions MUST be exported in order to support
+The following functions MUST be defined in order to support
the use by Math::BigInt:
_new(string) return ref to new object from ref to decimal string
_check(obj) check whether internal representation is still intact
return 0 for ok, otherwise error message as string
-The following functions are optional, and can be exported if the underlying lib
+The following functions are optional, and can be defined if the underlying lib
has a fast way to do them. If not defined, Math::BigInt will use a pure, but
-slow, Perl function as fallback to emulate these:
+slow, Perl way as fallback to emulate these:
_from_hex(str) return ref to new object from ref to hexadecimal string
_from_bin(str) return ref to new object from ref to binary string
The first parameter can be modified, that includes the possibility that you
return a reference to a completely different object instead. Although keeping
-the reference the same is prefered.
+the reference is prefered over creating and returning a different one.
Return values are always references to objects or strings. Exceptions are
C<_lsft()> and C<_rsft()>, which return undef if they can not shift the
If you want to port your own favourite c-lib for big numbers to the
Math::BigInt interface, you can take any of the already existing modules as
a rough guideline. You should really wrap up the latest BigInt and BigFloat
-testsuites with your module, and replace the following line:
+testsuites with your module, and replace in them any of the following:
use Math::BigInt;
-by
+by this:
use Math::BigInt lib => 'yourlib';
$| = 1;
unshift @INC, '../lib'; # for running manually
# chdir 't' if -d 't';
- plan tests => 1158;
+ plan tests => 1162;
}
use Math::BigInt;
0.0005:0.0001:1
0.005:0.0001:1
0.001:0.0005:1
-0.000001:0.0005:-2 # <0, but can't test this
-0.00000123:0.0005:-2 # <0, but can't test this
+0.000001:0.0005:-1
+0.00000123:0.0005:-1
0.00512:0.0001:1
0.005:0.000112:1
0.00123:0.0005:1
+1.5:2:-1
+2:1.5:1
+1.54321:234:-1
+234:1.54321:1
# infinity
-inf:5432112345:-1
+inf:5432112345:1
my $C = 'Math::BigInt::Calc'; # pass classname to sub's
# _new and _str
-my $x = _new($C,\"123"); my $y = _new($C,\"321");
-ok (ref($x),'ARRAY'); ok (${_str($C,$x)},123); ok (${_str($C,$y)},321);
+my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
+ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
# _add, _sub, _mul, _div
-ok (${_str($C,_add($C,$x,$y))},444);
-ok (${_str($C,_sub($C,$x,$y))},123);
-ok (${_str($C,_mul($C,$x,$y))},39483);
-ok (${_str($C,_div($C,$x,$y))},123);
+ok (${$C->_str($C->_add($x,$y))},444);
+ok (${$C->_str($C->_sub($x,$y))},123);
+ok (${$C->_str($C->_mul($x,$y))},39483);
+ok (${$C->_str($C->_div($x,$y))},123);
-ok (${_str($C,_mul($C,$x,$y))},39483);
-ok (${_str($C,$x)},39483);
-ok (${_str($C,$y)},321);
-my $z = _new($C,\"2");
-ok (${_str($C,_add($C,$x,$z))},39485);
-my ($re,$rr) = _div($C,$x,$y);
+ok (${$C->_str($C->_mul($x,$y))},39483);
+ok (${$C->_str($x)},39483);
+ok (${$C->_str($y)},321);
+my $z = $C->_new(\"2");
+ok (${$C->_str($C->_add($x,$z))},39485);
+my ($re,$rr) = $C->_div($x,$y);
-ok (${_str($C,$re)},123); ok (${_str($C,$rr)},2);
+ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
# is_zero, _is_one, _one, _zero
-ok (_is_zero($C,$x),0);
-ok (_is_one($C,$x),0);
+ok ($C->_is_zero($x),0);
+ok ($C->_is_one($x),0);
-ok (_is_one($C,_one()),1); ok (_is_one($C,_zero()),0);
-ok (_is_zero($C,_zero()),1); ok (_is_zero($C,_one()),0);
+ok ($C->_is_one($C->_one()),1); ok ($C->_is_one($C->_zero()),0);
+ok ($C->_is_zero($C->_zero()),1); ok ($C->_is_zero($C->_one()),0);
# is_odd, is_even
-ok (_is_odd($C,_one()),1); ok (_is_odd($C,_zero()),0);
-ok (_is_even($C,_one()),0); ok (_is_even($C,_zero()),1);
+ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0);
+ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1);
# _digit
-$x = _new($C,\"123456789");
-ok (_digit($C,$x,0),9);
-ok (_digit($C,$x,1),8);
-ok (_digit($C,$x,2),7);
-ok (_digit($C,$x,-1),1);
-ok (_digit($C,$x,-2),2);
-ok (_digit($C,$x,-3),3);
+$x = $C->_new(\"123456789");
+ok ($C->_digit($x,0),9);
+ok ($C->_digit($x,1),8);
+ok ($C->_digit($x,2),7);
+ok ($C->_digit($x,-1),1);
+ok ($C->_digit($x,-2),2);
+ok ($C->_digit($x,-3),3);
# _copy
-$x = _new($C,\"12356");
-ok (${_str($C,_copy($C,$x))},12356);
+$x = $C->_new(\"12356");
+ok (${$C->_str($C->_copy($x))},12356);
# _zeros
-$x = _new($C,\"1256000000"); ok (_zeros($C,$x),6);
-$x = _new($C,\"152"); ok (_zeros($C,$x),0);
-$x = _new($C,\"123000"); ok (_zeros($C,$x),3);
+$x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6);
+$x = $C->_new(\"152"); ok ($C->_zeros($x),0);
+$x = $C->_new(\"123000"); ok ($C->_zeros($x),3);
# _lsft, _rsft
-$x = _new($C,\"10"); $y = _new($C,\"3");
-ok (${_str($C,_lsft($C,$x,$y,10))},10000);
-$x = _new($C,\"20"); $y = _new($C,\"3");
-ok (${_str($C,_lsft($C,$x,$y,10))},20000);
-$x = _new($C,\"128"); $y = _new($C,\"4");
-if (!defined _lsft($C,$x,$y,2))
+$x = $C->_new(\"10"); $y = $C->_new(\"3");
+ok (${$C->_str($C->_lsft($x,$y,10))},10000);
+$x = $C->_new(\"20"); $y = $C->_new(\"3");
+ok (${$C->_str($C->_lsft($x,$y,10))},20000);
+$x = $C->_new(\"128"); $y = $C->_new(\"4");
+if (!defined $C->_lsft($x,$y,2))
{
ok (1,1)
}
{
ok ('_lsft','undef');
}
-$x = _new($C,\"1000"); $y = _new($C,\"3");
-ok (${_str($C,_rsft($C,$x,$y,10))},1);
-$x = _new($C,\"20000"); $y = _new($C,\"3");
-ok (${_str($C,_rsft($C,$x,$y,10))},20);
-$x = _new($C,\"256"); $y = _new($C,\"4");
-if (!defined _rsft($C,$x,$y,2))
+$x = $C->_new(\"1000"); $y = $C->_new(\"3");
+ok (${$C->_str($C->_rsft($x,$y,10))},1);
+$x = $C->_new(\"20000"); $y = $C->_new(\"3");
+ok (${$C->_str($C->_rsft($x,$y,10))},20);
+$x = $C->_new(\"256"); $y = $C->_new(\"4");
+if (!defined $C->_rsft($x,$y,2))
{
ok (1,1)
}
}
# _acmp
-$x = _new($C,\"123456789");
-$y = _new($C,\"987654321");
-ok (_acmp($C,$x,$y),-1);
-ok (_acmp($C,$y,$x),1);
-ok (_acmp($C,$x,$x),0);
-ok (_acmp($C,$y,$y),0);
+$x = $C->_new(\"123456789");
+$y = $C->_new(\"987654321");
+ok ($C->_acmp($x,$y),-1);
+ok ($C->_acmp($y,$x),1);
+ok ($C->_acmp($x,$x),0);
+ok ($C->_acmp($y,$y),0);
# _div
-$x = _new($C,\"3333"); $y = _new($C,\"1111");
-ok (${_str($C, scalar _div($C,$x,$y))},3);
-$x = _new($C,\"33333"); $y = _new($C,\"1111"); ($x,$y) = _div($C,$x,$y);
-ok (${_str($C,$x)},30); ok (${_str($C,$y)},3);
-$x = _new($C,\"123"); $y = _new($C,\"1111");
-($x,$y) = _div($C,$x,$y); ok (${_str($C,$x)},0); ok (${_str($C,$y)},123);
+$x = $C->_new(\"3333"); $y = $C->_new(\"1111");
+ok (${$C->_str(scalar $C->_div($x,$y))},3);
+$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y);
+ok (${$C->_str($x)},30); ok (${$C->_str($y)},3);
+$x = $C->_new(\"123"); $y = $C->_new(\"1111");
+($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
# _num
-$x = _new($C,\"12345"); $x = _num($C,$x); ok (ref($x)||'',''); ok ($x,12345);
+$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
# should not happen:
-# $x = _new($C,\"-2"); $y = _new($C,\"4"); ok (_acmp($C,$x,$y),-1);
+# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
# _check
-$x = _new($C,\"123456789");
-ok (_check($C,$x),0);
-ok (_check($C,123),'123 is not a reference');
+$x = $C->_new(\"123456789");
+ok ($C->_check($x),0);
+ok ($C->_check(123),'123 is not a reference');
# done
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 1424;
+ plan tests => 1447;
}
-my $version = '1.40'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.42'; # for $VERSION tests, match current release (by hand!)
##############################################################################
# for testing inheritance of _swap
$try .= '$x->is_negative()+0;';
} elsif ($f eq "is_positive") {
$try .= '$x->is_positive()+0;';
+ } elsif ($f eq "as_hex") {
+ $try .= '$x->as_hex();';
+ } elsif ($f eq "as_bin") {
+ $try .= '$x->as_bin();';
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]')+0;";
} elsif ($f eq "binf") {
$x = Math::BigInt->new(2); $x **= 127; $x--;
ok ($x,"170141183460469231731687303715884105727");
+$x = Math::BigInt->new('215960156869840440586892398248');
+($x,$y) = $x->length();
+ok ($x,30); ok ($y,0);
+
+$x = Math::BigInt->new('1_000_000_000_000');
+($x,$y) = $x->length();
+ok ($x,13); ok ($y,0);
+
# I am afraid the following is not yet possible due to slowness
# Also, testing for 2 meg output is a bit hard ;)
#$x = new Math::BigInt(2); $x **= 6972593; $x--;
12345:5
10000000000000000:17
-123:3
+215960156869840440586892398248:30
&bsqrt
144:12
16:4
2:2
3:3
abc:NaN
+&as_hex
+128:0x80
+-128:-0x80
+0:0x0
+-0:0x0
+1:0x1
+0x123456789123456789:0x123456789123456789
++inf:inf
+-inf:-inf
+NaNas_hex:NaN
+&as_bin
+128:0b10000000
+-128:-0b10000000
+0:0b0
+-0:0b0
+1:0b1
+0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101
++inf:inf
+-inf:-inf
+NaNas_bin:NaN
projects / platform / upstream / perl.git / commitdiff