4 # "Mike had an infinite amount to do and a negative amount of time in which
5 # to do it." - Before and After
8 # The following hash values are used:
9 # value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
10 # sign : +,-,NaN,+inf,-inf
13 # _f : flags, used by MBF to flag parts of a float as untouchable
15 # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
16 # underlying lib might change the reference!
18 my $class = "Math::BigInt";
23 @ISA = qw( Exporter );
24 @EXPORT_OK = qw( objectify _swap bgcd blcm);
25 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
26 use vars qw/$upgrade $downgrade/;
29 # Inside overload, the first arg is always an object. If the original code had
30 # it reversed (like $x = 2 * $y), then the third paramater indicates this
31 # swapping. To make it work, we use a helper routine which not only reswaps the
32 # params, but also makes a new object in this case. See _swap() for details,
33 # especially the cases of operators with different classes.
35 # For overloaded ops with only one argument we simple use $_[0]->copy() to
36 # preserve the argument.
38 # Thus inheritance of overload operators becomes possible and transparent for
39 # our subclasses without the need to repeat the entire overload section there.
42 '=' => sub { $_[0]->copy(); },
44 # '+' and '-' do not use _swap, since it is a triffle slower. If you want to
45 # override _swap (if ever), then override overload of '+' and '-', too!
46 # for sub it is a bit tricky to keep b: b-a => -a+b
47 '-' => sub { my $c = $_[0]->copy; $_[2] ?
48 $c->bneg()->badd($_[1]) :
50 '+' => sub { $_[0]->copy()->badd($_[1]); },
52 # some shortcuts for speed (assumes that reversed order of arguments is routed
53 # to normal '+' and we thus can always modify first arg. If this is changed,
54 # this breaks and must be adjusted.)
55 '+=' => sub { $_[0]->badd($_[1]); },
56 '-=' => sub { $_[0]->bsub($_[1]); },
57 '*=' => sub { $_[0]->bmul($_[1]); },
58 '/=' => sub { scalar $_[0]->bdiv($_[1]); },
59 '%=' => sub { $_[0]->bmod($_[1]); },
60 '^=' => sub { $_[0]->bxor($_[1]); },
61 '&=' => sub { $_[0]->band($_[1]); },
62 '|=' => sub { $_[0]->bior($_[1]); },
63 '**=' => sub { $_[0]->bpow($_[1]); },
65 # not supported by Perl yet
66 '..' => \&_pointpoint,
68 '<=>' => sub { $_[2] ?
69 ref($_[0])->bcmp($_[1],$_[0]) :
70 ref($_[0])->bcmp($_[0],$_[1])},
73 "$_[1]" cmp $_[0]->bstr() :
74 $_[0]->bstr() cmp "$_[1]" },
76 'log' => sub { $_[0]->copy()->blog(); },
77 'int' => sub { $_[0]->copy(); },
78 'neg' => sub { $_[0]->copy()->bneg(); },
79 'abs' => sub { $_[0]->copy()->babs(); },
80 'sqrt' => sub { $_[0]->copy()->bsqrt(); },
81 '~' => sub { $_[0]->copy()->bnot(); },
83 '*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); },
84 '/' => sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);},
85 '%' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); },
86 '**' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); },
87 '<<' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); },
88 '>>' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); },
90 '&' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); },
91 '|' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); },
92 '^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
94 # can modify arg of ++ and --, so avoid a new-copy for speed, but don't
95 # use $_[0]->__one(), it modifies $_[0] to be 1!
96 '++' => sub { $_[0]->binc() },
97 '--' => sub { $_[0]->bdec() },
99 # if overloaded, O(1) instead of O(N) and twice as fast for small numbers
101 # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
102 # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-(
103 my $t = !$_[0]->is_zero();
108 # the original qw() does not work with the TIESCALAR below, why?
109 # Order of arguments unsignificant
110 '""' => sub { $_[0]->bstr(); },
111 '0+' => sub { $_[0]->numify(); }
114 ##############################################################################
115 # global constants, flags and accessory
117 use constant MB_NEVER_ROUND => 0x0001;
119 my $NaNOK=1; # are NaNs ok?
120 my $nan = 'NaN'; # constants for easier life
122 my $CALC = 'Math::BigInt::Calc'; # module to do low level math
123 my $IMPORT = 0; # did import() yet?
125 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
130 $upgrade = undef; # default is no upgrade
131 $downgrade = undef; # default is no downgrade
133 ##############################################################################
134 # the old code had $rnd_mode, so we need to support it, too
137 sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; }
138 sub FETCH { return $round_mode; }
139 sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
141 BEGIN { tie $rnd_mode, 'Math::BigInt'; }
143 ##############################################################################
148 # make Class->round_mode() work
150 my $class = ref($self) || $self || __PACKAGE__;
154 die "Unknown round mode $m"
155 if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
156 return ${"${class}::round_mode"} = $m;
158 return ${"${class}::round_mode"};
164 # make Class->round_mode() work
166 my $class = ref($self) || $self || __PACKAGE__;
170 return ${"${class}::upgrade"} = $u;
172 return ${"${class}::upgrade"};
178 # make Class->round_mode() work
180 my $class = ref($self) || $self || __PACKAGE__;
183 die ('div_scale must be greater than zero') if $_[0] < 0;
184 ${"${class}::div_scale"} = shift;
186 return ${"${class}::div_scale"};
191 # $x->accuracy($a); ref($x) $a
192 # $x->accuracy(); ref($x)
193 # Class->accuracy(); class
194 # Class->accuracy($a); class $a
197 my $class = ref($x) || $x || __PACKAGE__;
200 # need to set new value?
204 die ('accuracy must not be zero') if defined $a && $a == 0;
207 # $object->accuracy() or fallback to global
208 $x->bround($a) if defined $a;
209 $x->{_a} = $a; # set/overwrite, even if not rounded
210 $x->{_p} = undef; # clear P
215 ${"${class}::accuracy"} = $a;
216 ${"${class}::precision"} = undef; # clear P
218 return $a; # shortcut
223 # $object->accuracy() or fallback to global
224 return $x->{_a} || ${"${class}::accuracy"};
226 return ${"${class}::accuracy"};
231 # $x->precision($p); ref($x) $p
232 # $x->precision(); ref($x)
233 # Class->precision(); class
234 # Class->precision($p); class $p
237 my $class = ref($x) || $x || __PACKAGE__;
240 # need to set new value?
246 # $object->precision() or fallback to global
247 $x->bfround($p) if defined $p;
248 $x->{_p} = $p; # set/overwrite, even if not rounded
249 $x->{_a} = undef; # clear A
254 ${"${class}::precision"} = $p;
255 ${"${class}::accuracy"} = undef; # clear A
257 return $p; # shortcut
262 # $object->precision() or fallback to global
263 return $x->{_p} || ${"${class}::precision"};
265 return ${"${class}::precision"};
270 # return (later set?) configuration data as hash ref
271 my $class = shift || 'Math::BigInt';
277 lib_version => ${"${lib}::VERSION"},
281 qw/upgrade downgrade precisison accuracy round_mode VERSION div_scale/)
283 $cfg->{lc($_)} = ${"${class}::$_"};
290 # select accuracy parameter based on precedence,
291 # used by bround() and bfround(), may return undef for scale (means no op)
292 my ($x,$s,$m,$scale,$mode) = @_;
293 $scale = $x->{_a} if !defined $scale;
294 $scale = $s if (!defined $scale);
295 $mode = $m if !defined $mode;
296 return ($scale,$mode);
301 # select precision parameter based on precedence,
302 # used by bround() and bfround(), may return undef for scale (means no op)
303 my ($x,$s,$m,$scale,$mode) = @_;
304 $scale = $x->{_p} if !defined $scale;
305 $scale = $s if (!defined $scale);
306 $mode = $m if !defined $mode;
307 return ($scale,$mode);
310 ##############################################################################
318 # if two arguments, the first one is the class to "swallow" subclasses
326 return unless ref($x); # only for objects
328 my $self = {}; bless $self,$c;
330 foreach my $k (keys %$x)
334 $self->{value} = $CALC->_copy($x->{value}); next;
336 if (!($r = ref($x->{$k})))
338 $self->{$k} = $x->{$k}; next;
342 $self->{$k} = \${$x->{$k}};
344 elsif ($r eq 'ARRAY')
346 $self->{$k} = [ @{$x->{$k}} ];
350 # only one level deep!
351 foreach my $h (keys %{$x->{$k}})
353 $self->{$k}->{$h} = $x->{$k}->{$h};
359 if ($xk->can('copy'))
361 $self->{$k} = $xk->copy();
365 $self->{$k} = $xk->new($xk);
374 # create a new BigInt object from a string or another BigInt object.
375 # see hash keys documented at top
377 # the argument could be an object, so avoid ||, && etc on it, this would
378 # cause costly overloaded code to be called. The only allowed ops are
381 my ($class,$wanted,$a,$p,$r) = @_;
383 # avoid numify-calls by not using || on $wanted!
384 return $class->bzero($a,$p) if !defined $wanted; # default to 0
385 return $class->copy($wanted,$a,$p,$r) if ref($wanted);
387 $class->import() if $IMPORT == 0; # make require work
389 my $self = {}; bless $self, $class;
390 # handle '+inf', '-inf' first
391 if ($wanted =~ /^[+-]?inf$/)
393 $self->{value} = $CALC->_zero();
394 $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
397 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
398 my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
401 die "$wanted is not a number initialized to $class" if !$NaNOK;
403 $self->{value} = $CALC->_zero();
404 $self->{sign} = $nan;
409 # _from_hex or _from_bin
410 $self->{value} = $mis->{value};
411 $self->{sign} = $mis->{sign};
412 return $self; # throw away $mis
414 # make integer from mantissa by adjusting exp, then convert to bigint
415 $self->{sign} = $$mis; # store sign
416 $self->{value} = $CALC->_zero(); # for all the NaN cases
417 my $e = int("$$es$$ev"); # exponent (avoid recursion)
420 my $diff = $e - CORE::length($$mfv);
421 if ($diff < 0) # Not integer
424 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
425 $self->{sign} = $nan;
429 # adjust fraction and add it to value
430 # print "diff > 0 $$miv\n";
431 $$miv = $$miv . ($$mfv . '0' x $diff);
436 if ($$mfv ne '') # e <= 0
438 # fraction and negative/zero E => NOI
439 #print "NOI 2 \$\$mfv '$$mfv'\n";
440 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
441 $self->{sign} = $nan;
445 # xE-y, and empty mfv
448 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
451 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
452 $self->{sign} = $nan;
456 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
457 $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
458 # if any of the globals is set, use them to round and store them inside $self
459 # do not round for new($x,undef,undef) since that is used by MBF to signal
461 $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
462 # print "mbi new $self\n";
468 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
470 $self = $class if !defined $self;
473 my $c = $self; $self = {}; bless $self, $c;
475 $self->import() if $IMPORT == 0; # make require work
476 return if $self->modify('bnan');
478 if ($self->can('_bnan'))
480 # use subclass to initialize
485 # otherwise do our own thing
486 $self->{value} = $CALC->_zero();
488 $self->{value} = $CALC->_zero();
489 $self->{sign} = $nan;
490 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
496 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
497 # the sign is either '+', or if given, used from there
499 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
500 $self = $class if !defined $self;
503 my $c = $self; $self = {}; bless $self, $c;
505 $self->import() if $IMPORT == 0; # make require work
506 return if $self->modify('binf');
508 if ($self->can('_binf'))
510 # use subclass to initialize
515 # otherwise do our own thing
516 $self->{value} = $CALC->_zero();
518 $self->{sign} = $sign.'inf';
519 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
525 # create a bigint '+0', if given a BigInt, set it to 0
527 $self = $class if !defined $self;
531 my $c = $self; $self = {}; bless $self, $c;
533 $self->import() if $IMPORT == 0; # make require work
534 return if $self->modify('bzero');
536 if ($self->can('_bzero'))
538 # use subclass to initialize
543 # otherwise do our own thing
544 $self->{value} = $CALC->_zero();
550 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
552 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
559 # create a bigint '+1' (or -1 if given sign '-'),
560 # if given a BigInt, set it to +1 or -1, respecively
562 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
563 $self = $class if !defined $self;
567 my $c = $self; $self = {}; bless $self, $c;
569 $self->import() if $IMPORT == 0; # make require work
570 return if $self->modify('bone');
572 if ($self->can('_bone'))
574 # use subclass to initialize
579 # otherwise do our own thing
580 $self->{value} = $CALC->_one();
582 $self->{sign} = $sign;
586 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
588 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
593 ##############################################################################
594 # string conversation
598 # (ref to BFLOAT or num_str ) return num_str
599 # Convert number from internal format to scientific string format.
600 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
601 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
602 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
604 if ($x->{sign} !~ /^[+-]$/)
606 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
609 my ($m,$e) = $x->parts();
610 # e can only be positive
612 # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
613 return $m->bstr().$sign.$e->bstr();
618 # make a string from bigint object
619 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
620 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
622 if ($x->{sign} !~ /^[+-]$/)
624 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
627 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
628 return $es.${$CALC->_str($x->{value})};
633 # Make a "normal" scalar from a BigInt object
634 my $x = shift; $x = $class->new($x) unless ref $x;
635 return $x->{sign} if $x->{sign} !~ /^[+-]$/;
636 my $num = $CALC->_num($x->{value});
637 return -$num if $x->{sign} eq '-';
641 ##############################################################################
642 # public stuff (usually prefixed with "b")
646 # return the sign of the number: +/-/NaN
647 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
652 sub _find_round_parameters
654 # After any operation or when calling round(), the result is rounded by
655 # regarding the A & P from arguments, local parameters, or globals.
657 # This procedure finds the round parameters, but it is for speed reasons
658 # duplicated in round. Otherwise, it is tested by the testsuite and used
661 my ($self,$a,$p,$r,@args) = @_;
662 # $a accuracy, if given by caller
663 # $p precision, if given by caller
664 # $r round_mode, if given by caller
665 # @args all 'other' arguments (0 for unary, 1 for binary ops)
667 # leave bigfloat parts alone
668 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
670 my $c = ref($self); # find out class of argument(s)
673 # now pick $a or $p, but only if we have got "arguments"
676 foreach ($self,@args)
678 # take the defined one, or if both defined, the one that is smaller
679 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
684 # even if $a is defined, take $p, to signal error for both defined
685 foreach ($self,@args)
687 # take the defined one, or if both defined, the one that is bigger
689 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
692 # if still none defined, use globals (#2)
693 $a = ${"$c\::accuracy"} unless defined $a;
694 $p = ${"$c\::precision"} unless defined $p;
697 return ($self) unless defined $a || defined $p; # early out
699 # set A and set P is an fatal error
700 return ($self->bnan()) if defined $a && defined $p;
702 $r = ${"$c\::round_mode"} unless defined $r;
703 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
705 return ($self,$a,$p,$r);
710 # Round $self according to given parameters, or given second argument's
711 # parameters or global defaults
713 # for speed reasons, _find_round_parameters is embeded here:
715 my ($self,$a,$p,$r,@args) = @_;
716 # $a accuracy, if given by caller
717 # $p precision, if given by caller
718 # $r round_mode, if given by caller
719 # @args all 'other' arguments (0 for unary, 1 for binary ops)
721 # leave bigfloat parts alone
722 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
724 my $c = ref($self); # find out class of argument(s)
727 # now pick $a or $p, but only if we have got "arguments"
730 foreach ($self,@args)
732 # take the defined one, or if both defined, the one that is smaller
733 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
738 # even if $a is defined, take $p, to signal error for both defined
739 foreach ($self,@args)
741 # take the defined one, or if both defined, the one that is bigger
743 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
746 # if still none defined, use globals (#2)
747 $a = ${"$c\::accuracy"} unless defined $a;
748 $p = ${"$c\::precision"} unless defined $p;
751 return $self unless defined $a || defined $p; # early out
753 # set A and set P is an fatal error
754 return $self->bnan() if defined $a && defined $p;
756 $r = ${"$c\::round_mode"} unless defined $r;
757 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
759 # now round, by calling either fround or ffround:
762 $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
764 else # both can't be undefined due to early out
766 $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
768 $self->bnorm(); # after round, normalize
773 # (numstr or BINT) return BINT
774 # Normalize number -- no-op here
775 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
781 # (BINT or num_str) return BINT
782 # make number absolute, or return absolute BINT from string
783 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
785 return $x if $x->modify('babs');
786 # post-normalized abs for internal use (does nothing for NaN)
787 $x->{sign} =~ s/^-/+/;
793 # (BINT or num_str) return BINT
794 # negate number or make a negated number from string
795 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
797 return $x if $x->modify('bneg');
799 # for +0 dont negate (to have always normalized)
800 $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
806 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
807 # (BINT or num_str, BINT or num_str) return cond_code
808 my ($self,$x,$y) = objectify(2,@_);
810 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
812 # handle +-inf and NaN
813 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
814 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
815 return +1 if $x->{sign} eq '+inf';
816 return -1 if $x->{sign} eq '-inf';
817 return -1 if $y->{sign} eq '+inf';
820 # check sign for speed first
821 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
822 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
825 my $xz = $x->is_zero();
826 my $yz = $y->is_zero();
827 return 0 if $xz && $yz; # 0 <=> 0
828 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
829 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
831 # post-normalized compare for internal use (honors signs)
832 if ($x->{sign} eq '+')
834 return 1 if $y->{sign} eq '-'; # 0 check handled above
835 return $CALC->_acmp($x->{value},$y->{value});
839 return -1 if $y->{sign} eq '+';
840 $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
845 # Compares 2 values, ignoring their signs.
846 # Returns one of undef, <0, =0, >0. (suitable for sort)
847 # (BINT, BINT) return cond_code
848 my ($self,$x,$y) = objectify(2,@_);
850 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
852 # handle +-inf and NaN
853 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
854 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
855 return +1; # inf is always bigger
857 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
862 # add second arg (BINT or string) to first (BINT) (modifies first)
863 # return result as BINT
864 my ($self,$x,$y,@r) = objectify(2,@_);
866 return $x if $x->modify('badd');
867 # print "mbi badd ",join(' ',caller()),"\n";
868 # print "upgrade => ",$upgrade||'undef',
869 # " \$x (",ref($x),") \$y (",ref($y),")\n";
870 # return $upgrade->badd($x,$y,@r) if defined $upgrade &&
871 # ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
872 # print "still badd\n";
874 $r[3] = $y; # no push!
875 # inf and NaN handling
876 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
879 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
881 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
883 # +inf++inf or -inf+-inf => same, rest is NaN
884 return $x if $x->{sign} eq $y->{sign};
887 # +-inf + something => +inf
888 # something +-inf => +-inf
889 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
893 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
897 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
902 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
905 #print "swapped sub (a=$a)\n";
906 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
911 # speedup, if equal, set result to 0
912 #print "equal sub, result = 0\n";
913 $x->{value} = $CALC->_zero();
918 #print "unswapped sub (a=$a)\n";
919 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
928 # (BINT or num_str, BINT or num_str) return num_str
929 # subtract second arg from first, modify first
930 my ($self,$x,$y,@r) = objectify(2,@_);
932 return $x if $x->modify('bsub');
933 # return $upgrade->badd($x,$y,@r) if defined $upgrade &&
934 # ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
938 return $x->round(@r);
941 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
942 $x->badd($y,@r); # badd does not leave internal zeros
943 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
944 $x; # already rounded by badd() or no round necc.
949 # increment arg by one
950 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
951 return $x if $x->modify('binc');
953 if ($x->{sign} eq '+')
955 $x->{value} = $CALC->_inc($x->{value});
956 return $x->round($a,$p,$r);
958 elsif ($x->{sign} eq '-')
960 $x->{value} = $CALC->_dec($x->{value});
961 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
962 return $x->round($a,$p,$r);
964 # inf, nan handling etc
965 $x->badd($self->__one(),$a,$p,$r); # badd does round
970 # decrement arg by one
971 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
972 return $x if $x->modify('bdec');
974 my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
976 if (($x->{sign} eq '-') || $zero)
978 $x->{value} = $CALC->_inc($x->{value});
979 $x->{sign} = '-' if $zero; # 0 => 1 => -1
980 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
981 return $x->round($a,$p,$r);
984 elsif ($x->{sign} eq '+')
986 $x->{value} = $CALC->_dec($x->{value});
987 return $x->round($a,$p,$r);
989 # inf, nan handling etc
990 $x->badd($self->__one('-'),$a,$p,$r); # badd does round
995 # not implemented yet
996 my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
998 return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
1005 # (BINT or num_str, BINT or num_str) return BINT
1006 # does not modify arguments, but returns new object
1007 # Lowest Common Multiplicator
1009 my $y = shift; my ($x);
1016 $x = $class->new($y);
1018 while (@_) { $x = __lcm($x,shift); }
1024 # (BINT or num_str, BINT or num_str) return BINT
1025 # does not modify arguments, but returns new object
1026 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
1029 $y = __PACKAGE__->new($y) if !ref($y);
1031 my $x = $y->copy(); # keep arguments
1032 if ($CALC->can('_gcd'))
1036 $y = shift; $y = $self->new($y) if !ref($y);
1037 next if $y->is_zero();
1038 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
1039 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
1046 $y = shift; $y = $self->new($y) if !ref($y);
1047 $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
1055 # (num_str or BINT) return BINT
1056 # represent ~x as twos-complement number
1057 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1058 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1060 return $x if $x->modify('bnot');
1061 $x->bneg()->bdec(); # bdec already does round
1064 # is_foo test routines
1068 # return true if arg (BINT or num_str) is zero (array '+', '0')
1069 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1070 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1072 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
1073 $CALC->_is_zero($x->{value});
1078 # return true if arg (BINT or num_str) is NaN
1079 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1081 return 1 if $x->{sign} eq $nan;
1087 # return true if arg (BINT or num_str) is +-inf
1088 my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1090 $sign = '' if !defined $sign;
1091 return 0 if $sign !~ /^([+-]|)$/;
1095 return 1 if ($x->{sign} =~ /^[+-]inf$/);
1098 $sign = quotemeta($sign.'inf');
1099 return 1 if ($x->{sign} =~ /^$sign$/);
1105 # return true if arg (BINT or num_str) is +1
1106 # or -1 if sign is given
1107 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1108 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1110 $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
1112 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
1113 $CALC->_is_one($x->{value});
1118 # return true when arg (BINT or num_str) is odd, false for even
1119 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1120 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1122 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1123 $CALC->_is_odd($x->{value});
1128 # return true when arg (BINT or num_str) is even, false for odd
1129 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1130 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1132 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1133 $CALC->_is_even($x->{value});
1138 # return true when arg (BINT or num_str) is positive (>= 0)
1139 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1140 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1142 return 1 if $x->{sign} =~ /^\+/;
1148 # return true when arg (BINT or num_str) is negative (< 0)
1149 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1150 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1152 return 1 if ($x->{sign} =~ /^-/);
1158 # return true when arg (BINT or num_str) is an integer
1159 # always true for BigInt, but different for Floats
1160 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1161 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1163 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1166 ###############################################################################
1170 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
1171 # (BINT or num_str, BINT or num_str) return BINT
1172 my ($self,$x,$y,@r) = objectify(2,@_);
1174 return $x if $x->modify('bmul');
1176 $r[3] = $y; # no push here
1178 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1181 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1183 return $x->bnan() if $x->is_zero() || $y->is_zero();
1184 # result will always be +-inf:
1185 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1186 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1187 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1188 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1189 return $x->binf('-');
1192 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1194 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1195 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1201 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1202 my ($self,$x,$y) = @_;
1204 # NaN if x == NaN or y == NaN or x==y==0
1205 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1206 if (($x->is_nan() || $y->is_nan()) ||
1207 ($x->is_zero() && $y->is_zero()));
1209 # +-inf / +-inf == NaN, reminder also NaN
1210 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1212 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
1214 # x / +-inf => 0, remainder x (works even if x == 0)
1215 if ($y->{sign} =~ /^[+-]inf$/)
1217 my $t = $x->copy(); # binf clobbers up $x
1218 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1221 # 5 / 0 => +inf, -6 / 0 => -inf
1222 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1223 # exception: -8 / 0 has remainder -8, not 8
1224 # exception: -inf / 0 has remainder -inf, not inf
1227 # +-inf / 0 => special case for -inf
1228 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1229 if (!$x->is_zero() && !$x->is_inf())
1231 my $t = $x->copy(); # binf clobbers up $x
1233 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1237 # last case: +-inf / ordinary number
1239 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1241 return wantarray ? ($x,$self->bzero()) : $x;
1246 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1247 # (BINT,BINT) (quo,rem) or BINT (only rem)
1248 my ($self,$x,$y,@r) = objectify(2,@_);
1250 return $x if $x->modify('bdiv');
1252 return $self->_div_inf($x,$y)
1253 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
1255 $r[3] = $y; # no push!
1259 wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
1261 # Is $x in the interval [0, $y) (aka $x <= $y) ?
1262 my $cmp = $CALC->_acmp($x->{value},$y->{value});
1263 if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
1265 return $upgrade->bdiv($x,$y,@r) if defined $upgrade;
1267 return $x->bzero()->round(@r) unless wantarray;
1268 my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
1269 return ($x->bzero()->round(@r),$t);
1273 # shortcut, both are the same, so set to +/- 1
1274 $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
1275 return $x unless wantarray;
1276 return ($x->round(@r),$self->bzero(@r));
1279 # calc new sign and in case $y == +/- 1, return $x
1280 my $xsign = $x->{sign}; # keep
1281 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1282 # check for / +-1 (cant use $y->is_one due to '-'
1283 if ($CALC->_is_one($y->{value}))
1285 return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
1290 my $rem = $self->bzero();
1291 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1292 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1294 if (! $CALC->_is_zero($rem->{value}))
1296 $rem->{sign} = $y->{sign};
1297 $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
1301 $rem->{sign} = '+'; # dont leave -0
1307 $x->{value} = $CALC->_div($x->{value},$y->{value});
1308 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1314 # modulus (or remainder)
1315 # (BINT or num_str, BINT or num_str) return BINT
1316 my ($self,$x,$y,@r) = objectify(2,@_);
1318 return $x if $x->modify('bmod');
1319 $r[3] = $y; # no push!
1320 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1322 my ($d,$r) = $self->_div_inf($x,$y);
1323 return $r->round(@r);
1326 if ($CALC->can('_mod'))
1328 # calc new sign and in case $y == +/- 1, return $x
1329 $x->{value} = $CALC->_mod($x->{value},$y->{value});
1330 if (!$CALC->_is_zero($x->{value}))
1332 my $xsign = $x->{sign};
1333 $x->{sign} = $y->{sign};
1334 $x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
1338 $x->{sign} = '+'; # dont leave -0
1340 return $x->round(@r);
1342 my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
1344 foreach (qw/value sign _a _p/)
1346 $x->{$_} = $rem->{$_};
1353 # (BINT or num_str, BINT or num_str) return BINT
1354 # compute factorial numbers
1355 # modifies first argument
1356 my ($self,$x,@r) = objectify(1,@_);
1358 return $x if $x->modify('bfac');
1360 return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
1361 return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
1363 if ($CALC->can('_fac'))
1365 $x->{value} = $CALC->_fac($x->{value});
1366 return $x->round(@r);
1371 my $f = $self->new(2);
1372 while ($f->bacmp($n) < 0)
1374 $x->bmul($f); $f->binc();
1376 $x->bmul($f); # last step
1377 $x->round(@r); # round
1382 # (BINT or num_str, BINT or num_str) return BINT
1383 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1384 # modifies first argument
1385 my ($self,$x,$y,@r) = objectify(2,@_);
1387 return $x if $x->modify('bpow');
1389 $r[3] = $y; # no push!
1390 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
1391 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1392 return $x->bone(@r) if $y->is_zero();
1393 return $x->round(@r) if $x->is_one() || $y->is_one();
1394 if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
1396 # if $x == -1 and odd/even y => +1/-1
1397 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
1398 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
1400 # 1 ** -y => 1 / (1 ** |y|)
1401 # so do test for negative $y after above's clause
1402 return $x->bnan() if $y->{sign} eq '-';
1403 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
1405 if ($CALC->can('_pow'))
1407 $x->{value} = $CALC->_pow($x->{value},$y->{value});
1408 return $x->round(@r);
1411 # based on the assumption that shifting in base 10 is fast, and that mul
1412 # works faster if numbers are small: we count trailing zeros (this step is
1413 # O(1)..O(N), but in case of O(N) we save much more time due to this),
1414 # stripping them out of the multiplication, and add $count * $y zeros
1415 # afterwards like this:
1416 # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1417 # creates deep recursion?
1418 # my $zeros = $x->_trailing_zeros();
1421 # $x->brsft($zeros,10); # remove zeros
1422 # $x->bpow($y); # recursion (will not branch into here again)
1423 # $zeros = $y * $zeros; # real number of zeros to add
1424 # $x->blsft($zeros,10);
1425 # return $x->round($a,$p,$r);
1428 my $pow2 = $self->__one();
1429 my $y1 = $class->new($y);
1430 my $two = $self->new(2);
1431 while (!$y1->is_one())
1433 $pow2->bmul($x) if $y1->is_odd();
1437 $x->bmul($pow2) unless $pow2->is_one();
1438 return $x->round(@r);
1443 # (BINT or num_str, BINT or num_str) return BINT
1444 # compute x << y, base n, y >= 0
1445 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1447 return $x if $x->modify('blsft');
1448 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1449 return $x->round($a,$p,$r) if $y->is_zero();
1451 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1453 my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
1456 $x->{value} = $t; return $x->round($a,$p,$r);
1459 return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
1464 # (BINT or num_str, BINT or num_str) return BINT
1465 # compute x >> y, base n, y >= 0
1466 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1468 return $x if $x->modify('brsft');
1469 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1470 return $x->round($a,$p,$r) if $y->is_zero();
1471 return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
1473 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1475 # this only works for negative numbers when shifting in base 2
1476 if (($x->{sign} eq '-') && ($n == 2))
1478 return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
1481 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1482 # but perhaps there is a better emulation for two's complement shift...
1483 # if $y != 1, we must simulate it by doing:
1484 # convert to bin, flip all bits, shift, and be done
1485 $x->binc(); # -3 => -2
1486 my $bin = $x->as_bin();
1487 $bin =~ s/^-0b//; # strip '-0b' prefix
1488 $bin =~ tr/10/01/; # flip bits
1490 if (length($bin) <= $y)
1492 $bin = '0'; # shifting to far right creates -1
1493 # 0, because later increment makes
1494 # that 1, attached '-' makes it '-1'
1495 # because -1 >> x == -1 !
1499 $bin =~ s/.{$y}$//; # cut off at the right side
1500 $bin = '1' . $bin; # extend left side by one dummy '1'
1501 $bin =~ tr/10/01/; # flip bits back
1503 my $res = $self->new('0b'.$bin); # add prefix and convert back
1504 $res->binc(); # remember to increment
1505 $x->{value} = $res->{value}; # take over value
1506 return $x->round($a,$p,$r); # we are done now, magic, isn't?
1508 $x->bdec(); # n == 2, but $y == 1: this fixes it
1511 my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
1515 return $x->round($a,$p,$r);
1518 $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
1524 #(BINT or num_str, BINT or num_str) return BINT
1526 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1528 return $x if $x->modify('band');
1530 local $Math::BigInt::upgrade = undef;
1532 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1533 return $x->bzero() if $y->is_zero() || $x->is_zero();
1535 my $sign = 0; # sign of result
1536 $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1537 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1538 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1540 if ($CALC->can('_and') && $sx == 1 && $sy == 1)
1542 $x->{value} = $CALC->_and($x->{value},$y->{value});
1543 return $x->round($a,$p,$r);
1546 my $m = $self->bone(); my ($xr,$yr);
1547 my $x10000 = $self->new (0x1000);
1548 my $y1 = copy(ref($x),$y); # make copy
1549 $y1->babs(); # and positive
1550 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1551 use integer; # need this for negative bools
1552 while (!$x1->is_zero() && !$y1->is_zero())
1554 ($x1, $xr) = bdiv($x1, $x10000);
1555 ($y1, $yr) = bdiv($y1, $x10000);
1556 # make both op's numbers!
1557 $x->badd( bmul( $class->new(
1558 abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1562 $x->bneg() if $sign;
1563 return $x->round($a,$p,$r);
1568 #(BINT or num_str, BINT or num_str) return BINT
1570 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1572 return $x if $x->modify('bior');
1574 local $Math::BigInt::upgrade = undef;
1576 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1577 return $x if $y->is_zero();
1579 my $sign = 0; # sign of result
1580 $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1581 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1582 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1584 # don't use lib for negative values
1585 if ($CALC->can('_or') && $sx == 1 && $sy == 1)
1587 $x->{value} = $CALC->_or($x->{value},$y->{value});
1588 return $x->round($a,$p,$r);
1591 my $m = $self->bone(); my ($xr,$yr);
1592 my $x10000 = $self->new(0x10000);
1593 my $y1 = copy(ref($x),$y); # make copy
1594 $y1->babs(); # and positive
1595 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1596 use integer; # need this for negative bools
1597 while (!$x1->is_zero() || !$y1->is_zero())
1599 ($x1, $xr) = bdiv($x1,$x10000);
1600 ($y1, $yr) = bdiv($y1,$x10000);
1601 # make both op's numbers!
1602 $x->badd( bmul( $class->new(
1603 abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1607 $x->bneg() if $sign;
1608 return $x->round($a,$p,$r);
1613 #(BINT or num_str, BINT or num_str) return BINT
1615 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1617 return $x if $x->modify('bxor');
1619 local $Math::BigInt::upgrade = undef;
1621 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1622 return $x if $y->is_zero();
1624 my $sign = 0; # sign of result
1625 $sign = 1 if $x->{sign} ne $y->{sign};
1626 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1627 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1629 # don't use lib for negative values
1630 if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
1632 $x->{value} = $CALC->_xor($x->{value},$y->{value});
1633 return $x->round($a,$p,$r);
1636 my $m = $self->bone(); my ($xr,$yr);
1637 my $x10000 = $self->new(0x10000);
1638 my $y1 = copy(ref($x),$y); # make copy
1639 $y1->babs(); # and positive
1640 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1641 use integer; # need this for negative bools
1642 while (!$x1->is_zero() || !$y1->is_zero())
1644 ($x1, $xr) = bdiv($x1, $x10000);
1645 ($y1, $yr) = bdiv($y1, $x10000);
1646 # make both op's numbers!
1647 $x->badd( bmul( $class->new(
1648 abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1652 $x->bneg() if $sign;
1653 return $x->round($a,$p,$r);
1658 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1660 my $e = $CALC->_len($x->{value});
1661 return wantarray ? ($e,0) : $e;
1666 # return the nth decimal digit, negative values count backward, 0 is right
1670 return $CALC->_digit($x->{value},$n);
1675 # return the amount of trailing zeros in $x
1677 $x = $class->new($x) unless ref $x;
1679 return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
1681 return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1683 # if not: since we do not know underlying internal representation:
1684 my $es = "$x"; $es =~ /([0]*)$/;
1685 return 0 if !defined $1; # no zeros
1686 return CORE::length("$1"); # as string, not as +0!
1691 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1693 return $x if $x->modify('bsqrt');
1695 return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
1696 return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
1697 return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
1699 return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
1701 if ($CALC->can('_sqrt'))
1703 $x->{value} = $CALC->_sqrt($x->{value});
1704 return $x->round($a,$p,$r);
1707 return $x->bone($a,$p) if $x < 4; # 2,3 => 1
1709 my $l = int($x->length()/2);
1711 $x->bone(); # keep ref($x), but modify it
1714 my $last = $self->bzero();
1715 my $two = $self->new(2);
1716 my $lastlast = $x+$two;
1717 while ($last != $x && $lastlast != $x)
1719 $lastlast = $last; $last = $x;
1723 $x-- if $x * $x > $y; # overshot?
1724 $x->round($a,$p,$r);
1729 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
1730 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1732 if ($x->{sign} !~ /^[+-]$/)
1734 my $s = $x->{sign}; $s =~ s/^[+-]//;
1735 return $self->new($s); # -inf,+inf => inf
1737 my $e = $class->bzero();
1738 return $e->binc() if $x->is_zero();
1739 $e += $x->_trailing_zeros();
1745 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
1746 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1748 if ($x->{sign} !~ /^[+-]$/)
1750 my $s = $x->{sign}; $s =~ s/^[+]//;
1751 return $self->new($s); # +inf => inf
1754 # that's inefficient
1755 my $zeros = $m->_trailing_zeros();
1756 $m /= 10 ** $zeros if $zeros != 0;
1762 # return a copy of both the exponent and the mantissa
1763 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1765 return ($x->mantissa(),$x->exponent());
1768 ##############################################################################
1769 # rounding functions
1773 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1774 # $n == 0 || $n == 1 => round to integer
1775 my $x = shift; $x = $class->new($x) unless ref $x;
1776 my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
1777 return $x if !defined $scale; # no-op
1778 return $x if $x->modify('bfround');
1780 # no-op for BigInts if $n <= 0
1783 $x->{_a} = undef; # clear an eventual set A
1784 $x->{_p} = $scale; return $x;
1787 $x->bround( $x->length()-$scale, $mode);
1788 $x->{_a} = undef; # bround sets {_a}
1789 $x->{_p} = $scale; # so correct it
1793 sub _scan_for_nonzero
1799 my $len = $x->length();
1800 return 0 if $len == 1; # '5' is trailed by invisible zeros
1801 my $follow = $pad - 1;
1802 return 0 if $follow > $len || $follow < 1;
1804 # since we do not know underlying represention of $x, use decimal string
1805 #my $r = substr ($$xs,-$follow);
1806 my $r = substr ("$x",-$follow);
1807 return 1 if $r =~ /[^0]/; return 0;
1812 # to make life easier for switch between MBF and MBI (autoload fxxx()
1813 # like MBF does for bxxx()?)
1815 return $x->bround(@_);
1820 # accuracy: +$n preserve $n digits from left,
1821 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1823 # and overwrite the rest with 0's, return normalized number
1824 # do not return $x->bnorm(), but $x
1826 my $x = shift; $x = $class->new($x) unless ref $x;
1827 my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
1828 return $x if !defined $scale; # no-op
1829 return $x if $x->modify('bround');
1831 if ($x->is_zero() || $scale == 0)
1833 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
1836 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
1838 # we have fewer digits than we want to scale to
1839 my $len = $x->length();
1840 # scale < 0, but > -len (not >=!)
1841 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
1843 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
1847 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1848 my ($pad,$digit_round,$digit_after);
1849 $pad = $len - $scale;
1850 $pad = abs($scale-1) if $scale < 0;
1852 # do not use digit(), it is costly for binary => decimal
1854 my $xs = $CALC->_str($x->{value});
1857 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1858 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
1859 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1860 $pl++; $pl ++ if $pad >= $len;
1861 $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
1863 # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
1865 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1866 # closer at the remaining digits of the original $x, remember decision
1867 my $round_up = 1; # default round up
1869 ($mode eq 'trunc') || # trunc by round down
1870 ($digit_after =~ /[01234]/) || # round down anyway,
1872 ($digit_after eq '5') && # not 5000...0000
1873 ($x->_scan_for_nonzero($pad,$xs) == 0) &&
1875 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1876 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
1877 ($mode eq '+inf') && ($x->{sign} eq '-') ||
1878 ($mode eq '-inf') && ($x->{sign} eq '+') ||
1879 ($mode eq 'zero') # round down if zero, sign adjusted below
1881 my $put_back = 0; # not yet modified
1883 # old code, depend on internal representation
1884 # split mantissa at $pad and then pad with zeros
1885 #my $s5 = int($pad / 5);
1889 # $x->{value}->[$i++] = 0; # replace with 5 x 0
1891 #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
1892 #my $rem = $pad % 5; # so much left over
1895 # #print "remainder $rem\n";
1896 ## #print "elem $x->{value}->[$s5]\n";
1897 # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
1899 #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
1900 #print ${$CALC->_str($pad->{value})}," $len\n";
1902 if (($pad > 0) && ($pad <= $len))
1904 substr($$xs,-$pad,$pad) = '0' x $pad;
1909 $x->bzero(); # round to '0'
1912 if ($round_up) # what gave test above?
1915 $pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
1917 # we modify directly the string variant instead of creating a number and
1919 my $c = 0; $pad ++; # for $pad == $len case
1920 while ($pad <= $len)
1922 $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
1923 substr($$xs,-$pad,1) = $c; $pad++;
1924 last if $c != 0; # no overflow => early out
1926 $$xs = '1'.$$xs if $c == 0;
1928 # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
1930 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
1932 $x->{_a} = $scale if $scale >= 0;
1935 $x->{_a} = $len+$scale;
1936 $x->{_a} = 0 if $scale < -$len;
1943 # return integer less or equal then number, since it is already integer,
1944 # always returns $self
1945 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1947 # not needed: return $x if $x->modify('bfloor');
1948 return $x->round($a,$p,$r);
1953 # return integer greater or equal then number, since it is already integer,
1954 # always returns $self
1955 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1957 # not needed: return $x if $x->modify('bceil');
1958 return $x->round($a,$p,$r);
1961 ##############################################################################
1962 # private stuff (internal use only)
1966 # internal speedup, set argument to 1, or create a +/- 1
1968 my $x = $self->bone(); # $x->{value} = $CALC->_one();
1969 $x->{sign} = shift || '+';
1975 # Overload will swap params if first one is no object ref so that the first
1976 # one is always an object ref. In this case, third param is true.
1977 # This routine is to overcome the effect of scalar,$object creating an object
1978 # of the class of this package, instead of the second param $object. This
1979 # happens inside overload, when the overload section of this package is
1980 # inherited by sub classes.
1981 # For overload cases (and this is used only there), we need to preserve the
1982 # args, hence the copy().
1983 # You can override this method in a subclass, the overload section will call
1984 # $object->_swap() to make sure it arrives at the proper subclass, with some
1985 # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
1986 # specify your own overload for them.
1988 # object, (object|scalar) => preserve first and make copy
1989 # scalar, object => swapped, re-swap and create new from first
1990 # (using class of second object, not $class!!)
1991 my $self = shift; # for override in subclass
1994 my $c = ref ($_[0]) || $class; # fallback $class should not happen
1995 return ( $c->new($_[1]), $_[0] );
1997 return ( $_[0]->copy(), $_[1] );
2002 # check for strings, if yes, return objects instead
2004 # the first argument is number of args objectify() should look at it will
2005 # return $count+1 elements, the first will be a classname. This is because
2006 # overloaded '""' calls bstr($object,undef,undef) and this would result in
2007 # useless objects beeing created and thrown away. So we cannot simple loop
2008 # over @_. If the given count is 0, all arguments will be used.
2010 # If the second arg is a ref, use it as class.
2011 # If not, try to use it as classname, unless undef, then use $class
2012 # (aka Math::BigInt). The latter shouldn't happen,though.
2015 # $x->badd(1); => ref x, scalar y
2016 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2017 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2018 # Math::BigInt::badd(1,2); => scalar x, scalar y
2019 # In the last case we check number of arguments to turn it silently into
2020 # $class,1,2. (We can not take '1' as class ;o)
2021 # badd($class,1) is not supported (it should, eventually, try to add undef)
2022 # currently it tries 'Math::BigInt' + 1, which will not work.
2024 # some shortcut for the common cases
2027 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
2028 # $x->binary_op($y);
2029 #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2)
2030 # && ref($_[1]) && ref($_[2]);
2032 my $count = abs(shift || 0);
2034 my @a; # resulting array
2037 # okay, got object as first
2042 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2044 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2046 # print "Now in objectify, my class is today $a[0]\n";
2055 $k = $a[0]->new($k);
2057 elsif (ref($k) ne $a[0])
2059 # foreign object, try to convert to integer
2060 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
2073 $k = $a[0]->new($k);
2075 elsif (ref($k) ne $a[0])
2077 # foreign object, try to convert to integer
2078 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
2082 push @a,@_; # return other params, too
2084 die "$class objectify needs list context" unless wantarray;
2093 my @a = @_; my $l = scalar @_; my $j = 0;
2094 for ( my $i = 0; $i < $l ; $i++,$j++ )
2096 if ($_[$i] eq ':constant')
2098 # this causes overlord er load to step in
2099 overload::constant integer => sub { $self->new(shift) };
2100 splice @a, $j, 1; $j --;
2102 elsif ($_[$i] eq 'upgrade')
2104 # this causes upgrading
2105 $upgrade = $_[$i+1]; # or undef to disable
2106 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
2107 splice @a, $j, $s; $j -= $s;
2109 elsif ($_[$i] =~ /^lib$/i)
2111 # this causes a different low lib to take care...
2112 $CALC = $_[$i+1] || '';
2113 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
2114 splice @a, $j, $s; $j -= $s;
2117 # any non :constant stuff is handled by our parent, Exporter
2118 # even if @_ is empty, to give it a chance
2119 $self->SUPER::import(@a); # need it for subclasses
2120 $self->export_to_level(1,$self,@a); # need it for MBF
2122 # try to load core math lib
2123 my @c = split /\s*,\s*/,$CALC;
2124 push @c,'Calc'; # if all fail, try this
2125 $CALC = ''; # signal error
2126 foreach my $lib (@c)
2128 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2132 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
2133 # used in the same script, or eval inside import().
2134 (my $mod = $lib . '.pm') =~ s!::!/!g;
2135 # require does not automatically :: => /, so portability problems arise
2136 eval { require $mod; $lib->import( @c ); }
2140 eval "use $lib qw/@c/;";
2142 $CALC = $lib, last if $@ eq ''; # no error in loading lib?
2144 die "Couldn't load any math lib, not even the default" if $CALC eq '';
2149 # convert a (ref to) big hex string to BigInt, return undef for error
2152 my $x = Math::BigInt->bzero();
2155 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2156 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2158 return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
2160 my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
2162 $$hs =~ s/^[+-]//; # strip sign
2163 if ($CALC->can('_from_hex'))
2165 $x->{value} = $CALC->_from_hex($hs);
2169 # fallback to pure perl
2170 my $mul = Math::BigInt->bzero(); $mul++;
2171 my $x65536 = Math::BigInt->new(65536);
2172 my $len = CORE::length($$hs)-2;
2173 $len = int($len/4); # 4-digit parts, w/o '0x'
2174 my $val; my $i = -4;
2177 $val = substr($$hs,$i,4);
2178 $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
2179 $val = hex($val); # hex does not like wrong chars
2181 $x += $mul * $val if $val != 0;
2182 $mul *= $x65536 if $len >= 0; # skip last mul
2185 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2191 # convert a (ref to) big binary string to BigInt, return undef for error
2194 my $x = Math::BigInt->bzero();
2196 $$bs =~ s/([01])_([01])/$1$2/g;
2197 $$bs =~ s/([01])_([01])/$1$2/g;
2198 return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
2200 my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
2201 $$bs =~ s/^[+-]//; # strip sign
2202 if ($CALC->can('_from_bin'))
2204 $x->{value} = $CALC->_from_bin($bs);
2208 my $mul = Math::BigInt->bzero(); $mul++;
2209 my $x256 = Math::BigInt->new(256);
2210 my $len = CORE::length($$bs)-2;
2211 $len = int($len/8); # 8-digit parts, w/o '0b'
2212 my $val; my $i = -8;
2215 $val = substr($$bs,$i,8);
2216 $val =~ s/^[+-]?0b// if $len == 0; # for last part only
2217 #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
2219 # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
2220 $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
2222 $x += $mul * $val if $val != 0;
2223 $mul *= $x256 if $len >= 0; # skip last mul
2226 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2232 # (ref to num_str) return num_str
2233 # internal, take apart a string and return the pieces
2234 # strip leading/trailing whitespace, leading zeros, underscore and reject
2238 # strip white space at front, also extranous leading zeros
2239 $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2240 $$x =~ s/^\s+//; # but this will
2241 $$x =~ s/\s+$//g; # strip white space at end
2243 # shortcut, if nothing to split, return early
2244 if ($$x =~ /^[+-]?\d+$/)
2246 $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2247 return (\$sign, $x, \'', \'', \0);
2250 # invalid starting char?
2251 return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
2253 return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
2254 return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
2256 # strip underscores between digits
2257 $$x =~ s/(\d)_(\d)/$1$2/g;
2258 $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
2260 # some possible inputs:
2261 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
2262 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
2264 return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
2266 my ($m,$e) = split /[Ee]/,$$x;
2267 $e = '0' if !defined $e || $e eq "";
2268 # sign,value for exponent,mantint,mantfrac
2269 my ($es,$ev,$mis,$miv,$mfv);
2271 if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2275 return if $m eq '.' || $m eq '';
2276 my ($mi,$mf) = split /\./,$m;
2277 $mi = '0' if !defined $mi;
2278 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2279 $mf = '0' if !defined $mf || $mf eq '';
2280 if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2282 $mis = $1||'+'; $miv = $2;
2283 return unless ($mf =~ /^(\d*?)0*$/); # strip trailing zeros
2285 return (\$mis,\$miv,\$mfv,\$es,\$ev);
2288 return; # NaN, not a number
2293 # an object might be asked to return itself as bigint on certain overloaded
2294 # operations, this does exactly this, so that sub classes can simple inherit
2295 # it or override with their own integer conversion routine
2303 # return as hex string, with prefixed 0x
2304 my $x = shift; $x = $class->new($x) if !ref($x);
2306 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2307 return '0x0' if $x->is_zero();
2309 my $es = ''; my $s = '';
2310 $s = $x->{sign} if $x->{sign} eq '-';
2311 if ($CALC->can('_as_hex'))
2313 $es = ${$CALC->_as_hex($x->{value})};
2317 my $x1 = $x->copy()->babs(); my $xr;
2318 my $x10000 = Math::BigInt->new (0x10000);
2319 while (!$x1->is_zero())
2321 ($x1, $xr) = bdiv($x1,$x10000);
2322 $es .= unpack('h4',pack('v',$xr->numify()));
2325 $es =~ s/^[0]+//; # strip leading zeros
2333 # return as binary string, with prefixed 0b
2334 my $x = shift; $x = $class->new($x) if !ref($x);
2336 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2337 return '0b0' if $x->is_zero();
2339 my $es = ''; my $s = '';
2340 $s = $x->{sign} if $x->{sign} eq '-';
2341 if ($CALC->can('_as_bin'))
2343 $es = ${$CALC->_as_bin($x->{value})};
2347 my $x1 = $x->copy()->babs(); my $xr;
2348 my $x10000 = Math::BigInt->new (0x10000);
2349 while (!$x1->is_zero())
2351 ($x1, $xr) = bdiv($x1,$x10000);
2352 $es .= unpack('b16',pack('v',$xr->numify()));
2355 $es =~ s/^[0]+//; # strip leading zeros
2361 ##############################################################################
2362 # internal calculation routines (others are in Math::BigInt::Calc etc)
2366 # (BINT or num_str, BINT or num_str) return BINT
2367 # does modify first argument
2370 my $x = shift; my $ty = shift;
2371 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
2372 return $x * $ty / bgcd($x,$ty);
2377 # (BINT or num_str, BINT or num_str) return BINT
2378 # does modify both arguments
2379 # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
2382 return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
2384 while (!$ty->is_zero())
2386 ($x, $ty) = ($ty,bmod($x,$ty));
2391 ###############################################################################
2392 # this method return 0 if the object can be modified, or 1 for not
2393 # We use a fast use constant statement here, to avoid costly calls. Subclasses
2394 # may override it with special code (f.i. Math::BigInt::Constant does so)
2396 sub modify () { 0; }
2403 Math::BigInt - Arbitrary size integer math package
2410 $x = Math::BigInt->new($str); # defaults to 0
2411 $nan = Math::BigInt->bnan(); # create a NotANumber
2412 $zero = Math::BigInt->bzero(); # create a +0
2413 $inf = Math::BigInt->binf(); # create a +inf
2414 $inf = Math::BigInt->binf('-'); # create a -inf
2415 $one = Math::BigInt->bone(); # create a +1
2416 $one = Math::BigInt->bone('-'); # create a -1
2419 $x->is_zero(); # true if arg is +0
2420 $x->is_nan(); # true if arg is NaN
2421 $x->is_one(); # true if arg is +1
2422 $x->is_one('-'); # true if arg is -1
2423 $x->is_odd(); # true if odd, false for even
2424 $x->is_even(); # true if even, false for odd
2425 $x->is_positive(); # true if >= 0
2426 $x->is_negative(); # true if < 0
2427 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
2428 $x->is_int(); # true if $x is an integer (not a float)
2430 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2431 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2432 $x->sign(); # return the sign, either +,- or NaN
2433 $x->digit($n); # return the nth digit, counting from right
2434 $x->digit(-$n); # return the nth digit, counting from left
2436 # The following all modify their first argument:
2439 $x->bzero(); # set $x to 0
2440 $x->bnan(); # set $x to NaN
2441 $x->bone(); # set $x to +1
2442 $x->bone('-'); # set $x to -1
2443 $x->binf(); # set $x to inf
2444 $x->binf('-'); # set $x to -inf
2446 $x->bneg(); # negation
2447 $x->babs(); # absolute value
2448 $x->bnorm(); # normalize (no-op)
2449 $x->bnot(); # two's complement (bit wise not)
2450 $x->binc(); # increment x by 1
2451 $x->bdec(); # decrement x by 1
2453 $x->badd($y); # addition (add $y to $x)
2454 $x->bsub($y); # subtraction (subtract $y from $x)
2455 $x->bmul($y); # multiplication (multiply $x by $y)
2456 $x->bdiv($y); # divide, set $x to quotient
2457 # return (quo,rem) or quo if scalar
2459 $x->bmod($y); # modulus (x % y)
2460 $x->bpow($y); # power of arguments (x ** y)
2461 $x->blsft($y); # left shift
2462 $x->brsft($y); # right shift
2463 $x->blsft($y,$n); # left shift, by base $n (like 10)
2464 $x->brsft($y,$n); # right shift, by base $n (like 10)
2466 $x->band($y); # bitwise and
2467 $x->bior($y); # bitwise inclusive or
2468 $x->bxor($y); # bitwise exclusive or
2469 $x->bnot(); # bitwise not (two's complement)
2471 $x->bsqrt(); # calculate square-root
2472 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
2474 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2475 $x->bround($N); # accuracy: preserve $N digits
2476 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2478 # The following do not modify their arguments in BigInt, but do in BigFloat:
2479 $x->bfloor(); # return integer less or equal than $x
2480 $x->bceil(); # return integer greater or equal than $x
2482 # The following do not modify their arguments:
2484 bgcd(@values); # greatest common divisor (no OO style)
2485 blcm(@values); # lowest common multiplicator (no OO style)
2487 $x->length(); # return number of digits in number
2488 ($x,$f) = $x->length(); # length of number and length of fraction part,
2489 # latter is always 0 digits long for BigInt's
2491 $x->exponent(); # return exponent as BigInt
2492 $x->mantissa(); # return (signed) mantissa as BigInt
2493 $x->parts(); # return (mantissa,exponent) as BigInt
2494 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2495 $x->as_number(); # return as BigInt (in BigInt: same as copy())
2497 # conversation to string
2498 $x->bstr(); # normalized string
2499 $x->bsstr(); # normalized string in scientific notation
2500 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2501 $x->as_bin(); # as signed binary string with prefixed 0b
2505 All operators (inlcuding basic math operations) are overloaded if you
2506 declare your big integers as
2508 $i = new Math::BigInt '123_456_789_123_456_789';
2510 Operations with overloaded operators preserve the arguments which is
2511 exactly what you expect.
2515 =item Canonical notation
2517 Big integer values are strings of the form C</^[+-]\d+$/> with leading
2520 '-0' canonical value '-0', normalized '0'
2521 ' -123_123_123' canonical value '-123123123'
2522 '1_23_456_7890' canonical value '1234567890'
2526 Input values to these routines may be either Math::BigInt objects or
2527 strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2529 You can include one underscore between any two digits.
2531 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2532 Non integer values result in NaN.
2534 Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2537 bnorm() on a BigInt object is now effectively a no-op, since the numbers
2538 are always stored in normalized form. On a string, it creates a BigInt
2543 Output values are BigInt objects (normalized), except for bstr(), which
2544 returns a string in normalized form.
2545 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2546 C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2547 return either undef, <0, 0 or >0 and are suited for sort.
2553 Each of the methods below accepts three additional parameters. These arguments
2554 $A, $P and $R are accuracy, precision and round_mode. Please see more in the
2555 section about ACCURACY and ROUNDIND.
2559 $x->accuracy(5); # local for $x
2560 $class->accuracy(5); # global for all members of $class
2562 Set or get the global or local accuracy, aka how many significant digits the
2563 results have. Please see the section about L<ACCURACY AND PRECISION> for
2566 Value must be greater than zero. Pass an undef value to disable it:
2568 $x->accuracy(undef);
2569 Math::BigInt->accuracy(undef);
2571 Returns the current accuracy. For C<$x->accuracy()> it will return either the
2572 local accuracy, or if not defined, the global. This means the return value
2573 represents the accuracy that will be in effect for $x:
2575 $y = Math::BigInt->new(1234567); # unrounded
2576 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
2577 $x = Math::BigInt->new(123456); # will be automatically rounded
2578 print "$x $y\n"; # '123500 1234567'
2579 print $x->accuracy(),"\n"; # will be 4
2580 print $y->accuracy(),"\n"; # also 4, since global is 4
2581 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
2582 print $x->accuracy(),"\n"; # still 4
2583 print $y->accuracy(),"\n"; # 5, since global is 5
2589 Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
2590 2, but others work, too.
2592 Right shifting usually amounts to dividing $x by $n ** $y and truncating the
2596 $x = Math::BigInt->new(10);
2597 $x->brsft(1); # same as $x >> 1: 5
2598 $x = Math::BigInt->new(1234);
2599 $x->brsft(2,10); # result 12
2601 There is one exception, and that is base 2 with negative $x:
2604 $x = Math::BigInt->new(-5);
2607 This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
2612 $x = Math::BigInt->new($str,$A,$P,$R);
2614 Creates a new BigInt object from a string or another BigInt object. The
2615 input is accepted as decimal, hex (with leading '0x') or binary (with leading
2620 $x = Math::BigInt->bnan();
2622 Creates a new BigInt object representing NaN (Not A Number).
2623 If used on an object, it will set it to NaN:
2629 $x = Math::BigInt->bzero();
2631 Creates a new BigInt object representing zero.
2632 If used on an object, it will set it to zero:
2638 $x = Math::BigInt->binf($sign);
2640 Creates a new BigInt object representing infinity. The optional argument is
2641 either '-' or '+', indicating whether you want infinity or minus infinity.
2642 If used on an object, it will set it to infinity:
2649 $x = Math::BigInt->binf($sign);
2651 Creates a new BigInt object representing one. The optional argument is
2652 either '-' or '+', indicating whether you want one or minus one.
2653 If used on an object, it will set it to one:
2658 =head2 is_one() / is_zero() / is_nan() / is_positive() / is_negative() /
2659 is_inf() / is_odd() / is_even() / is_int()
2661 $x->is_zero(); # true if arg is +0
2662 $x->is_nan(); # true if arg is NaN
2663 $x->is_one(); # true if arg is +1
2664 $x->is_one('-'); # true if arg is -1
2665 $x->is_odd(); # true if odd, false for even
2666 $x->is_even(); # true if even, false for odd
2667 $x->is_positive(); # true if >= 0
2668 $x->is_negative(); # true if < 0
2669 $x->is_inf(); # true if +inf
2670 $x->is_inf('-'); # true if -inf (sign is default '+')
2671 $x->is_int(); # true if $x is an integer
2673 These methods all test the BigInt for one condition and return true or false
2674 depending on the input.
2678 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2682 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2686 $x->sign(); # return the sign, either +,- or NaN
2690 $x->digit($n); # return the nth digit, counting from right
2696 Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
2697 and '-inf', respectively. Does nothing for NaN or zero.
2703 Set the number to it's absolute value, e.g. change the sign from '-' to '+'
2704 and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
2709 $x->bnorm(); # normalize (no-op)
2713 $x->bnot(); # two's complement (bit wise not)
2717 $x->binc(); # increment x by 1
2721 $x->bdec(); # decrement x by 1
2725 $x->badd($y); # addition (add $y to $x)
2729 $x->bsub($y); # subtraction (subtract $y from $x)
2733 $x->bmul($y); # multiplication (multiply $x by $y)
2737 $x->bdiv($y); # divide, set $x to quotient
2738 # return (quo,rem) or quo if scalar
2742 $x->bmod($y); # modulus (x % y)
2746 $x->bpow($y); # power of arguments (x ** y)
2750 $x->blsft($y); # left shift
2751 $x->blsft($y,$n); # left shift, by base $n (like 10)
2755 $x->brsft($y); # right shift
2756 $x->brsft($y,$n); # right shift, by base $n (like 10)
2760 $x->band($y); # bitwise and
2764 $x->bior($y); # bitwise inclusive or
2768 $x->bxor($y); # bitwise exclusive or
2772 $x->bnot(); # bitwise not (two's complement)
2776 $x->bsqrt(); # calculate square-root
2780 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
2784 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2788 $x->bround($N); # accuracy: preserve $N digits
2792 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2798 Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
2799 does change $x in BigFloat.
2805 Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
2806 does change $x in BigFloat.
2810 bgcd(@values); # greatest common divisor (no OO style)
2814 blcm(@values); # lowest common multiplicator (no OO style)
2819 ($xl,$fl) = $x->length();
2821 Returns the number of digits in the decimal representation of the number.
2822 In list context, returns the length of the integer and fraction part. For
2823 BigInt's, the length of the fraction part will always be 0.
2829 Return the exponent of $x as BigInt.
2835 Return the signed mantissa of $x as BigInt.
2839 $x->parts(); # return (mantissa,exponent) as BigInt
2843 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2847 $x->as_number(); # return as BigInt (in BigInt: same as copy())
2851 $x->bstr(); # normalized string
2855 $x->bsstr(); # normalized string in scientific notation
2859 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2863 $x->as_bin(); # as signed binary string with prefixed 0b
2865 =head1 ACCURACY and PRECISION
2867 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
2868 accuracy and precision based rounding, both automatically after every
2869 operation as well as manually.
2871 This section describes the accuracy/precision handling in Math::Big* as it
2872 used to be and as it is now, complete with an explanation of all terms and
2875 Not yet implemented things (but with correct description) are marked with '!',
2876 things that need to be answered are marked with '?'.
2878 In the next paragraph follows a short description of terms used here (because
2879 these may differ from terms used by others people or documentation).
2881 During the rest of this document, the shortcuts A (for accuracy), P (for
2882 precision), F (fallback) and R (rounding mode) will be used.
2886 A fixed number of digits before (positive) or after (negative)
2887 the decimal point. For example, 123.45 has a precision of -2. 0 means an
2888 integer like 123 (or 120). A precision of 2 means two digits to the left
2889 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2890 numbers with zeros before the decimal point may have different precisions,
2891 because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2892 was). It could also have p < 0, when the digits after the decimal point
2895 The string output (of floating point numbers) will be padded with zeros:
2897 Initial value P A Result String
2898 ------------------------------------------------------------
2899 1234.01 -3 1000 1000
2902 1234.001 1 1234 1234.0
2904 1234.01 2 1234.01 1234.01
2905 1234.01 5 1234.01 1234.01000
2907 For BigInts, no padding occurs.
2911 Number of significant digits. Leading zeros are not counted. A
2912 number may have an accuracy greater than the non-zero digits
2913 when there are zeros in it or trailing zeros. For example, 123.456 has
2914 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
2916 The string output (of floating point numbers) will be padded with zeros:
2918 Initial value P A Result String
2919 ------------------------------------------------------------
2921 1234.01 6 1234.01 1234.01
2922 1234.1 8 1234.1 1234.1000
2924 For BigInts, no padding occurs.
2928 When both A and P are undefined, this is used as a fallback accuracy when
2931 =head2 Rounding mode R
2933 When rounding a number, different 'styles' or 'kinds'
2934 of rounding are possible. (Note that random rounding, as in
2935 Math::Round, is not implemented.)
2941 truncation invariably removes all digits following the
2942 rounding place, replacing them with zeros. Thus, 987.65 rounded
2943 to tens (P=1) becomes 980, and rounded to the fourth sigdig
2944 becomes 987.6 (A=4). 123.456 rounded to the second place after the
2945 decimal point (P=-2) becomes 123.46.
2947 All other implemented styles of rounding attempt to round to the
2948 "nearest digit." If the digit D immediately to the right of the
2949 rounding place (skipping the decimal point) is greater than 5, the
2950 number is incremented at the rounding place (possibly causing a
2951 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
2952 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
2953 truncated at the rounding place: e.g. when rounding to units, 0.4
2954 rounds to 0, and -19.4 rounds to -19.
2956 However the results of other styles of rounding differ if the
2957 digit immediately to the right of the rounding place (skipping the
2958 decimal point) is 5 and if there are no digits, or no digits other
2959 than 0, after that 5. In such cases:
2963 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
2964 if it is not already. E.g., when rounding to the first sigdig, 0.45
2965 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
2969 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
2970 it is not already. E.g., when rounding to the first sigdig, 0.45
2971 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
2975 round to plus infinity, i.e. always round up. E.g., when
2976 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
2977 and 0.4501 also becomes 0.5.
2981 round to minus infinity, i.e. always round down. E.g., when
2982 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
2983 but 0.4501 becomes 0.5.
2987 round to zero, i.e. positive numbers down, negative ones up.
2988 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
2989 becomes -0.5, but 0.4501 becomes 0.5.
2993 The handling of A & P in MBI/MBF (the old core code shipped with Perl
2994 versions <= 5.7.2) is like this:
3000 * ffround($p) is able to round to $p number of digits after the decimal
3002 * otherwise P is unused
3004 =item Accuracy (significant digits)
3006 * fround($a) rounds to $a significant digits
3007 * only fdiv() and fsqrt() take A as (optional) paramater
3008 + other operations simply create the same number (fneg etc), or more (fmul)
3010 + rounding/truncating is only done when explicitly calling one of fround
3011 or ffround, and never for BigInt (not implemented)
3012 * fsqrt() simply hands its accuracy argument over to fdiv.
3013 * the documentation and the comment in the code indicate two different ways
3014 on how fdiv() determines the maximum number of digits it should calculate,
3015 and the actual code does yet another thing
3017 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
3019 result has at most max(scale, length(dividend), length(divisor)) digits
3021 scale = max(scale, length(dividend)-1,length(divisor)-1);
3022 scale += length(divisior) - length(dividend);
3023 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
3024 Actually, the 'difference' added to the scale is calculated from the
3025 number of "significant digits" in dividend and divisor, which is derived
3026 by looking at the length of the mantissa. Which is wrong, since it includes
3027 the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
3028 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
3029 assumption that 124 has 3 significant digits, while 120/7 will get you
3030 '17', not '17.1' since 120 is thought to have 2 significant digits.
3031 The rounding after the division then uses the remainder and $y to determine
3032 wether it must round up or down.
3033 ? I have no idea which is the right way. That's why I used a slightly more
3034 ? simple scheme and tweaked the few failing testcases to match it.
3038 This is how it works now:
3042 =item Setting/Accessing
3044 * You can set the A global via Math::BigInt->accuracy() or
3045 Math::BigFloat->accuracy() or whatever class you are using.
3046 * You can also set P globally by using Math::SomeClass->precision() likewise.
3047 * Globals are classwide, and not inherited by subclasses.
3048 * to undefine A, use Math::SomeCLass->accuracy(undef);
3049 * to undefine P, use Math::SomeClass->precision(undef);
3050 * Setting Math::SomeClass->accuracy() clears automatically
3051 Math::SomeClass->precision(), and vice versa.
3052 * To be valid, A must be > 0, P can have any value.
3053 * If P is negative, this means round to the P'th place to the right of the
3054 decimal point; positive values mean to the left of the decimal point.
3055 P of 0 means round to integer.
3056 * to find out the current global A, take Math::SomeClass->accuracy()
3057 * to find out the current global P, take Math::SomeClass->precision()
3058 * use $x->accuracy() respective $x->precision() for the local setting of $x.
3059 * Please note that $x->accuracy() respecive $x->precision() fall back to the
3060 defined globals, when $x's A or P is not set.
3062 =item Creating numbers
3064 * When you create a number, you can give it's desired A or P via:
3065 $x = Math::BigInt->new($number,$A,$P);
3066 * Only one of A or P can be defined, otherwise the result is NaN
3067 * If no A or P is give ($x = Math::BigInt->new($number) form), then the
3068 globals (if set) will be used. Thus changing the global defaults later on
3069 will not change the A or P of previously created numbers (i.e., A and P of
3070 $x will be what was in effect when $x was created)
3071 * If given undef for A and P, B<no> rounding will occur, and the globals will
3072 B<not> be used. This is used by subclasses to create numbers without
3073 suffering rounding in the parent. Thus a subclass is able to have it's own
3074 globals enforced upon creation of a number by using
3075 $x = Math::BigInt->new($number,undef,undef):
3077 use Math::Bigint::SomeSubclass;
3080 Math::BigInt->accuracy(2);
3081 Math::BigInt::SomeSubClass->accuracy(3);
3082 $x = Math::BigInt::SomeSubClass->new(1234);
3084 $x is now 1230, and not 1200. A subclass might choose to implement
3085 this otherwise, e.g. falling back to the parent's A and P.
3089 * If A or P are enabled/defined, they are used to round the result of each
3090 operation according to the rules below
3091 * Negative P is ignored in Math::BigInt, since BigInts never have digits
3092 after the decimal point
3093 * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
3094 Math::BigInt as globals should not tamper with the parts of a BigFloat.
3095 Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
3099 * It only makes sense that a number has only one of A or P at a time.
3100 Since you can set/get both A and P, there is a rule that will practically
3101 enforce only A or P to be in effect at a time, even if both are set.
3102 This is called precedence.
3103 * If two objects are involved in an operation, and one of them has A in
3104 effect, and the other P, this results in an error (NaN).
3105 * A takes precendence over P (Hint: A comes before P). If A is defined, it
3106 is used, otherwise P is used. If neither of them is defined, nothing is
3107 used, i.e. the result will have as many digits as it can (with an
3108 exception for fdiv/fsqrt) and will not be rounded.
3109 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
3110 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
3111 If either the dividend's or the divisor's mantissa has more digits than
3112 the value of F, the higher value will be used instead of F.
3113 This is to limit the digits (A) of the result (just consider what would
3114 happen with unlimited A and P in the case of 1/3 :-)
3115 * fdiv will calculate (at least) 4 more digits than required (determined by
3116 A, P or F), and, if F is not used, round the result
3117 (this will still fail in the case of a result like 0.12345000000001 with A
3118 or P of 5, but this can not be helped - or can it?)
3119 * Thus you can have the math done by on Math::Big* class in three modes:
3120 + never round (this is the default):
3121 This is done by setting A and P to undef. No math operation
3122 will round the result, with fdiv() and fsqrt() as exceptions to guard
3123 against overflows. You must explicitely call bround(), bfround() or
3124 round() (the latter with parameters).
3125 Note: Once you have rounded a number, the settings will 'stick' on it
3126 and 'infect' all other numbers engaged in math operations with it, since
3127 local settings have the highest precedence. So, to get SaferRound[tm],
3128 use a copy() before rounding like this:
3130 $x = Math::BigFloat->new(12.34);
3131 $y = Math::BigFloat->new(98.76);
3132 $z = $x * $y; # 1218.6984
3133 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
3134 $z = $x * $y; # still 1218.6984, without
3135 # copy would have been 1210!
3137 + round after each op:
3138 After each single operation (except for testing like is_zero()), the
3139 method round() is called and the result is rounded appropriately. By
3140 setting proper values for A and P, you can have all-the-same-A or
3141 all-the-same-P modes. For example, Math::Currency might set A to undef,
3142 and P to -2, globally.
3144 ?Maybe an extra option that forbids local A & P settings would be in order,
3145 ?so that intermediate rounding does not 'poison' further math?
3147 =item Overriding globals
3149 * you will be able to give A, P and R as an argument to all the calculation
3150 routines; the second parameter is A, the third one is P, and the fourth is
3151 R (shift right by one for binary operations like badd). P is used only if
3152 the first parameter (A) is undefined. These three parameters override the
3153 globals in the order detailed as follows, i.e. the first defined value
3155 (local: per object, global: global default, parameter: argument to sub)
3158 + local A (if defined on both of the operands: smaller one is taken)
3159 + local P (if defined on both of the operands: bigger one is taken)
3163 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
3164 arguments (A and P) instead of one
3166 =item Local settings
3168 * You can set A and P locally by using $x->accuracy() and $x->precision()
3169 and thus force different A and P for different objects/numbers.
3170 * Setting A or P this way immediately rounds $x to the new value.
3171 * $x->accuracy() clears $x->precision(), and vice versa.
3175 * the rounding routines will use the respective global or local settings.
3176 fround()/bround() is for accuracy rounding, while ffround()/bfround()
3178 * the two rounding functions take as the second parameter one of the
3179 following rounding modes (R):
3180 'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
3181 * you can set and get the global R by using Math::SomeClass->round_mode()
3182 or by setting $Math::SomeClass::round_mode
3183 * after each operation, $result->round() is called, and the result may
3184 eventually be rounded (that is, if A or P were set either locally,
3185 globally or as parameter to the operation)
3186 * to manually round a number, call $x->round($A,$P,$round_mode);
3187 this will round the number by using the appropriate rounding function
3188 and then normalize it.
3189 * rounding modifies the local settings of the number:
3191 $x = Math::BigFloat->new(123.456);
3195 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
3196 will be 4 from now on.
3198 =item Default values
3207 * The defaults are set up so that the new code gives the same results as
3208 the old code (except in a few cases on fdiv):
3209 + Both A and P are undefined and thus will not be used for rounding
3210 after each operation.
3211 + round() is thus a no-op, unless given extra parameters A and P
3217 The actual numbers are stored as unsigned big integers (with seperate sign).
3218 You should neither care about nor depend on the internal representation; it
3219 might change without notice. Use only method calls like C<< $x->sign(); >>
3220 instead relying on the internal hash keys like in C<< $x->{sign}; >>.
3224 Math with the numbers is done (by default) by a module called
3225 Math::BigInt::Calc. This is equivalent to saying:
3227 use Math::BigInt lib => 'Calc';
3229 You can change this by using:
3231 use Math::BigInt lib => 'BitVect';
3233 The following would first try to find Math::BigInt::Foo, then
3234 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
3236 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
3238 Calc.pm uses as internal format an array of elements of some decimal base
3239 (usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm
3240 uses a bit vector of base 2, most significant bit first. Other modules might
3241 use even different means of representing the numbers. See the respective
3242 module documentation for further details.
3246 The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
3248 A sign of 'NaN' is used to represent the result when input arguments are not
3249 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
3250 minus infinity. You will get '+inf' when dividing a positive number by 0, and
3251 '-inf' when dividing any negative number by 0.
3253 =head2 mantissa(), exponent() and parts()
3255 C<mantissa()> and C<exponent()> return the said parts of the BigInt such
3258 $m = $x->mantissa();
3259 $e = $x->exponent();
3260 $y = $m * ( 10 ** $e );
3261 print "ok\n" if $x == $y;
3263 C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
3264 in one go. Both the returned mantissa and exponent have a sign.
3266 Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
3267 where it will be NaN; and for $x == 0, where it will be 1
3268 (to be compatible with Math::BigFloat's internal representation of a zero as
3271 C<$m> will always be a copy of the original number. The relation between $e
3272 and $m might change in the future, but will always be equivalent in a
3273 numerical sense, e.g. $m might get minimized.
3279 sub bint { Math::BigInt->new(shift); }
3281 $x = Math::BigInt->bstr("1234") # string "1234"
3282 $x = "$x"; # same as bstr()
3283 $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
3284 $x = Math::BigInt->babs("-12345"); # Bigint "12345"
3285 $x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
3286 $x = bint(1) + bint(2); # BigInt "3"
3287 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
3288 $x = bint(1); # BigInt "1"
3289 $x = $x + 5 / 2; # BigInt "3"
3290 $x = $x ** 3; # BigInt "27"
3291 $x *= 2; # BigInt "54"
3292 $x = Math::BigInt->new(0); # BigInt "0"
3294 $x = Math::BigInt->badd(4,5) # BigInt "9"
3295 print $x->bsstr(); # 9e+0
3297 Examples for rounding:
3302 $x = Math::BigFloat->new(123.4567);
3303 $y = Math::BigFloat->new(123.456789);
3304 Math::BigFloat->accuracy(4); # no more A than 4
3306 ok ($x->copy()->fround(),123.4); # even rounding
3307 print $x->copy()->fround(),"\n"; # 123.4
3308 Math::BigFloat->round_mode('odd'); # round to odd
3309 print $x->copy()->fround(),"\n"; # 123.5
3310 Math::BigFloat->accuracy(5); # no more A than 5
3311 Math::BigFloat->round_mode('odd'); # round to odd
3312 print $x->copy()->fround(),"\n"; # 123.46
3313 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
3314 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
3316 Math::BigFloat->accuracy(undef); # A not important now
3317 Math::BigFloat->precision(2); # P important
3318 print $x->copy()->bnorm(),"\n"; # 123.46
3319 print $x->copy()->fround(),"\n"; # 123.46
3321 Examples for converting:
3323 my $x = Math::BigInt->new('0b1'.'01' x 123);
3324 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
3326 =head1 Autocreating constants
3328 After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
3329 in the given scope are converted to C<Math::BigInt>. This conversion
3330 happens at compile time.
3334 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
3336 prints the integer value of C<2**100>. Note that without conversion of
3337 constants the expression 2**100 will be calculated as perl scalar.
3339 Please note that strings and floating point constants are not affected,
3342 use Math::BigInt qw/:constant/;
3344 $x = 1234567890123456789012345678901234567890
3345 + 123456789123456789;
3346 $y = '1234567890123456789012345678901234567890'
3347 + '123456789123456789';
3349 do not work. You need an explicit Math::BigInt->new() around one of the
3350 operands. You should also quote large constants to protect loss of precision:
3354 $x = Math::BigInt->new('1234567889123456789123456789123456789');
3356 Without the quotes Perl would convert the large number to a floating point
3357 constant at compile time and then hand the result to BigInt, which results in
3358 an truncated result or a NaN.
3362 Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
3363 must be made in the second case. For long numbers, the copy can eat up to 20%
3364 of the work (in the case of addition/subtraction, less for
3365 multiplication/division). If $y is very small compared to $x, the form
3366 $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
3367 more time then the actual addition.
3369 With a technique called copy-on-write, the cost of copying with overload could
3370 be minimized or even completely avoided. A test implementation of COW did show
3371 performance gains for overloaded math, but introduced a performance loss due
3372 to a constant overhead for all other operatons.
3374 The rewritten version of this module is slower on certain operations, like
3375 new(), bstr() and numify(). The reason are that it does now more work and
3376 handles more cases. The time spent in these operations is usually gained in
3377 the other operations so that programs on the average should get faster. If
3378 they don't, please contect the author.
3380 Some operations may be slower for small numbers, but are significantly faster
3381 for big numbers. Other operations are now constant (O(1), like bneg(), babs()
3382 etc), instead of O(N) and thus nearly always take much less time. These
3383 optimizations were done on purpose.
3385 If you find the Calc module to slow, try to install any of the replacement
3386 modules and see if they help you.
3388 =head2 Alternative math libraries
3390 You can use an alternative library to drive Math::BigInt via:
3392 use Math::BigInt lib => 'Module';
3394 See L<MATH LIBRARY> for more information.
3396 For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
3400 =head1 Subclassing Math::BigInt
3402 The basic design of Math::BigInt allows simple subclasses with very little
3403 work, as long as a few simple rules are followed:
3409 The public API must remain consistent, i.e. if a sub-class is overloading
3410 addition, the sub-class must use the same name, in this case badd(). The
3411 reason for this is that Math::BigInt is optimized to call the object methods
3416 The private object hash keys like C<$x->{sign}> may not be changed, but
3417 additional keys can be added, like C<$x->{_custom}>.
3421 Accessor functions are available for all existing object hash keys and should
3422 be used instead of directly accessing the internal hash keys. The reason for
3423 this is that Math::BigInt itself has a pluggable interface which permits it
3424 to support different storage methods.
3428 More complex sub-classes may have to replicate more of the logic internal of
3429 Math::BigInt if they need to change more basic behaviors. A subclass that
3430 needs to merely change the output only needs to overload C<bstr()>.
3432 All other object methods and overloaded functions can be directly inherited
3433 from the parent class.
3435 At the very minimum, any subclass will need to provide it's own C<new()> and can
3436 store additional hash keys in the object. There are also some package globals
3437 that must be defined, e.g.:
3441 $precision = -2; # round to 2 decimal places
3442 $round_mode = 'even';
3445 Additionally, you might want to provide the following two globals to allow
3446 auto-upgrading and auto-downgrading to work correctly:
3451 This allows Math::BigInt to correctly retrieve package globals from the
3452 subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
3453 t/Math/BigFloat/SubClass.pm completely functional subclass examples.
3459 in your subclass to automatically inherit the overloading from the parent. If
3460 you like, you can change part of the overloading, look at Math::String for an
3465 When used like this:
3467 use Math::BigInt upgrade => 'Foo::Bar';
3469 certain operations will 'upgrade' their calculation and thus the result to
3470 the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
3472 use Math::BigInt upgrade => 'Math::BigFloat';
3474 As a shortcut, you can use the module C<bignum>:
3478 Also good for oneliners:
3480 perl -Mbignum -le 'print 2 ** 255'
3482 This makes it possible to mix arguments of different classes (as in 2.5 + 2)
3483 as well es preserve accuracy (as in sqrt(3)).
3485 Beware: This feature is not fully implemented yet.
3489 The following methods upgrade themselves unconditionally; that is if upgrade
3490 is in effect, they will always hand up their work:
3502 Beware: This list is not complete.
3504 All other methods upgrade themselves only when one (or all) of their
3505 arguments are of the class mentioned in $upgrade (This might change in later
3506 versions to a more sophisticated scheme):
3512 =item Out of Memory!
3514 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
3515 C<eval()> in your code will crash with "Out of memory". This is probably an
3516 overload/exporter bug. You can workaround by not having C<eval()>
3517 and ':constant' at the same time or upgrade your Perl to a newer version.
3519 =item Fails to load Calc on Perl prior 5.6.0
3521 Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
3522 will fall back to eval { require ... } when loading the math lib on Perls
3523 prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
3524 filesystems using a different seperator.
3530 Some things might not work as you expect them. Below is documented what is
3531 known to be troublesome:
3535 =item stringify, bstr(), bsstr() and 'cmp'
3537 Both stringify and bstr() now drop the leading '+'. The old code would return
3538 '+3', the new returns '3'. This is to be consistent with Perl and to make
3539 cmp (especially with overloading) to work as you expect. It also solves
3540 problems with Test.pm, it's ok() uses 'eq' internally.
3542 Mark said, when asked about to drop the '+' altogether, or make only cmp work:
3544 I agree (with the first alternative), don't add the '+' on positive
3545 numbers. It's not as important anymore with the new internal
3546 form for numbers. It made doing things like abs and neg easier,
3547 but those have to be done differently now anyway.
3549 So, the following examples will now work all as expected:
3552 BEGIN { plan tests => 1 }
3555 my $x = new Math::BigInt 3*3;
3556 my $y = new Math::BigInt 3*3;
3559 print "$x eq 9" if $x eq $y;
3560 print "$x eq 9" if $x eq '9';
3561 print "$x eq 9" if $x eq 3*3;
3563 Additionally, the following still works:
3565 print "$x == 9" if $x == $y;
3566 print "$x == 9" if $x == 9;
3567 print "$x == 9" if $x == 3*3;
3569 There is now a C<bsstr()> method to get the string in scientific notation aka
3570 C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
3571 for comparisation, but Perl will represent some numbers as 100 and others
3572 as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
3575 BEGIN { plan tests => 3 }
3578 $x = Math::BigInt->new('1e56'); $y = 1e56;
3579 ok ($x,$y); # will fail
3580 ok ($x->bsstr(),$y); # okay
3581 $y = Math::BigInt->new($y);
3584 Alternatively, simple use <=> for comparisations, that will get it always
3585 right. There is not yet a way to get a number automatically represented as
3586 a string that matches exactly the way Perl represents it.
3590 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
3593 $x = Math::BigInt->new(123);
3594 $y = int($x); # BigInt 123
3595 $x = Math::BigFloat->new(123.45);
3596 $y = int($x); # BigInt 123
3598 In all Perl versions you can use C<as_number()> for the same effect:
3600 $x = Math::BigFloat->new(123.45);
3601 $y = $x->as_number(); # BigInt 123
3603 This also works for other subclasses, like Math::String.
3605 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
3609 The following will probably not do what you expect:
3611 $c = Math::BigInt->new(123);
3612 print $c->length(),"\n"; # prints 30
3614 It prints both the number of digits in the number and in the fraction part
3615 since print calls C<length()> in list context. Use something like:
3617 print scalar $c->length(),"\n"; # prints 3
3621 The following will probably not do what you expect:
3623 print $c->bdiv(10000),"\n";
3625 It prints both quotient and remainder since print calls C<bdiv()> in list
3626 context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
3629 print $c / 10000,"\n";
3630 print scalar $c->bdiv(10000),"\n"; # or if you want to modify $c
3634 The quotient is always the greatest integer less than or equal to the
3635 real-valued quotient of the two operands, and the remainder (when it is
3636 nonzero) always has the same sign as the second operand; so, for
3646 As a consequence, the behavior of the operator % agrees with the
3647 behavior of Perl's built-in % operator (as documented in the perlop
3648 manpage), and the equation
3650 $x == ($x / $y) * $y + ($x % $y)
3652 holds true for any $x and $y, which justifies calling the two return
3653 values of bdiv() the quotient and remainder. The only exception to this rule
3654 are when $y == 0 and $x is negative, then the remainder will also be
3655 negative. See below under "infinity handling" for the reasoning behing this.
3657 Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
3658 not change BigInt's way to do things. This is because under 'use integer' Perl
3659 will do what the underlying C thinks is right and this is different for each
3660 system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
3661 the author to implement it ;)
3663 =item infinity handling
3665 Here are some examples that explain the reasons why certain results occur while
3668 The following table shows the result of the division and the remainder, so that
3669 the equation above holds true. Some "ordinary" cases are strewn in to show more
3670 clearly the reasoning:
3672 A / B = C, R so that C * B + R = A
3673 =========================================================
3674 5 / 8 = 0, 5 0 * 8 + 5 = 5
3675 0 / 8 = 0, 0 0 * 8 + 0 = 0
3676 0 / inf = 0, 0 0 * inf + 0 = 0
3677 0 /-inf = 0, 0 0 * -inf + 0 = 0
3678 5 / inf = 0, 5 0 * inf + 5 = 5
3679 5 /-inf = 0, 5 0 * -inf + 5 = 5
3680 -5/ inf = 0, -5 0 * inf + -5 = -5
3681 -5/-inf = 0, -5 0 * -inf + -5 = -5
3682 inf/ 5 = inf, 0 inf * 5 + 0 = inf
3683 -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
3684 inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
3685 -inf/ -5 = inf, 0 inf * -5 + 0 = -inf
3686 5/ 5 = 1, 0 1 * 5 + 0 = 5
3687 -5/ -5 = 1, 0 1 * -5 + 0 = -5
3688 inf/ inf = 1, 0 1 * inf + 0 = inf
3689 -inf/-inf = 1, 0 1 * -inf + 0 = -inf
3690 inf/-inf = -1, 0 -1 * -inf + 0 = inf
3691 -inf/ inf = -1, 0 1 * -inf + 0 = -inf
3692 8/ 0 = inf, 8 inf * 0 + 8 = 8
3693 inf/ 0 = inf, inf inf * 0 + inf = inf
3696 These cases below violate the "remainder has the sign of the second of the two
3697 arguments", since they wouldn't match up otherwise.
3699 A / B = C, R so that C * B + R = A
3700 ========================================================
3701 -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
3702 -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
3704 =item Modifying and =
3708 $x = Math::BigFloat->new(5);
3711 It will not do what you think, e.g. making a copy of $x. Instead it just makes
3712 a second reference to the B<same> object and stores it in $y. Thus anything
3713 that modifies $x (except overloaded operators) will modify $y, and vice versa.
3714 Or in other words, C<=> is only safe if you modify your BigInts only via
3715 overloaded math. As soon as you use a method call it breaks:
3718 print "$x, $y\n"; # prints '10, 10'
3720 If you want a true copy of $x, use:
3724 You can also chain the calls like this, this will make first a copy and then
3727 $y = $x->copy()->bmul(2);
3729 See also the documentation for overload.pm regarding C<=>.
3733 C<bpow()> (and the rounding functions) now modifies the first argument and
3734 returns it, unlike the old code which left it alone and only returned the
3735 result. This is to be consistent with C<badd()> etc. The first three will
3736 modify $x, the last one won't:
3738 print bpow($x,$i),"\n"; # modify $x
3739 print $x->bpow($i),"\n"; # ditto
3740 print $x **= $i,"\n"; # the same
3741 print $x ** $i,"\n"; # leave $x alone
3743 The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
3745 =item Overloading -$x
3755 since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
3756 needs to preserve $x since it does not know that it later will get overwritten.
3757 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
3759 With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
3760 since it is slower for all other things.
3762 =item Mixing different object types
3764 In Perl you will get a floating point value if you do one of the following:
3770 With overloaded math, only the first two variants will result in a BigFloat:
3775 $mbf = Math::BigFloat->new(5);
3776 $mbi2 = Math::BigInteger->new(5);
3777 $mbi = Math::BigInteger->new(2);
3779 # what actually gets called:
3780 $float = $mbf + $mbi; # $mbf->badd()
3781 $float = $mbf / $mbi; # $mbf->bdiv()
3782 $integer = $mbi + $mbf; # $mbi->badd()
3783 $integer = $mbi2 / $mbi; # $mbi2->bdiv()
3784 $integer = $mbi2 / $mbf; # $mbi2->bdiv()
3786 This is because math with overloaded operators follows the first (dominating)
3787 operand, and the operation of that is called and returns thus the result. So,
3788 Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
3789 the result should be a Math::BigFloat or the second operant is one.
3791 To get a Math::BigFloat you either need to call the operation manually,
3792 make sure the operands are already of the proper type or casted to that type
3793 via Math::BigFloat->new():
3795 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
3797 Beware of simple "casting" the entire expression, this would only convert
3798 the already computed result:
3800 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
3802 Beware also of the order of more complicated expressions like:
3804 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
3805 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
3807 If in doubt, break the expression into simpler terms, or cast all operands
3808 to the desired resulting type.
3810 Scalar values are a bit different, since:
3815 will both result in the proper type due to the way the overloaded math works.
3817 This section also applies to other overloaded math packages, like Math::String.
3819 One solution to you problem might be L<autoupgrading|upgrading>.
3823 C<bsqrt()> works only good if the result is a big integer, e.g. the square
3824 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
3827 If you want a better approximation of the square root, then use:
3829 $x = Math::BigFloat->new(12);
3830 Math::BigFloat->precision(0);
3831 Math::BigFloat->round_mode('even');
3832 print $x->copy->bsqrt(),"\n"; # 4
3834 Math::BigFloat->precision(2);
3835 print $x->bsqrt(),"\n"; # 3.46
3836 print $x->bsqrt(3),"\n"; # 3.464
3840 For negative numbers in base see also L<brsft|brsft>.
3846 This program is free software; you may redistribute it and/or modify it under
3847 the same terms as Perl itself.
3851 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
3852 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
3855 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
3856 more documentation including a full version history, testcases, empty
3857 subclass files and benchmarks.
3861 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
3862 Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.