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->upgrade() work
166 my $class = ref($self) || $self || __PACKAGE__;
170 return ${"${class}::upgrade"} = $u;
172 return ${"${class}::upgrade"};
178 # make Class->downgrade() work
180 my $class = ref($self) || $self || __PACKAGE__;
184 return ${"${class}::downgrade"} = $u;
186 return ${"${class}::downgrade"};
192 # make Class->round_mode() work
194 my $class = ref($self) || $self || __PACKAGE__;
197 die ('div_scale must be greater than zero') if $_[0] < 0;
198 ${"${class}::div_scale"} = shift;
200 return ${"${class}::div_scale"};
205 # $x->accuracy($a); ref($x) $a
206 # $x->accuracy(); ref($x)
207 # Class->accuracy(); class
208 # Class->accuracy($a); class $a
211 my $class = ref($x) || $x || __PACKAGE__;
214 # need to set new value?
218 die ('accuracy must not be zero') if defined $a && $a == 0;
221 # $object->accuracy() or fallback to global
222 $x->bround($a) if defined $a;
223 $x->{_a} = $a; # set/overwrite, even if not rounded
224 $x->{_p} = undef; # clear P
229 ${"${class}::accuracy"} = $a;
230 ${"${class}::precision"} = undef; # clear P
232 return $a; # shortcut
237 # $object->accuracy() or fallback to global
238 return $x->{_a} || ${"${class}::accuracy"};
240 return ${"${class}::accuracy"};
245 # $x->precision($p); ref($x) $p
246 # $x->precision(); ref($x)
247 # Class->precision(); class
248 # Class->precision($p); class $p
251 my $class = ref($x) || $x || __PACKAGE__;
254 # need to set new value?
260 # $object->precision() or fallback to global
261 $x->bfround($p) if defined $p;
262 $x->{_p} = $p; # set/overwrite, even if not rounded
263 $x->{_a} = undef; # clear A
268 ${"${class}::precision"} = $p;
269 ${"${class}::accuracy"} = undef; # clear A
271 return $p; # shortcut
276 # $object->precision() or fallback to global
277 return $x->{_p} || ${"${class}::precision"};
279 return ${"${class}::precision"};
284 # return (later set?) configuration data as hash ref
285 my $class = shift || 'Math::BigInt';
291 lib_version => ${"${lib}::VERSION"},
295 qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
297 $cfg->{lc($_)} = ${"${class}::$_"};
304 # select accuracy parameter based on precedence,
305 # used by bround() and bfround(), may return undef for scale (means no op)
306 my ($x,$s,$m,$scale,$mode) = @_;
307 $scale = $x->{_a} if !defined $scale;
308 $scale = $s if (!defined $scale);
309 $mode = $m if !defined $mode;
310 return ($scale,$mode);
315 # select precision parameter based on precedence,
316 # used by bround() and bfround(), may return undef for scale (means no op)
317 my ($x,$s,$m,$scale,$mode) = @_;
318 $scale = $x->{_p} if !defined $scale;
319 $scale = $s if (!defined $scale);
320 $mode = $m if !defined $mode;
321 return ($scale,$mode);
324 ##############################################################################
332 # if two arguments, the first one is the class to "swallow" subclasses
340 return unless ref($x); # only for objects
342 my $self = {}; bless $self,$c;
344 foreach my $k (keys %$x)
348 $self->{value} = $CALC->_copy($x->{value}); next;
350 if (!($r = ref($x->{$k})))
352 $self->{$k} = $x->{$k}; next;
356 $self->{$k} = \${$x->{$k}};
358 elsif ($r eq 'ARRAY')
360 $self->{$k} = [ @{$x->{$k}} ];
364 # only one level deep!
365 foreach my $h (keys %{$x->{$k}})
367 $self->{$k}->{$h} = $x->{$k}->{$h};
373 if ($xk->can('copy'))
375 $self->{$k} = $xk->copy();
379 $self->{$k} = $xk->new($xk);
388 # create a new BigInt object from a string or another BigInt object.
389 # see hash keys documented at top
391 # the argument could be an object, so avoid ||, && etc on it, this would
392 # cause costly overloaded code to be called. The only allowed ops are
395 my ($class,$wanted,$a,$p,$r) = @_;
397 # avoid numify-calls by not using || on $wanted!
398 return $class->bzero($a,$p) if !defined $wanted; # default to 0
399 return $class->copy($wanted,$a,$p,$r) if ref($wanted);
401 $class->import() if $IMPORT == 0; # make require work
403 my $self = {}; bless $self, $class;
404 # handle '+inf', '-inf' first
405 if ($wanted =~ /^[+-]?inf$/)
407 $self->{value} = $CALC->_zero();
408 $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
411 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
412 my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
415 die "$wanted is not a number initialized to $class" if !$NaNOK;
417 $self->{value} = $CALC->_zero();
418 $self->{sign} = $nan;
423 # _from_hex or _from_bin
424 $self->{value} = $mis->{value};
425 $self->{sign} = $mis->{sign};
426 return $self; # throw away $mis
428 # make integer from mantissa by adjusting exp, then convert to bigint
429 $self->{sign} = $$mis; # store sign
430 $self->{value} = $CALC->_zero(); # for all the NaN cases
431 my $e = int("$$es$$ev"); # exponent (avoid recursion)
434 my $diff = $e - CORE::length($$mfv);
435 if ($diff < 0) # Not integer
438 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
439 $self->{sign} = $nan;
443 # adjust fraction and add it to value
444 # print "diff > 0 $$miv\n";
445 $$miv = $$miv . ($$mfv . '0' x $diff);
450 if ($$mfv ne '') # e <= 0
452 # fraction and negative/zero E => NOI
453 #print "NOI 2 \$\$mfv '$$mfv'\n";
454 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
455 $self->{sign} = $nan;
459 # xE-y, and empty mfv
462 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
465 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
466 $self->{sign} = $nan;
470 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
471 $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
472 # if any of the globals is set, use them to round and store them inside $self
473 # do not round for new($x,undef,undef) since that is used by MBF to signal
475 $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
476 # print "mbi new $self\n";
482 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
484 $self = $class if !defined $self;
487 my $c = $self; $self = {}; bless $self, $c;
489 $self->import() if $IMPORT == 0; # make require work
490 return if $self->modify('bnan');
492 if ($self->can('_bnan'))
494 # use subclass to initialize
499 # otherwise do our own thing
500 $self->{value} = $CALC->_zero();
502 $self->{value} = $CALC->_zero();
503 $self->{sign} = $nan;
504 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
510 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
511 # the sign is either '+', or if given, used from there
513 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
514 $self = $class if !defined $self;
517 my $c = $self; $self = {}; bless $self, $c;
519 $self->import() if $IMPORT == 0; # make require work
520 return if $self->modify('binf');
522 if ($self->can('_binf'))
524 # use subclass to initialize
529 # otherwise do our own thing
530 $self->{value} = $CALC->_zero();
532 $self->{sign} = $sign.'inf';
533 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
539 # create a bigint '+0', if given a BigInt, set it to 0
541 $self = $class if !defined $self;
545 my $c = $self; $self = {}; bless $self, $c;
547 $self->import() if $IMPORT == 0; # make require work
548 return if $self->modify('bzero');
550 if ($self->can('_bzero'))
552 # use subclass to initialize
557 # otherwise do our own thing
558 $self->{value} = $CALC->_zero();
564 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
566 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
573 # create a bigint '+1' (or -1 if given sign '-'),
574 # if given a BigInt, set it to +1 or -1, respecively
576 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
577 $self = $class if !defined $self;
581 my $c = $self; $self = {}; bless $self, $c;
583 $self->import() if $IMPORT == 0; # make require work
584 return if $self->modify('bone');
586 if ($self->can('_bone'))
588 # use subclass to initialize
593 # otherwise do our own thing
594 $self->{value} = $CALC->_one();
596 $self->{sign} = $sign;
600 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
602 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
607 ##############################################################################
608 # string conversation
612 # (ref to BFLOAT or num_str ) return num_str
613 # Convert number from internal format to scientific string format.
614 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
615 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
616 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
618 if ($x->{sign} !~ /^[+-]$/)
620 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
623 my ($m,$e) = $x->parts();
624 # e can only be positive
626 # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
627 return $m->bstr().$sign.$e->bstr();
632 # make a string from bigint object
633 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
634 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
636 if ($x->{sign} !~ /^[+-]$/)
638 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
641 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
642 return $es.${$CALC->_str($x->{value})};
647 # Make a "normal" scalar from a BigInt object
648 my $x = shift; $x = $class->new($x) unless ref $x;
649 return $x->{sign} if $x->{sign} !~ /^[+-]$/;
650 my $num = $CALC->_num($x->{value});
651 return -$num if $x->{sign} eq '-';
655 ##############################################################################
656 # public stuff (usually prefixed with "b")
660 # return the sign of the number: +/-/NaN
661 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
666 sub _find_round_parameters
668 # After any operation or when calling round(), the result is rounded by
669 # regarding the A & P from arguments, local parameters, or globals.
671 # This procedure finds the round parameters, but it is for speed reasons
672 # duplicated in round. Otherwise, it is tested by the testsuite and used
675 my ($self,$a,$p,$r,@args) = @_;
676 # $a accuracy, if given by caller
677 # $p precision, if given by caller
678 # $r round_mode, if given by caller
679 # @args all 'other' arguments (0 for unary, 1 for binary ops)
681 # leave bigfloat parts alone
682 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
684 my $c = ref($self); # find out class of argument(s)
687 # now pick $a or $p, but only if we have got "arguments"
690 foreach ($self,@args)
692 # take the defined one, or if both defined, the one that is smaller
693 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
698 # even if $a is defined, take $p, to signal error for both defined
699 foreach ($self,@args)
701 # take the defined one, or if both defined, the one that is bigger
703 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
706 # if still none defined, use globals (#2)
707 $a = ${"$c\::accuracy"} unless defined $a;
708 $p = ${"$c\::precision"} unless defined $p;
711 return ($self) unless defined $a || defined $p; # early out
713 # set A and set P is an fatal error
714 return ($self->bnan()) if defined $a && defined $p;
716 $r = ${"$c\::round_mode"} unless defined $r;
717 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
719 return ($self,$a,$p,$r);
724 # Round $self according to given parameters, or given second argument's
725 # parameters or global defaults
727 # for speed reasons, _find_round_parameters is embeded here:
729 my ($self,$a,$p,$r,@args) = @_;
730 # $a accuracy, if given by caller
731 # $p precision, if given by caller
732 # $r round_mode, if given by caller
733 # @args all 'other' arguments (0 for unary, 1 for binary ops)
735 # leave bigfloat parts alone
736 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
738 my $c = ref($self); # find out class of argument(s)
741 # now pick $a or $p, but only if we have got "arguments"
744 foreach ($self,@args)
746 # take the defined one, or if both defined, the one that is smaller
747 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
752 # even if $a is defined, take $p, to signal error for both defined
753 foreach ($self,@args)
755 # take the defined one, or if both defined, the one that is bigger
757 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
760 # if still none defined, use globals (#2)
761 $a = ${"$c\::accuracy"} unless defined $a;
762 $p = ${"$c\::precision"} unless defined $p;
765 return $self unless defined $a || defined $p; # early out
767 # set A and set P is an fatal error
768 return $self->bnan() if defined $a && defined $p;
770 $r = ${"$c\::round_mode"} unless defined $r;
771 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
773 # now round, by calling either fround or ffround:
776 $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
778 else # both can't be undefined due to early out
780 $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
782 $self->bnorm(); # after round, normalize
787 # (numstr or BINT) return BINT
788 # Normalize number -- no-op here
789 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
795 # (BINT or num_str) return BINT
796 # make number absolute, or return absolute BINT from string
797 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
799 return $x if $x->modify('babs');
800 # post-normalized abs for internal use (does nothing for NaN)
801 $x->{sign} =~ s/^-/+/;
807 # (BINT or num_str) return BINT
808 # negate number or make a negated number from string
809 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
811 return $x if $x->modify('bneg');
813 # for +0 dont negate (to have always normalized)
814 $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
820 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
821 # (BINT or num_str, BINT or num_str) return cond_code
822 my ($self,$x,$y) = objectify(2,@_);
824 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
826 # handle +-inf and NaN
827 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
828 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
829 return +1 if $x->{sign} eq '+inf';
830 return -1 if $x->{sign} eq '-inf';
831 return -1 if $y->{sign} eq '+inf';
834 # check sign for speed first
835 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
836 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
839 my $xz = $x->is_zero();
840 my $yz = $y->is_zero();
841 return 0 if $xz && $yz; # 0 <=> 0
842 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
843 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
845 # post-normalized compare for internal use (honors signs)
846 if ($x->{sign} eq '+')
848 return 1 if $y->{sign} eq '-'; # 0 check handled above
849 return $CALC->_acmp($x->{value},$y->{value});
853 return -1 if $y->{sign} eq '+';
854 $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
859 # Compares 2 values, ignoring their signs.
860 # Returns one of undef, <0, =0, >0. (suitable for sort)
861 # (BINT, BINT) return cond_code
862 my ($self,$x,$y) = objectify(2,@_);
864 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
866 # handle +-inf and NaN
867 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
868 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
869 return +1; # inf is always bigger
871 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
876 # add second arg (BINT or string) to first (BINT) (modifies first)
877 # return result as BINT
878 my ($self,$x,$y,@r) = objectify(2,@_);
880 return $x if $x->modify('badd');
881 # print "mbi badd ",join(' ',caller()),"\n";
882 # print "upgrade => ",$upgrade||'undef',
883 # " \$x (",ref($x),") \$y (",ref($y),")\n";
884 # return $upgrade->badd($x,$y,@r) if defined $upgrade &&
885 # ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
886 # print "still badd\n";
888 $r[3] = $y; # no push!
889 # inf and NaN handling
890 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
893 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
895 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
897 # +inf++inf or -inf+-inf => same, rest is NaN
898 return $x if $x->{sign} eq $y->{sign};
901 # +-inf + something => +inf
902 # something +-inf => +-inf
903 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
907 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
911 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
916 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
919 #print "swapped sub (a=$a)\n";
920 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
925 # speedup, if equal, set result to 0
926 #print "equal sub, result = 0\n";
927 $x->{value} = $CALC->_zero();
932 #print "unswapped sub (a=$a)\n";
933 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
942 # (BINT or num_str, BINT or num_str) return num_str
943 # subtract second arg from first, modify first
944 my ($self,$x,$y,@r) = objectify(2,@_);
946 return $x if $x->modify('bsub');
947 # return $upgrade->badd($x,$y,@r) if defined $upgrade &&
948 # ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
952 return $x->round(@r);
955 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
956 $x->badd($y,@r); # badd does not leave internal zeros
957 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
958 $x; # already rounded by badd() or no round necc.
963 # increment arg by one
964 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
965 return $x if $x->modify('binc');
967 if ($x->{sign} eq '+')
969 $x->{value} = $CALC->_inc($x->{value});
970 return $x->round($a,$p,$r);
972 elsif ($x->{sign} eq '-')
974 $x->{value} = $CALC->_dec($x->{value});
975 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
976 return $x->round($a,$p,$r);
978 # inf, nan handling etc
979 $x->badd($self->__one(),$a,$p,$r); # badd does round
984 # decrement arg by one
985 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
986 return $x if $x->modify('bdec');
988 my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
990 if (($x->{sign} eq '-') || $zero)
992 $x->{value} = $CALC->_inc($x->{value});
993 $x->{sign} = '-' if $zero; # 0 => 1 => -1
994 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
995 return $x->round($a,$p,$r);
998 elsif ($x->{sign} eq '+')
1000 $x->{value} = $CALC->_dec($x->{value});
1001 return $x->round($a,$p,$r);
1003 # inf, nan handling etc
1004 $x->badd($self->__one('-'),$a,$p,$r); # badd does round
1009 # not implemented yet
1010 my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1012 return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
1019 # (BINT or num_str, BINT or num_str) return BINT
1020 # does not modify arguments, but returns new object
1021 # Lowest Common Multiplicator
1023 my $y = shift; my ($x);
1030 $x = $class->new($y);
1032 while (@_) { $x = __lcm($x,shift); }
1038 # (BINT or num_str, BINT or num_str) return BINT
1039 # does not modify arguments, but returns new object
1040 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
1043 $y = __PACKAGE__->new($y) if !ref($y);
1045 my $x = $y->copy(); # keep arguments
1046 if ($CALC->can('_gcd'))
1050 $y = shift; $y = $self->new($y) if !ref($y);
1051 next if $y->is_zero();
1052 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
1053 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
1060 $y = shift; $y = $self->new($y) if !ref($y);
1061 $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
1069 # (num_str or BINT) return BINT
1070 # represent ~x as twos-complement number
1071 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1072 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1074 return $x if $x->modify('bnot');
1075 $x->bneg()->bdec(); # bdec already does round
1078 # is_foo test routines
1082 # return true if arg (BINT or num_str) is zero (array '+', '0')
1083 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1084 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1086 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
1087 $CALC->_is_zero($x->{value});
1092 # return true if arg (BINT or num_str) is NaN
1093 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1095 return 1 if $x->{sign} eq $nan;
1101 # return true if arg (BINT or num_str) is +-inf
1102 my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1104 $sign = '' if !defined $sign;
1105 return 0 if $sign !~ /^([+-]|)$/;
1109 return 1 if ($x->{sign} =~ /^[+-]inf$/);
1112 $sign = quotemeta($sign.'inf');
1113 return 1 if ($x->{sign} =~ /^$sign$/);
1119 # return true if arg (BINT or num_str) is +1
1120 # or -1 if sign is given
1121 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1122 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1124 $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
1126 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
1127 $CALC->_is_one($x->{value});
1132 # return true when arg (BINT or num_str) is odd, false for even
1133 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1134 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1136 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1137 $CALC->_is_odd($x->{value});
1142 # return true when arg (BINT or num_str) is even, false for odd
1143 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1144 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1146 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1147 $CALC->_is_even($x->{value});
1152 # return true when arg (BINT or num_str) is positive (>= 0)
1153 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1154 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1156 return 1 if $x->{sign} =~ /^\+/;
1162 # return true when arg (BINT or num_str) is negative (< 0)
1163 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1164 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1166 return 1 if ($x->{sign} =~ /^-/);
1172 # return true when arg (BINT or num_str) is an integer
1173 # always true for BigInt, but different for Floats
1174 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1175 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1177 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1180 ###############################################################################
1184 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
1185 # (BINT or num_str, BINT or num_str) return BINT
1186 my ($self,$x,$y,@r) = objectify(2,@_);
1188 return $x if $x->modify('bmul');
1190 $r[3] = $y; # no push here
1192 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1195 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1197 return $x->bnan() if $x->is_zero() || $y->is_zero();
1198 # result will always be +-inf:
1199 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1200 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1201 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1202 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1203 return $x->binf('-');
1206 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1208 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1209 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1215 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1216 my ($self,$x,$y) = @_;
1218 # NaN if x == NaN or y == NaN or x==y==0
1219 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1220 if (($x->is_nan() || $y->is_nan()) ||
1221 ($x->is_zero() && $y->is_zero()));
1223 # +-inf / +-inf == NaN, reminder also NaN
1224 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1226 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
1228 # x / +-inf => 0, remainder x (works even if x == 0)
1229 if ($y->{sign} =~ /^[+-]inf$/)
1231 my $t = $x->copy(); # binf clobbers up $x
1232 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1235 # 5 / 0 => +inf, -6 / 0 => -inf
1236 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1237 # exception: -8 / 0 has remainder -8, not 8
1238 # exception: -inf / 0 has remainder -inf, not inf
1241 # +-inf / 0 => special case for -inf
1242 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1243 if (!$x->is_zero() && !$x->is_inf())
1245 my $t = $x->copy(); # binf clobbers up $x
1247 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1251 # last case: +-inf / ordinary number
1253 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1255 return wantarray ? ($x,$self->bzero()) : $x;
1260 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1261 # (BINT,BINT) (quo,rem) or BINT (only rem)
1262 my ($self,$x,$y,@r) = objectify(2,@_);
1264 return $x if $x->modify('bdiv');
1266 return $self->_div_inf($x,$y)
1267 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
1269 $r[3] = $y; # no push!
1273 wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
1275 # Is $x in the interval [0, $y) (aka $x <= $y) ?
1276 my $cmp = $CALC->_acmp($x->{value},$y->{value});
1277 if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
1279 return $upgrade->bdiv($x,$y,@r) if defined $upgrade;
1281 return $x->bzero()->round(@r) unless wantarray;
1282 my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
1283 return ($x->bzero()->round(@r),$t);
1287 # shortcut, both are the same, so set to +/- 1
1288 $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
1289 return $x unless wantarray;
1290 return ($x->round(@r),$self->bzero(@r));
1293 # calc new sign and in case $y == +/- 1, return $x
1294 my $xsign = $x->{sign}; # keep
1295 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1296 # check for / +-1 (cant use $y->is_one due to '-'
1297 if ($CALC->_is_one($y->{value}))
1299 return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
1304 my $rem = $self->bzero();
1305 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1306 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1308 if (! $CALC->_is_zero($rem->{value}))
1310 $rem->{sign} = $y->{sign};
1311 $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
1315 $rem->{sign} = '+'; # dont leave -0
1321 $x->{value} = $CALC->_div($x->{value},$y->{value});
1322 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
1328 # modulus (or remainder)
1329 # (BINT or num_str, BINT or num_str) return BINT
1330 my ($self,$x,$y,@r) = objectify(2,@_);
1332 return $x if $x->modify('bmod');
1333 $r[3] = $y; # no push!
1334 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1336 my ($d,$r) = $self->_div_inf($x,$y);
1337 return $r->round(@r);
1340 if ($CALC->can('_mod'))
1342 # calc new sign and in case $y == +/- 1, return $x
1343 $x->{value} = $CALC->_mod($x->{value},$y->{value});
1344 if (!$CALC->_is_zero($x->{value}))
1346 my $xsign = $x->{sign};
1347 $x->{sign} = $y->{sign};
1348 $x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
1352 $x->{sign} = '+'; # dont leave -0
1354 return $x->round(@r);
1356 my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
1358 foreach (qw/value sign _a _p/)
1360 $x->{$_} = $rem->{$_};
1367 # (BINT or num_str, BINT or num_str) return BINT
1368 # compute factorial numbers
1369 # modifies first argument
1370 my ($self,$x,@r) = objectify(1,@_);
1372 return $x if $x->modify('bfac');
1374 return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
1375 return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
1377 if ($CALC->can('_fac'))
1379 $x->{value} = $CALC->_fac($x->{value});
1380 return $x->round(@r);
1385 my $f = $self->new(2);
1386 while ($f->bacmp($n) < 0)
1388 $x->bmul($f); $f->binc();
1390 $x->bmul($f); # last step
1391 $x->round(@r); # round
1396 # (BINT or num_str, BINT or num_str) return BINT
1397 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1398 # modifies first argument
1399 my ($self,$x,$y,@r) = objectify(2,@_);
1401 return $x if $x->modify('bpow');
1403 $r[3] = $y; # no push!
1404 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
1405 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1406 return $x->bone(@r) if $y->is_zero();
1407 return $x->round(@r) if $x->is_one() || $y->is_one();
1408 if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
1410 # if $x == -1 and odd/even y => +1/-1
1411 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
1412 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
1414 # 1 ** -y => 1 / (1 ** |y|)
1415 # so do test for negative $y after above's clause
1416 return $x->bnan() if $y->{sign} eq '-';
1417 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
1419 if ($CALC->can('_pow'))
1421 $x->{value} = $CALC->_pow($x->{value},$y->{value});
1422 return $x->round(@r);
1425 # based on the assumption that shifting in base 10 is fast, and that mul
1426 # works faster if numbers are small: we count trailing zeros (this step is
1427 # O(1)..O(N), but in case of O(N) we save much more time due to this),
1428 # stripping them out of the multiplication, and add $count * $y zeros
1429 # afterwards like this:
1430 # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1431 # creates deep recursion?
1432 # my $zeros = $x->_trailing_zeros();
1435 # $x->brsft($zeros,10); # remove zeros
1436 # $x->bpow($y); # recursion (will not branch into here again)
1437 # $zeros = $y * $zeros; # real number of zeros to add
1438 # $x->blsft($zeros,10);
1439 # return $x->round($a,$p,$r);
1442 my $pow2 = $self->__one();
1443 my $y1 = $class->new($y);
1444 my $two = $self->new(2);
1445 while (!$y1->is_one())
1447 $pow2->bmul($x) if $y1->is_odd();
1451 $x->bmul($pow2) unless $pow2->is_one();
1452 return $x->round(@r);
1457 # (BINT or num_str, BINT or num_str) return BINT
1458 # compute x << y, base n, y >= 0
1459 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1461 return $x if $x->modify('blsft');
1462 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1463 return $x->round($a,$p,$r) if $y->is_zero();
1465 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1467 my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
1470 $x->{value} = $t; return $x->round($a,$p,$r);
1473 return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
1478 # (BINT or num_str, BINT or num_str) return BINT
1479 # compute x >> y, base n, y >= 0
1480 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1482 return $x if $x->modify('brsft');
1483 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1484 return $x->round($a,$p,$r) if $y->is_zero();
1485 return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
1487 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1489 # this only works for negative numbers when shifting in base 2
1490 if (($x->{sign} eq '-') && ($n == 2))
1492 return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
1495 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1496 # but perhaps there is a better emulation for two's complement shift...
1497 # if $y != 1, we must simulate it by doing:
1498 # convert to bin, flip all bits, shift, and be done
1499 $x->binc(); # -3 => -2
1500 my $bin = $x->as_bin();
1501 $bin =~ s/^-0b//; # strip '-0b' prefix
1502 $bin =~ tr/10/01/; # flip bits
1504 if (length($bin) <= $y)
1506 $bin = '0'; # shifting to far right creates -1
1507 # 0, because later increment makes
1508 # that 1, attached '-' makes it '-1'
1509 # because -1 >> x == -1 !
1513 $bin =~ s/.{$y}$//; # cut off at the right side
1514 $bin = '1' . $bin; # extend left side by one dummy '1'
1515 $bin =~ tr/10/01/; # flip bits back
1517 my $res = $self->new('0b'.$bin); # add prefix and convert back
1518 $res->binc(); # remember to increment
1519 $x->{value} = $res->{value}; # take over value
1520 return $x->round($a,$p,$r); # we are done now, magic, isn't?
1522 $x->bdec(); # n == 2, but $y == 1: this fixes it
1525 my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
1529 return $x->round($a,$p,$r);
1532 $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
1538 #(BINT or num_str, BINT or num_str) return BINT
1540 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1542 return $x if $x->modify('band');
1544 local $Math::BigInt::upgrade = undef;
1546 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1547 return $x->bzero() if $y->is_zero() || $x->is_zero();
1549 my $sign = 0; # sign of result
1550 $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1551 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1552 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1554 if ($CALC->can('_and') && $sx == 1 && $sy == 1)
1556 $x->{value} = $CALC->_and($x->{value},$y->{value});
1557 return $x->round($a,$p,$r);
1560 my $m = $self->bone(); my ($xr,$yr);
1561 my $x10000 = $self->new (0x1000);
1562 my $y1 = copy(ref($x),$y); # make copy
1563 $y1->babs(); # and positive
1564 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1565 use integer; # need this for negative bools
1566 while (!$x1->is_zero() && !$y1->is_zero())
1568 ($x1, $xr) = bdiv($x1, $x10000);
1569 ($y1, $yr) = bdiv($y1, $x10000);
1570 # make both op's numbers!
1571 $x->badd( bmul( $class->new(
1572 abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1576 $x->bneg() if $sign;
1577 return $x->round($a,$p,$r);
1582 #(BINT or num_str, BINT or num_str) return BINT
1584 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1586 return $x if $x->modify('bior');
1588 local $Math::BigInt::upgrade = undef;
1590 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1591 return $x if $y->is_zero();
1593 my $sign = 0; # sign of result
1594 $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1595 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1596 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1598 # don't use lib for negative values
1599 if ($CALC->can('_or') && $sx == 1 && $sy == 1)
1601 $x->{value} = $CALC->_or($x->{value},$y->{value});
1602 return $x->round($a,$p,$r);
1605 my $m = $self->bone(); my ($xr,$yr);
1606 my $x10000 = $self->new(0x10000);
1607 my $y1 = copy(ref($x),$y); # make copy
1608 $y1->babs(); # and positive
1609 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1610 use integer; # need this for negative bools
1611 while (!$x1->is_zero() || !$y1->is_zero())
1613 ($x1, $xr) = bdiv($x1,$x10000);
1614 ($y1, $yr) = bdiv($y1,$x10000);
1615 # make both op's numbers!
1616 $x->badd( bmul( $class->new(
1617 abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1621 $x->bneg() if $sign;
1622 return $x->round($a,$p,$r);
1627 #(BINT or num_str, BINT or num_str) return BINT
1629 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1631 return $x if $x->modify('bxor');
1633 local $Math::BigInt::upgrade = undef;
1635 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1636 return $x if $y->is_zero();
1638 my $sign = 0; # sign of result
1639 $sign = 1 if $x->{sign} ne $y->{sign};
1640 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1641 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1643 # don't use lib for negative values
1644 if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
1646 $x->{value} = $CALC->_xor($x->{value},$y->{value});
1647 return $x->round($a,$p,$r);
1650 my $m = $self->bone(); my ($xr,$yr);
1651 my $x10000 = $self->new(0x10000);
1652 my $y1 = copy(ref($x),$y); # make copy
1653 $y1->babs(); # and positive
1654 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1655 use integer; # need this for negative bools
1656 while (!$x1->is_zero() || !$y1->is_zero())
1658 ($x1, $xr) = bdiv($x1, $x10000);
1659 ($y1, $yr) = bdiv($y1, $x10000);
1660 # make both op's numbers!
1661 $x->badd( bmul( $class->new(
1662 abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1666 $x->bneg() if $sign;
1667 return $x->round($a,$p,$r);
1672 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1674 my $e = $CALC->_len($x->{value});
1675 return wantarray ? ($e,0) : $e;
1680 # return the nth decimal digit, negative values count backward, 0 is right
1684 return $CALC->_digit($x->{value},$n);
1689 # return the amount of trailing zeros in $x
1691 $x = $class->new($x) unless ref $x;
1693 return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
1695 return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1697 # if not: since we do not know underlying internal representation:
1698 my $es = "$x"; $es =~ /([0]*)$/;
1699 return 0 if !defined $1; # no zeros
1700 return CORE::length("$1"); # as string, not as +0!
1705 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1707 return $x if $x->modify('bsqrt');
1709 return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
1710 return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
1711 return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
1713 return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
1715 if ($CALC->can('_sqrt'))
1717 $x->{value} = $CALC->_sqrt($x->{value});
1718 return $x->round($a,$p,$r);
1721 return $x->bone($a,$p) if $x < 4; # 2,3 => 1
1723 my $l = int($x->length()/2);
1725 $x->bone(); # keep ref($x), but modify it
1728 my $last = $self->bzero();
1729 my $two = $self->new(2);
1730 my $lastlast = $x+$two;
1731 while ($last != $x && $lastlast != $x)
1733 $lastlast = $last; $last = $x;
1737 $x-- if $x * $x > $y; # overshot?
1738 $x->round($a,$p,$r);
1743 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
1744 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1746 if ($x->{sign} !~ /^[+-]$/)
1748 my $s = $x->{sign}; $s =~ s/^[+-]//;
1749 return $self->new($s); # -inf,+inf => inf
1751 my $e = $class->bzero();
1752 return $e->binc() if $x->is_zero();
1753 $e += $x->_trailing_zeros();
1759 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
1760 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1762 if ($x->{sign} !~ /^[+-]$/)
1764 return $self->new($x->{sign}); # keep + or - sign
1767 # that's inefficient
1768 my $zeros = $m->_trailing_zeros();
1769 $m /= 10 ** $zeros if $zeros != 0;
1775 # return a copy of both the exponent and the mantissa
1776 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1778 return ($x->mantissa(),$x->exponent());
1781 ##############################################################################
1782 # rounding functions
1786 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1787 # $n == 0 || $n == 1 => round to integer
1788 my $x = shift; $x = $class->new($x) unless ref $x;
1789 my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
1790 return $x if !defined $scale; # no-op
1791 return $x if $x->modify('bfround');
1793 # no-op for BigInts if $n <= 0
1796 $x->{_a} = undef; # clear an eventual set A
1797 $x->{_p} = $scale; return $x;
1800 $x->bround( $x->length()-$scale, $mode);
1801 $x->{_a} = undef; # bround sets {_a}
1802 $x->{_p} = $scale; # so correct it
1806 sub _scan_for_nonzero
1812 my $len = $x->length();
1813 return 0 if $len == 1; # '5' is trailed by invisible zeros
1814 my $follow = $pad - 1;
1815 return 0 if $follow > $len || $follow < 1;
1817 # since we do not know underlying represention of $x, use decimal string
1818 #my $r = substr ($$xs,-$follow);
1819 my $r = substr ("$x",-$follow);
1820 return 1 if $r =~ /[^0]/; return 0;
1825 # to make life easier for switch between MBF and MBI (autoload fxxx()
1826 # like MBF does for bxxx()?)
1828 return $x->bround(@_);
1833 # accuracy: +$n preserve $n digits from left,
1834 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1836 # and overwrite the rest with 0's, return normalized number
1837 # do not return $x->bnorm(), but $x
1839 my $x = shift; $x = $class->new($x) unless ref $x;
1840 my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
1841 return $x if !defined $scale; # no-op
1842 return $x if $x->modify('bround');
1844 if ($x->is_zero() || $scale == 0)
1846 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
1849 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
1851 # we have fewer digits than we want to scale to
1852 my $len = $x->length();
1853 # scale < 0, but > -len (not >=!)
1854 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
1856 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
1860 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1861 my ($pad,$digit_round,$digit_after);
1862 $pad = $len - $scale;
1863 $pad = abs($scale-1) if $scale < 0;
1865 # do not use digit(), it is costly for binary => decimal
1867 my $xs = $CALC->_str($x->{value});
1870 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1871 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
1872 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1873 $pl++; $pl ++ if $pad >= $len;
1874 $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
1876 # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
1878 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1879 # closer at the remaining digits of the original $x, remember decision
1880 my $round_up = 1; # default round up
1882 ($mode eq 'trunc') || # trunc by round down
1883 ($digit_after =~ /[01234]/) || # round down anyway,
1885 ($digit_after eq '5') && # not 5000...0000
1886 ($x->_scan_for_nonzero($pad,$xs) == 0) &&
1888 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1889 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
1890 ($mode eq '+inf') && ($x->{sign} eq '-') ||
1891 ($mode eq '-inf') && ($x->{sign} eq '+') ||
1892 ($mode eq 'zero') # round down if zero, sign adjusted below
1894 my $put_back = 0; # not yet modified
1896 # old code, depend on internal representation
1897 # split mantissa at $pad and then pad with zeros
1898 #my $s5 = int($pad / 5);
1902 # $x->{value}->[$i++] = 0; # replace with 5 x 0
1904 #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
1905 #my $rem = $pad % 5; # so much left over
1908 # #print "remainder $rem\n";
1909 ## #print "elem $x->{value}->[$s5]\n";
1910 # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
1912 #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
1913 #print ${$CALC->_str($pad->{value})}," $len\n";
1915 if (($pad > 0) && ($pad <= $len))
1917 substr($$xs,-$pad,$pad) = '0' x $pad;
1922 $x->bzero(); # round to '0'
1925 if ($round_up) # what gave test above?
1928 $pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
1930 # we modify directly the string variant instead of creating a number and
1932 my $c = 0; $pad ++; # for $pad == $len case
1933 while ($pad <= $len)
1935 $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
1936 substr($$xs,-$pad,1) = $c; $pad++;
1937 last if $c != 0; # no overflow => early out
1939 $$xs = '1'.$$xs if $c == 0;
1941 # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
1943 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
1945 $x->{_a} = $scale if $scale >= 0;
1948 $x->{_a} = $len+$scale;
1949 $x->{_a} = 0 if $scale < -$len;
1956 # return integer less or equal then number, since it is already integer,
1957 # always returns $self
1958 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1960 # not needed: return $x if $x->modify('bfloor');
1961 return $x->round($a,$p,$r);
1966 # return integer greater or equal then number, since it is already integer,
1967 # always returns $self
1968 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1970 # not needed: return $x if $x->modify('bceil');
1971 return $x->round($a,$p,$r);
1974 ##############################################################################
1975 # private stuff (internal use only)
1979 # internal speedup, set argument to 1, or create a +/- 1
1981 my $x = $self->bone(); # $x->{value} = $CALC->_one();
1982 $x->{sign} = shift || '+';
1988 # Overload will swap params if first one is no object ref so that the first
1989 # one is always an object ref. In this case, third param is true.
1990 # This routine is to overcome the effect of scalar,$object creating an object
1991 # of the class of this package, instead of the second param $object. This
1992 # happens inside overload, when the overload section of this package is
1993 # inherited by sub classes.
1994 # For overload cases (and this is used only there), we need to preserve the
1995 # args, hence the copy().
1996 # You can override this method in a subclass, the overload section will call
1997 # $object->_swap() to make sure it arrives at the proper subclass, with some
1998 # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
1999 # specify your own overload for them.
2001 # object, (object|scalar) => preserve first and make copy
2002 # scalar, object => swapped, re-swap and create new from first
2003 # (using class of second object, not $class!!)
2004 my $self = shift; # for override in subclass
2007 my $c = ref ($_[0]) || $class; # fallback $class should not happen
2008 return ( $c->new($_[1]), $_[0] );
2010 return ( $_[0]->copy(), $_[1] );
2015 # check for strings, if yes, return objects instead
2017 # the first argument is number of args objectify() should look at it will
2018 # return $count+1 elements, the first will be a classname. This is because
2019 # overloaded '""' calls bstr($object,undef,undef) and this would result in
2020 # useless objects beeing created and thrown away. So we cannot simple loop
2021 # over @_. If the given count is 0, all arguments will be used.
2023 # If the second arg is a ref, use it as class.
2024 # If not, try to use it as classname, unless undef, then use $class
2025 # (aka Math::BigInt). The latter shouldn't happen,though.
2028 # $x->badd(1); => ref x, scalar y
2029 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2030 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2031 # Math::BigInt::badd(1,2); => scalar x, scalar y
2032 # In the last case we check number of arguments to turn it silently into
2033 # $class,1,2. (We can not take '1' as class ;o)
2034 # badd($class,1) is not supported (it should, eventually, try to add undef)
2035 # currently it tries 'Math::BigInt' + 1, which will not work.
2037 # some shortcut for the common cases
2040 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
2041 # $x->binary_op($y);
2042 #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2)
2043 # && ref($_[1]) && ref($_[2]);
2045 my $count = abs(shift || 0);
2047 my @a; # resulting array
2050 # okay, got object as first
2055 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2057 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2059 # print "Now in objectify, my class is today $a[0]\n";
2068 $k = $a[0]->new($k);
2070 elsif (ref($k) ne $a[0])
2072 # foreign object, try to convert to integer
2073 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
2086 $k = $a[0]->new($k);
2088 elsif (ref($k) ne $a[0])
2090 # foreign object, try to convert to integer
2091 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
2095 push @a,@_; # return other params, too
2097 die "$class objectify needs list context" unless wantarray;
2106 my @a = @_; my $l = scalar @_; my $j = 0;
2107 for ( my $i = 0; $i < $l ; $i++,$j++ )
2109 if ($_[$i] eq ':constant')
2111 # this causes overlord er load to step in
2112 overload::constant integer => sub { $self->new(shift) };
2113 splice @a, $j, 1; $j --;
2115 elsif ($_[$i] eq 'upgrade')
2117 # this causes upgrading
2118 $upgrade = $_[$i+1]; # or undef to disable
2119 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
2120 splice @a, $j, $s; $j -= $s;
2122 elsif ($_[$i] =~ /^lib$/i)
2124 # this causes a different low lib to take care...
2125 $CALC = $_[$i+1] || '';
2126 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
2127 splice @a, $j, $s; $j -= $s;
2130 # any non :constant stuff is handled by our parent, Exporter
2131 # even if @_ is empty, to give it a chance
2132 $self->SUPER::import(@a); # need it for subclasses
2133 $self->export_to_level(1,$self,@a); # need it for MBF
2135 # try to load core math lib
2136 my @c = split /\s*,\s*/,$CALC;
2137 push @c,'Calc'; # if all fail, try this
2138 $CALC = ''; # signal error
2139 foreach my $lib (@c)
2141 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2145 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
2146 # used in the same script, or eval inside import().
2147 (my $mod = $lib . '.pm') =~ s!::!/!g;
2148 # require does not automatically :: => /, so portability problems arise
2149 eval { require $mod; $lib->import( @c ); }
2153 eval "use $lib qw/@c/;";
2155 $CALC = $lib, last if $@ eq ''; # no error in loading lib?
2157 die "Couldn't load any math lib, not even the default" if $CALC eq '';
2162 # convert a (ref to) big hex string to BigInt, return undef for error
2165 my $x = Math::BigInt->bzero();
2168 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2169 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2171 return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
2173 my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
2175 $$hs =~ s/^[+-]//; # strip sign
2176 if ($CALC->can('_from_hex'))
2178 $x->{value} = $CALC->_from_hex($hs);
2182 # fallback to pure perl
2183 my $mul = Math::BigInt->bzero(); $mul++;
2184 my $x65536 = Math::BigInt->new(65536);
2185 my $len = CORE::length($$hs)-2;
2186 $len = int($len/4); # 4-digit parts, w/o '0x'
2187 my $val; my $i = -4;
2190 $val = substr($$hs,$i,4);
2191 $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
2192 $val = hex($val); # hex does not like wrong chars
2194 $x += $mul * $val if $val != 0;
2195 $mul *= $x65536 if $len >= 0; # skip last mul
2198 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2204 # convert a (ref to) big binary string to BigInt, return undef for error
2207 my $x = Math::BigInt->bzero();
2209 $$bs =~ s/([01])_([01])/$1$2/g;
2210 $$bs =~ s/([01])_([01])/$1$2/g;
2211 return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
2213 my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
2214 $$bs =~ s/^[+-]//; # strip sign
2215 if ($CALC->can('_from_bin'))
2217 $x->{value} = $CALC->_from_bin($bs);
2221 my $mul = Math::BigInt->bzero(); $mul++;
2222 my $x256 = Math::BigInt->new(256);
2223 my $len = CORE::length($$bs)-2;
2224 $len = int($len/8); # 8-digit parts, w/o '0b'
2225 my $val; my $i = -8;
2228 $val = substr($$bs,$i,8);
2229 $val =~ s/^[+-]?0b// if $len == 0; # for last part only
2230 #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
2232 # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
2233 $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
2235 $x += $mul * $val if $val != 0;
2236 $mul *= $x256 if $len >= 0; # skip last mul
2239 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2245 # (ref to num_str) return num_str
2246 # internal, take apart a string and return the pieces
2247 # strip leading/trailing whitespace, leading zeros, underscore and reject
2251 # strip white space at front, also extranous leading zeros
2252 $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2253 $$x =~ s/^\s+//; # but this will
2254 $$x =~ s/\s+$//g; # strip white space at end
2256 # shortcut, if nothing to split, return early
2257 if ($$x =~ /^[+-]?\d+$/)
2259 $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2260 return (\$sign, $x, \'', \'', \0);
2263 # invalid starting char?
2264 return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
2266 return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
2267 return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
2269 # strip underscores between digits
2270 $$x =~ s/(\d)_(\d)/$1$2/g;
2271 $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
2273 # some possible inputs:
2274 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
2275 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
2277 return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
2279 my ($m,$e) = split /[Ee]/,$$x;
2280 $e = '0' if !defined $e || $e eq "";
2281 # sign,value for exponent,mantint,mantfrac
2282 my ($es,$ev,$mis,$miv,$mfv);
2284 if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2288 return if $m eq '.' || $m eq '';
2289 my ($mi,$mf) = split /\./,$m;
2290 $mi = '0' if !defined $mi;
2291 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2292 $mf = '0' if !defined $mf || $mf eq '';
2293 if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2295 $mis = $1||'+'; $miv = $2;
2296 return unless ($mf =~ /^(\d*?)0*$/); # strip trailing zeros
2298 return (\$mis,\$miv,\$mfv,\$es,\$ev);
2301 return; # NaN, not a number
2306 # an object might be asked to return itself as bigint on certain overloaded
2307 # operations, this does exactly this, so that sub classes can simple inherit
2308 # it or override with their own integer conversion routine
2316 # return as hex string, with prefixed 0x
2317 my $x = shift; $x = $class->new($x) if !ref($x);
2319 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2320 return '0x0' if $x->is_zero();
2322 my $es = ''; my $s = '';
2323 $s = $x->{sign} if $x->{sign} eq '-';
2324 if ($CALC->can('_as_hex'))
2326 $es = ${$CALC->_as_hex($x->{value})};
2330 my $x1 = $x->copy()->babs(); my $xr;
2331 my $x10000 = Math::BigInt->new (0x10000);
2332 while (!$x1->is_zero())
2334 ($x1, $xr) = bdiv($x1,$x10000);
2335 $es .= unpack('h4',pack('v',$xr->numify()));
2338 $es =~ s/^[0]+//; # strip leading zeros
2346 # return as binary string, with prefixed 0b
2347 my $x = shift; $x = $class->new($x) if !ref($x);
2349 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2350 return '0b0' if $x->is_zero();
2352 my $es = ''; my $s = '';
2353 $s = $x->{sign} if $x->{sign} eq '-';
2354 if ($CALC->can('_as_bin'))
2356 $es = ${$CALC->_as_bin($x->{value})};
2360 my $x1 = $x->copy()->babs(); my $xr;
2361 my $x10000 = Math::BigInt->new (0x10000);
2362 while (!$x1->is_zero())
2364 ($x1, $xr) = bdiv($x1,$x10000);
2365 $es .= unpack('b16',pack('v',$xr->numify()));
2368 $es =~ s/^[0]+//; # strip leading zeros
2374 ##############################################################################
2375 # internal calculation routines (others are in Math::BigInt::Calc etc)
2379 # (BINT or num_str, BINT or num_str) return BINT
2380 # does modify first argument
2383 my $x = shift; my $ty = shift;
2384 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
2385 return $x * $ty / bgcd($x,$ty);
2390 # (BINT or num_str, BINT or num_str) return BINT
2391 # does modify both arguments
2392 # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
2395 return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
2397 while (!$ty->is_zero())
2399 ($x, $ty) = ($ty,bmod($x,$ty));
2404 ###############################################################################
2405 # this method return 0 if the object can be modified, or 1 for not
2406 # We use a fast use constant statement here, to avoid costly calls. Subclasses
2407 # may override it with special code (f.i. Math::BigInt::Constant does so)
2409 sub modify () { 0; }
2416 Math::BigInt - Arbitrary size integer math package
2423 $x = Math::BigInt->new($str); # defaults to 0
2424 $nan = Math::BigInt->bnan(); # create a NotANumber
2425 $zero = Math::BigInt->bzero(); # create a +0
2426 $inf = Math::BigInt->binf(); # create a +inf
2427 $inf = Math::BigInt->binf('-'); # create a -inf
2428 $one = Math::BigInt->bone(); # create a +1
2429 $one = Math::BigInt->bone('-'); # create a -1
2432 $x->is_zero(); # true if arg is +0
2433 $x->is_nan(); # true if arg is NaN
2434 $x->is_one(); # true if arg is +1
2435 $x->is_one('-'); # true if arg is -1
2436 $x->is_odd(); # true if odd, false for even
2437 $x->is_even(); # true if even, false for odd
2438 $x->is_positive(); # true if >= 0
2439 $x->is_negative(); # true if < 0
2440 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
2441 $x->is_int(); # true if $x is an integer (not a float)
2443 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2444 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2445 $x->sign(); # return the sign, either +,- or NaN
2446 $x->digit($n); # return the nth digit, counting from right
2447 $x->digit(-$n); # return the nth digit, counting from left
2449 # The following all modify their first argument:
2452 $x->bzero(); # set $x to 0
2453 $x->bnan(); # set $x to NaN
2454 $x->bone(); # set $x to +1
2455 $x->bone('-'); # set $x to -1
2456 $x->binf(); # set $x to inf
2457 $x->binf('-'); # set $x to -inf
2459 $x->bneg(); # negation
2460 $x->babs(); # absolute value
2461 $x->bnorm(); # normalize (no-op)
2462 $x->bnot(); # two's complement (bit wise not)
2463 $x->binc(); # increment x by 1
2464 $x->bdec(); # decrement x by 1
2466 $x->badd($y); # addition (add $y to $x)
2467 $x->bsub($y); # subtraction (subtract $y from $x)
2468 $x->bmul($y); # multiplication (multiply $x by $y)
2469 $x->bdiv($y); # divide, set $x to quotient
2470 # return (quo,rem) or quo if scalar
2472 $x->bmod($y); # modulus (x % y)
2473 $x->bpow($y); # power of arguments (x ** y)
2474 $x->blsft($y); # left shift
2475 $x->brsft($y); # right shift
2476 $x->blsft($y,$n); # left shift, by base $n (like 10)
2477 $x->brsft($y,$n); # right shift, by base $n (like 10)
2479 $x->band($y); # bitwise and
2480 $x->bior($y); # bitwise inclusive or
2481 $x->bxor($y); # bitwise exclusive or
2482 $x->bnot(); # bitwise not (two's complement)
2484 $x->bsqrt(); # calculate square-root
2485 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
2487 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2488 $x->bround($N); # accuracy: preserve $N digits
2489 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2491 # The following do not modify their arguments in BigInt, but do in BigFloat:
2492 $x->bfloor(); # return integer less or equal than $x
2493 $x->bceil(); # return integer greater or equal than $x
2495 # The following do not modify their arguments:
2497 bgcd(@values); # greatest common divisor (no OO style)
2498 blcm(@values); # lowest common multiplicator (no OO style)
2500 $x->length(); # return number of digits in number
2501 ($x,$f) = $x->length(); # length of number and length of fraction part,
2502 # latter is always 0 digits long for BigInt's
2504 $x->exponent(); # return exponent as BigInt
2505 $x->mantissa(); # return (signed) mantissa as BigInt
2506 $x->parts(); # return (mantissa,exponent) as BigInt
2507 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2508 $x->as_number(); # return as BigInt (in BigInt: same as copy())
2510 # conversation to string
2511 $x->bstr(); # normalized string
2512 $x->bsstr(); # normalized string in scientific notation
2513 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2514 $x->as_bin(); # as signed binary string with prefixed 0b
2518 All operators (inlcuding basic math operations) are overloaded if you
2519 declare your big integers as
2521 $i = new Math::BigInt '123_456_789_123_456_789';
2523 Operations with overloaded operators preserve the arguments which is
2524 exactly what you expect.
2528 =item Canonical notation
2530 Big integer values are strings of the form C</^[+-]\d+$/> with leading
2533 '-0' canonical value '-0', normalized '0'
2534 ' -123_123_123' canonical value '-123123123'
2535 '1_23_456_7890' canonical value '1234567890'
2539 Input values to these routines may be either Math::BigInt objects or
2540 strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2542 You can include one underscore between any two digits.
2544 This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2545 Non integer values result in NaN.
2547 Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2550 bnorm() on a BigInt object is now effectively a no-op, since the numbers
2551 are always stored in normalized form. On a string, it creates a BigInt
2556 Output values are BigInt objects (normalized), except for bstr(), which
2557 returns a string in normalized form.
2558 Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2559 C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2560 return either undef, <0, 0 or >0 and are suited for sort.
2566 Each of the methods below accepts three additional parameters. These arguments
2567 $A, $P and $R are accuracy, precision and round_mode. Please see more in the
2568 section about ACCURACY and ROUNDIND.
2572 $x->accuracy(5); # local for $x
2573 $class->accuracy(5); # global for all members of $class
2575 Set or get the global or local accuracy, aka how many significant digits the
2576 results have. Please see the section about L<ACCURACY AND PRECISION> for
2579 Value must be greater than zero. Pass an undef value to disable it:
2581 $x->accuracy(undef);
2582 Math::BigInt->accuracy(undef);
2584 Returns the current accuracy. For C<$x->accuracy()> it will return either the
2585 local accuracy, or if not defined, the global. This means the return value
2586 represents the accuracy that will be in effect for $x:
2588 $y = Math::BigInt->new(1234567); # unrounded
2589 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
2590 $x = Math::BigInt->new(123456); # will be automatically rounded
2591 print "$x $y\n"; # '123500 1234567'
2592 print $x->accuracy(),"\n"; # will be 4
2593 print $y->accuracy(),"\n"; # also 4, since global is 4
2594 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
2595 print $x->accuracy(),"\n"; # still 4
2596 print $y->accuracy(),"\n"; # 5, since global is 5
2602 Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
2603 2, but others work, too.
2605 Right shifting usually amounts to dividing $x by $n ** $y and truncating the
2609 $x = Math::BigInt->new(10);
2610 $x->brsft(1); # same as $x >> 1: 5
2611 $x = Math::BigInt->new(1234);
2612 $x->brsft(2,10); # result 12
2614 There is one exception, and that is base 2 with negative $x:
2617 $x = Math::BigInt->new(-5);
2620 This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
2625 $x = Math::BigInt->new($str,$A,$P,$R);
2627 Creates a new BigInt object from a string or another BigInt object. The
2628 input is accepted as decimal, hex (with leading '0x') or binary (with leading
2633 $x = Math::BigInt->bnan();
2635 Creates a new BigInt object representing NaN (Not A Number).
2636 If used on an object, it will set it to NaN:
2642 $x = Math::BigInt->bzero();
2644 Creates a new BigInt object representing zero.
2645 If used on an object, it will set it to zero:
2651 $x = Math::BigInt->binf($sign);
2653 Creates a new BigInt object representing infinity. The optional argument is
2654 either '-' or '+', indicating whether you want infinity or minus infinity.
2655 If used on an object, it will set it to infinity:
2662 $x = Math::BigInt->binf($sign);
2664 Creates a new BigInt object representing one. The optional argument is
2665 either '-' or '+', indicating whether you want one or minus one.
2666 If used on an object, it will set it to one:
2671 =head2 is_one() / is_zero() / is_nan() / is_positive() / is_negative() /
2672 is_inf() / is_odd() / is_even() / is_int()
2674 $x->is_zero(); # true if arg is +0
2675 $x->is_nan(); # true if arg is NaN
2676 $x->is_one(); # true if arg is +1
2677 $x->is_one('-'); # true if arg is -1
2678 $x->is_odd(); # true if odd, false for even
2679 $x->is_even(); # true if even, false for odd
2680 $x->is_positive(); # true if >= 0
2681 $x->is_negative(); # true if < 0
2682 $x->is_inf(); # true if +inf
2683 $x->is_inf('-'); # true if -inf (sign is default '+')
2684 $x->is_int(); # true if $x is an integer
2686 These methods all test the BigInt for one condition and return true or false
2687 depending on the input.
2691 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2695 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2699 $x->sign(); # return the sign, either +,- or NaN
2703 $x->digit($n); # return the nth digit, counting from right
2709 Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
2710 and '-inf', respectively. Does nothing for NaN or zero.
2716 Set the number to it's absolute value, e.g. change the sign from '-' to '+'
2717 and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
2722 $x->bnorm(); # normalize (no-op)
2726 $x->bnot(); # two's complement (bit wise not)
2730 $x->binc(); # increment x by 1
2734 $x->bdec(); # decrement x by 1
2738 $x->badd($y); # addition (add $y to $x)
2742 $x->bsub($y); # subtraction (subtract $y from $x)
2746 $x->bmul($y); # multiplication (multiply $x by $y)
2750 $x->bdiv($y); # divide, set $x to quotient
2751 # return (quo,rem) or quo if scalar
2755 $x->bmod($y); # modulus (x % y)
2759 $x->bpow($y); # power of arguments (x ** y)
2763 $x->blsft($y); # left shift
2764 $x->blsft($y,$n); # left shift, by base $n (like 10)
2768 $x->brsft($y); # right shift
2769 $x->brsft($y,$n); # right shift, by base $n (like 10)
2773 $x->band($y); # bitwise and
2777 $x->bior($y); # bitwise inclusive or
2781 $x->bxor($y); # bitwise exclusive or
2785 $x->bnot(); # bitwise not (two's complement)
2789 $x->bsqrt(); # calculate square-root
2793 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
2797 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2801 $x->bround($N); # accuracy: preserve $N digits
2805 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2811 Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
2812 does change $x in BigFloat.
2818 Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
2819 does change $x in BigFloat.
2823 bgcd(@values); # greatest common divisor (no OO style)
2827 blcm(@values); # lowest common multiplicator (no OO style)
2832 ($xl,$fl) = $x->length();
2834 Returns the number of digits in the decimal representation of the number.
2835 In list context, returns the length of the integer and fraction part. For
2836 BigInt's, the length of the fraction part will always be 0.
2842 Return the exponent of $x as BigInt.
2848 Return the signed mantissa of $x as BigInt.
2852 $x->parts(); # return (mantissa,exponent) as BigInt
2856 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2860 $x->as_number(); # return as BigInt (in BigInt: same as copy())
2864 $x->bstr(); # normalized string
2868 $x->bsstr(); # normalized string in scientific notation
2872 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2876 $x->as_bin(); # as signed binary string with prefixed 0b
2878 =head1 ACCURACY and PRECISION
2880 Since version v1.33, Math::BigInt and Math::BigFloat have full support for
2881 accuracy and precision based rounding, both automatically after every
2882 operation as well as manually.
2884 This section describes the accuracy/precision handling in Math::Big* as it
2885 used to be and as it is now, complete with an explanation of all terms and
2888 Not yet implemented things (but with correct description) are marked with '!',
2889 things that need to be answered are marked with '?'.
2891 In the next paragraph follows a short description of terms used here (because
2892 these may differ from terms used by others people or documentation).
2894 During the rest of this document, the shortcuts A (for accuracy), P (for
2895 precision), F (fallback) and R (rounding mode) will be used.
2899 A fixed number of digits before (positive) or after (negative)
2900 the decimal point. For example, 123.45 has a precision of -2. 0 means an
2901 integer like 123 (or 120). A precision of 2 means two digits to the left
2902 of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2903 numbers with zeros before the decimal point may have different precisions,
2904 because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2905 was). It could also have p < 0, when the digits after the decimal point
2908 The string output (of floating point numbers) will be padded with zeros:
2910 Initial value P A Result String
2911 ------------------------------------------------------------
2912 1234.01 -3 1000 1000
2915 1234.001 1 1234 1234.0
2917 1234.01 2 1234.01 1234.01
2918 1234.01 5 1234.01 1234.01000
2920 For BigInts, no padding occurs.
2924 Number of significant digits. Leading zeros are not counted. A
2925 number may have an accuracy greater than the non-zero digits
2926 when there are zeros in it or trailing zeros. For example, 123.456 has
2927 A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
2929 The string output (of floating point numbers) will be padded with zeros:
2931 Initial value P A Result String
2932 ------------------------------------------------------------
2934 1234.01 6 1234.01 1234.01
2935 1234.1 8 1234.1 1234.1000
2937 For BigInts, no padding occurs.
2941 When both A and P are undefined, this is used as a fallback accuracy when
2944 =head2 Rounding mode R
2946 When rounding a number, different 'styles' or 'kinds'
2947 of rounding are possible. (Note that random rounding, as in
2948 Math::Round, is not implemented.)
2954 truncation invariably removes all digits following the
2955 rounding place, replacing them with zeros. Thus, 987.65 rounded
2956 to tens (P=1) becomes 980, and rounded to the fourth sigdig
2957 becomes 987.6 (A=4). 123.456 rounded to the second place after the
2958 decimal point (P=-2) becomes 123.46.
2960 All other implemented styles of rounding attempt to round to the
2961 "nearest digit." If the digit D immediately to the right of the
2962 rounding place (skipping the decimal point) is greater than 5, the
2963 number is incremented at the rounding place (possibly causing a
2964 cascade of incrementation): e.g. when rounding to units, 0.9 rounds
2965 to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
2966 truncated at the rounding place: e.g. when rounding to units, 0.4
2967 rounds to 0, and -19.4 rounds to -19.
2969 However the results of other styles of rounding differ if the
2970 digit immediately to the right of the rounding place (skipping the
2971 decimal point) is 5 and if there are no digits, or no digits other
2972 than 0, after that 5. In such cases:
2976 rounds the digit at the rounding place to 0, 2, 4, 6, or 8
2977 if it is not already. E.g., when rounding to the first sigdig, 0.45
2978 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
2982 rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
2983 it is not already. E.g., when rounding to the first sigdig, 0.45
2984 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
2988 round to plus infinity, i.e. always round up. E.g., when
2989 rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
2990 and 0.4501 also becomes 0.5.
2994 round to minus infinity, i.e. always round down. E.g., when
2995 rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
2996 but 0.4501 becomes 0.5.
3000 round to zero, i.e. positive numbers down, negative ones up.
3001 E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
3002 becomes -0.5, but 0.4501 becomes 0.5.
3006 The handling of A & P in MBI/MBF (the old core code shipped with Perl
3007 versions <= 5.7.2) is like this:
3013 * ffround($p) is able to round to $p number of digits after the decimal
3015 * otherwise P is unused
3017 =item Accuracy (significant digits)
3019 * fround($a) rounds to $a significant digits
3020 * only fdiv() and fsqrt() take A as (optional) paramater
3021 + other operations simply create the same number (fneg etc), or more (fmul)
3023 + rounding/truncating is only done when explicitly calling one of fround
3024 or ffround, and never for BigInt (not implemented)
3025 * fsqrt() simply hands its accuracy argument over to fdiv.
3026 * the documentation and the comment in the code indicate two different ways
3027 on how fdiv() determines the maximum number of digits it should calculate,
3028 and the actual code does yet another thing
3030 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
3032 result has at most max(scale, length(dividend), length(divisor)) digits
3034 scale = max(scale, length(dividend)-1,length(divisor)-1);
3035 scale += length(divisior) - length(dividend);
3036 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
3037 Actually, the 'difference' added to the scale is calculated from the
3038 number of "significant digits" in dividend and divisor, which is derived
3039 by looking at the length of the mantissa. Which is wrong, since it includes
3040 the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
3041 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
3042 assumption that 124 has 3 significant digits, while 120/7 will get you
3043 '17', not '17.1' since 120 is thought to have 2 significant digits.
3044 The rounding after the division then uses the remainder and $y to determine
3045 wether it must round up or down.
3046 ? I have no idea which is the right way. That's why I used a slightly more
3047 ? simple scheme and tweaked the few failing testcases to match it.
3051 This is how it works now:
3055 =item Setting/Accessing
3057 * You can set the A global via Math::BigInt->accuracy() or
3058 Math::BigFloat->accuracy() or whatever class you are using.
3059 * You can also set P globally by using Math::SomeClass->precision() likewise.
3060 * Globals are classwide, and not inherited by subclasses.
3061 * to undefine A, use Math::SomeCLass->accuracy(undef);
3062 * to undefine P, use Math::SomeClass->precision(undef);
3063 * Setting Math::SomeClass->accuracy() clears automatically
3064 Math::SomeClass->precision(), and vice versa.
3065 * To be valid, A must be > 0, P can have any value.
3066 * If P is negative, this means round to the P'th place to the right of the
3067 decimal point; positive values mean to the left of the decimal point.
3068 P of 0 means round to integer.
3069 * to find out the current global A, take Math::SomeClass->accuracy()
3070 * to find out the current global P, take Math::SomeClass->precision()
3071 * use $x->accuracy() respective $x->precision() for the local setting of $x.
3072 * Please note that $x->accuracy() respecive $x->precision() fall back to the
3073 defined globals, when $x's A or P is not set.
3075 =item Creating numbers
3077 * When you create a number, you can give it's desired A or P via:
3078 $x = Math::BigInt->new($number,$A,$P);
3079 * Only one of A or P can be defined, otherwise the result is NaN
3080 * If no A or P is give ($x = Math::BigInt->new($number) form), then the
3081 globals (if set) will be used. Thus changing the global defaults later on
3082 will not change the A or P of previously created numbers (i.e., A and P of
3083 $x will be what was in effect when $x was created)
3084 * If given undef for A and P, B<no> rounding will occur, and the globals will
3085 B<not> be used. This is used by subclasses to create numbers without
3086 suffering rounding in the parent. Thus a subclass is able to have it's own
3087 globals enforced upon creation of a number by using
3088 $x = Math::BigInt->new($number,undef,undef):
3090 use Math::Bigint::SomeSubclass;
3093 Math::BigInt->accuracy(2);
3094 Math::BigInt::SomeSubClass->accuracy(3);
3095 $x = Math::BigInt::SomeSubClass->new(1234);
3097 $x is now 1230, and not 1200. A subclass might choose to implement
3098 this otherwise, e.g. falling back to the parent's A and P.
3102 * If A or P are enabled/defined, they are used to round the result of each
3103 operation according to the rules below
3104 * Negative P is ignored in Math::BigInt, since BigInts never have digits
3105 after the decimal point
3106 * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
3107 Math::BigInt as globals should not tamper with the parts of a BigFloat.
3108 Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
3112 * It only makes sense that a number has only one of A or P at a time.
3113 Since you can set/get both A and P, there is a rule that will practically
3114 enforce only A or P to be in effect at a time, even if both are set.
3115 This is called precedence.
3116 * If two objects are involved in an operation, and one of them has A in
3117 effect, and the other P, this results in an error (NaN).
3118 * A takes precendence over P (Hint: A comes before P). If A is defined, it
3119 is used, otherwise P is used. If neither of them is defined, nothing is
3120 used, i.e. the result will have as many digits as it can (with an
3121 exception for fdiv/fsqrt) and will not be rounded.
3122 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
3123 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
3124 If either the dividend's or the divisor's mantissa has more digits than
3125 the value of F, the higher value will be used instead of F.
3126 This is to limit the digits (A) of the result (just consider what would
3127 happen with unlimited A and P in the case of 1/3 :-)
3128 * fdiv will calculate (at least) 4 more digits than required (determined by
3129 A, P or F), and, if F is not used, round the result
3130 (this will still fail in the case of a result like 0.12345000000001 with A
3131 or P of 5, but this can not be helped - or can it?)
3132 * Thus you can have the math done by on Math::Big* class in three modes:
3133 + never round (this is the default):
3134 This is done by setting A and P to undef. No math operation
3135 will round the result, with fdiv() and fsqrt() as exceptions to guard
3136 against overflows. You must explicitely call bround(), bfround() or
3137 round() (the latter with parameters).
3138 Note: Once you have rounded a number, the settings will 'stick' on it
3139 and 'infect' all other numbers engaged in math operations with it, since
3140 local settings have the highest precedence. So, to get SaferRound[tm],
3141 use a copy() before rounding like this:
3143 $x = Math::BigFloat->new(12.34);
3144 $y = Math::BigFloat->new(98.76);
3145 $z = $x * $y; # 1218.6984
3146 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
3147 $z = $x * $y; # still 1218.6984, without
3148 # copy would have been 1210!
3150 + round after each op:
3151 After each single operation (except for testing like is_zero()), the
3152 method round() is called and the result is rounded appropriately. By
3153 setting proper values for A and P, you can have all-the-same-A or
3154 all-the-same-P modes. For example, Math::Currency might set A to undef,
3155 and P to -2, globally.
3157 ?Maybe an extra option that forbids local A & P settings would be in order,
3158 ?so that intermediate rounding does not 'poison' further math?
3160 =item Overriding globals
3162 * you will be able to give A, P and R as an argument to all the calculation
3163 routines; the second parameter is A, the third one is P, and the fourth is
3164 R (shift right by one for binary operations like badd). P is used only if
3165 the first parameter (A) is undefined. These three parameters override the
3166 globals in the order detailed as follows, i.e. the first defined value
3168 (local: per object, global: global default, parameter: argument to sub)
3171 + local A (if defined on both of the operands: smaller one is taken)
3172 + local P (if defined on both of the operands: bigger one is taken)
3176 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
3177 arguments (A and P) instead of one
3179 =item Local settings
3181 * You can set A and P locally by using $x->accuracy() and $x->precision()
3182 and thus force different A and P for different objects/numbers.
3183 * Setting A or P this way immediately rounds $x to the new value.
3184 * $x->accuracy() clears $x->precision(), and vice versa.
3188 * the rounding routines will use the respective global or local settings.
3189 fround()/bround() is for accuracy rounding, while ffround()/bfround()
3191 * the two rounding functions take as the second parameter one of the
3192 following rounding modes (R):
3193 'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
3194 * you can set and get the global R by using Math::SomeClass->round_mode()
3195 or by setting $Math::SomeClass::round_mode
3196 * after each operation, $result->round() is called, and the result may
3197 eventually be rounded (that is, if A or P were set either locally,
3198 globally or as parameter to the operation)
3199 * to manually round a number, call $x->round($A,$P,$round_mode);
3200 this will round the number by using the appropriate rounding function
3201 and then normalize it.
3202 * rounding modifies the local settings of the number:
3204 $x = Math::BigFloat->new(123.456);
3208 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
3209 will be 4 from now on.
3211 =item Default values
3220 * The defaults are set up so that the new code gives the same results as
3221 the old code (except in a few cases on fdiv):
3222 + Both A and P are undefined and thus will not be used for rounding
3223 after each operation.
3224 + round() is thus a no-op, unless given extra parameters A and P
3230 The actual numbers are stored as unsigned big integers (with seperate sign).
3231 You should neither care about nor depend on the internal representation; it
3232 might change without notice. Use only method calls like C<< $x->sign(); >>
3233 instead relying on the internal hash keys like in C<< $x->{sign}; >>.
3237 Math with the numbers is done (by default) by a module called
3238 Math::BigInt::Calc. This is equivalent to saying:
3240 use Math::BigInt lib => 'Calc';
3242 You can change this by using:
3244 use Math::BigInt lib => 'BitVect';
3246 The following would first try to find Math::BigInt::Foo, then
3247 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
3249 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
3251 Calc.pm uses as internal format an array of elements of some decimal base
3252 (usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm
3253 uses a bit vector of base 2, most significant bit first. Other modules might
3254 use even different means of representing the numbers. See the respective
3255 module documentation for further details.
3259 The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
3261 A sign of 'NaN' is used to represent the result when input arguments are not
3262 numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
3263 minus infinity. You will get '+inf' when dividing a positive number by 0, and
3264 '-inf' when dividing any negative number by 0.
3266 =head2 mantissa(), exponent() and parts()
3268 C<mantissa()> and C<exponent()> return the said parts of the BigInt such
3271 $m = $x->mantissa();
3272 $e = $x->exponent();
3273 $y = $m * ( 10 ** $e );
3274 print "ok\n" if $x == $y;
3276 C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
3277 in one go. Both the returned mantissa and exponent have a sign.
3279 Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
3280 where it will be NaN; and for $x == 0, where it will be 1
3281 (to be compatible with Math::BigFloat's internal representation of a zero as
3284 C<$m> will always be a copy of the original number. The relation between $e
3285 and $m might change in the future, but will always be equivalent in a
3286 numerical sense, e.g. $m might get minimized.
3292 sub bint { Math::BigInt->new(shift); }
3294 $x = Math::BigInt->bstr("1234") # string "1234"
3295 $x = "$x"; # same as bstr()
3296 $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
3297 $x = Math::BigInt->babs("-12345"); # Bigint "12345"
3298 $x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
3299 $x = bint(1) + bint(2); # BigInt "3"
3300 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
3301 $x = bint(1); # BigInt "1"
3302 $x = $x + 5 / 2; # BigInt "3"
3303 $x = $x ** 3; # BigInt "27"
3304 $x *= 2; # BigInt "54"
3305 $x = Math::BigInt->new(0); # BigInt "0"
3307 $x = Math::BigInt->badd(4,5) # BigInt "9"
3308 print $x->bsstr(); # 9e+0
3310 Examples for rounding:
3315 $x = Math::BigFloat->new(123.4567);
3316 $y = Math::BigFloat->new(123.456789);
3317 Math::BigFloat->accuracy(4); # no more A than 4
3319 ok ($x->copy()->fround(),123.4); # even rounding
3320 print $x->copy()->fround(),"\n"; # 123.4
3321 Math::BigFloat->round_mode('odd'); # round to odd
3322 print $x->copy()->fround(),"\n"; # 123.5
3323 Math::BigFloat->accuracy(5); # no more A than 5
3324 Math::BigFloat->round_mode('odd'); # round to odd
3325 print $x->copy()->fround(),"\n"; # 123.46
3326 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
3327 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
3329 Math::BigFloat->accuracy(undef); # A not important now
3330 Math::BigFloat->precision(2); # P important
3331 print $x->copy()->bnorm(),"\n"; # 123.46
3332 print $x->copy()->fround(),"\n"; # 123.46
3334 Examples for converting:
3336 my $x = Math::BigInt->new('0b1'.'01' x 123);
3337 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
3339 =head1 Autocreating constants
3341 After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
3342 in the given scope are converted to C<Math::BigInt>. This conversion
3343 happens at compile time.
3347 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
3349 prints the integer value of C<2**100>. Note that without conversion of
3350 constants the expression 2**100 will be calculated as perl scalar.
3352 Please note that strings and floating point constants are not affected,
3355 use Math::BigInt qw/:constant/;
3357 $x = 1234567890123456789012345678901234567890
3358 + 123456789123456789;
3359 $y = '1234567890123456789012345678901234567890'
3360 + '123456789123456789';
3362 do not work. You need an explicit Math::BigInt->new() around one of the
3363 operands. You should also quote large constants to protect loss of precision:
3367 $x = Math::BigInt->new('1234567889123456789123456789123456789');
3369 Without the quotes Perl would convert the large number to a floating point
3370 constant at compile time and then hand the result to BigInt, which results in
3371 an truncated result or a NaN.
3375 Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
3376 must be made in the second case. For long numbers, the copy can eat up to 20%
3377 of the work (in the case of addition/subtraction, less for
3378 multiplication/division). If $y is very small compared to $x, the form
3379 $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
3380 more time then the actual addition.
3382 With a technique called copy-on-write, the cost of copying with overload could
3383 be minimized or even completely avoided. A test implementation of COW did show
3384 performance gains for overloaded math, but introduced a performance loss due
3385 to a constant overhead for all other operatons.
3387 The rewritten version of this module is slower on certain operations, like
3388 new(), bstr() and numify(). The reason are that it does now more work and
3389 handles more cases. The time spent in these operations is usually gained in
3390 the other operations so that programs on the average should get faster. If
3391 they don't, please contect the author.
3393 Some operations may be slower for small numbers, but are significantly faster
3394 for big numbers. Other operations are now constant (O(1), like bneg(), babs()
3395 etc), instead of O(N) and thus nearly always take much less time. These
3396 optimizations were done on purpose.
3398 If you find the Calc module to slow, try to install any of the replacement
3399 modules and see if they help you.
3401 =head2 Alternative math libraries
3403 You can use an alternative library to drive Math::BigInt via:
3405 use Math::BigInt lib => 'Module';
3407 See L<MATH LIBRARY> for more information.
3409 For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
3413 =head1 Subclassing Math::BigInt
3415 The basic design of Math::BigInt allows simple subclasses with very little
3416 work, as long as a few simple rules are followed:
3422 The public API must remain consistent, i.e. if a sub-class is overloading
3423 addition, the sub-class must use the same name, in this case badd(). The
3424 reason for this is that Math::BigInt is optimized to call the object methods
3429 The private object hash keys like C<$x->{sign}> may not be changed, but
3430 additional keys can be added, like C<$x->{_custom}>.
3434 Accessor functions are available for all existing object hash keys and should
3435 be used instead of directly accessing the internal hash keys. The reason for
3436 this is that Math::BigInt itself has a pluggable interface which permits it
3437 to support different storage methods.
3441 More complex sub-classes may have to replicate more of the logic internal of
3442 Math::BigInt if they need to change more basic behaviors. A subclass that
3443 needs to merely change the output only needs to overload C<bstr()>.
3445 All other object methods and overloaded functions can be directly inherited
3446 from the parent class.
3448 At the very minimum, any subclass will need to provide it's own C<new()> and can
3449 store additional hash keys in the object. There are also some package globals
3450 that must be defined, e.g.:
3454 $precision = -2; # round to 2 decimal places
3455 $round_mode = 'even';
3458 Additionally, you might want to provide the following two globals to allow
3459 auto-upgrading and auto-downgrading to work correctly:
3464 This allows Math::BigInt to correctly retrieve package globals from the
3465 subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
3466 t/Math/BigFloat/SubClass.pm completely functional subclass examples.
3472 in your subclass to automatically inherit the overloading from the parent. If
3473 you like, you can change part of the overloading, look at Math::String for an
3478 When used like this:
3480 use Math::BigInt upgrade => 'Foo::Bar';
3482 certain operations will 'upgrade' their calculation and thus the result to
3483 the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
3485 use Math::BigInt upgrade => 'Math::BigFloat';
3487 As a shortcut, you can use the module C<bignum>:
3491 Also good for oneliners:
3493 perl -Mbignum -le 'print 2 ** 255'
3495 This makes it possible to mix arguments of different classes (as in 2.5 + 2)
3496 as well es preserve accuracy (as in sqrt(3)).
3498 Beware: This feature is not fully implemented yet.
3502 The following methods upgrade themselves unconditionally; that is if upgrade
3503 is in effect, they will always hand up their work:
3515 Beware: This list is not complete.
3517 All other methods upgrade themselves only when one (or all) of their
3518 arguments are of the class mentioned in $upgrade (This might change in later
3519 versions to a more sophisticated scheme):
3525 =item Out of Memory!
3527 Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
3528 C<eval()> in your code will crash with "Out of memory". This is probably an
3529 overload/exporter bug. You can workaround by not having C<eval()>
3530 and ':constant' at the same time or upgrade your Perl to a newer version.
3532 =item Fails to load Calc on Perl prior 5.6.0
3534 Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
3535 will fall back to eval { require ... } when loading the math lib on Perls
3536 prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
3537 filesystems using a different seperator.
3543 Some things might not work as you expect them. Below is documented what is
3544 known to be troublesome:
3548 =item stringify, bstr(), bsstr() and 'cmp'
3550 Both stringify and bstr() now drop the leading '+'. The old code would return
3551 '+3', the new returns '3'. This is to be consistent with Perl and to make
3552 cmp (especially with overloading) to work as you expect. It also solves
3553 problems with Test.pm, it's ok() uses 'eq' internally.
3555 Mark said, when asked about to drop the '+' altogether, or make only cmp work:
3557 I agree (with the first alternative), don't add the '+' on positive
3558 numbers. It's not as important anymore with the new internal
3559 form for numbers. It made doing things like abs and neg easier,
3560 but those have to be done differently now anyway.
3562 So, the following examples will now work all as expected:
3565 BEGIN { plan tests => 1 }
3568 my $x = new Math::BigInt 3*3;
3569 my $y = new Math::BigInt 3*3;
3572 print "$x eq 9" if $x eq $y;
3573 print "$x eq 9" if $x eq '9';
3574 print "$x eq 9" if $x eq 3*3;
3576 Additionally, the following still works:
3578 print "$x == 9" if $x == $y;
3579 print "$x == 9" if $x == 9;
3580 print "$x == 9" if $x == 3*3;
3582 There is now a C<bsstr()> method to get the string in scientific notation aka
3583 C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
3584 for comparisation, but Perl will represent some numbers as 100 and others
3585 as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
3588 BEGIN { plan tests => 3 }
3591 $x = Math::BigInt->new('1e56'); $y = 1e56;
3592 ok ($x,$y); # will fail
3593 ok ($x->bsstr(),$y); # okay
3594 $y = Math::BigInt->new($y);
3597 Alternatively, simple use <=> for comparisations, that will get it always
3598 right. There is not yet a way to get a number automatically represented as
3599 a string that matches exactly the way Perl represents it.
3603 C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
3606 $x = Math::BigInt->new(123);
3607 $y = int($x); # BigInt 123
3608 $x = Math::BigFloat->new(123.45);
3609 $y = int($x); # BigInt 123
3611 In all Perl versions you can use C<as_number()> for the same effect:
3613 $x = Math::BigFloat->new(123.45);
3614 $y = $x->as_number(); # BigInt 123
3616 This also works for other subclasses, like Math::String.
3618 It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
3622 The following will probably not do what you expect:
3624 $c = Math::BigInt->new(123);
3625 print $c->length(),"\n"; # prints 30
3627 It prints both the number of digits in the number and in the fraction part
3628 since print calls C<length()> in list context. Use something like:
3630 print scalar $c->length(),"\n"; # prints 3
3634 The following will probably not do what you expect:
3636 print $c->bdiv(10000),"\n";
3638 It prints both quotient and remainder since print calls C<bdiv()> in list
3639 context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
3642 print $c / 10000,"\n";
3643 print scalar $c->bdiv(10000),"\n"; # or if you want to modify $c
3647 The quotient is always the greatest integer less than or equal to the
3648 real-valued quotient of the two operands, and the remainder (when it is
3649 nonzero) always has the same sign as the second operand; so, for
3659 As a consequence, the behavior of the operator % agrees with the
3660 behavior of Perl's built-in % operator (as documented in the perlop
3661 manpage), and the equation
3663 $x == ($x / $y) * $y + ($x % $y)
3665 holds true for any $x and $y, which justifies calling the two return
3666 values of bdiv() the quotient and remainder. The only exception to this rule
3667 are when $y == 0 and $x is negative, then the remainder will also be
3668 negative. See below under "infinity handling" for the reasoning behing this.
3670 Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
3671 not change BigInt's way to do things. This is because under 'use integer' Perl
3672 will do what the underlying C thinks is right and this is different for each
3673 system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
3674 the author to implement it ;)
3676 =item infinity handling
3678 Here are some examples that explain the reasons why certain results occur while
3681 The following table shows the result of the division and the remainder, so that
3682 the equation above holds true. Some "ordinary" cases are strewn in to show more
3683 clearly the reasoning:
3685 A / B = C, R so that C * B + R = A
3686 =========================================================
3687 5 / 8 = 0, 5 0 * 8 + 5 = 5
3688 0 / 8 = 0, 0 0 * 8 + 0 = 0
3689 0 / inf = 0, 0 0 * inf + 0 = 0
3690 0 /-inf = 0, 0 0 * -inf + 0 = 0
3691 5 / inf = 0, 5 0 * inf + 5 = 5
3692 5 /-inf = 0, 5 0 * -inf + 5 = 5
3693 -5/ inf = 0, -5 0 * inf + -5 = -5
3694 -5/-inf = 0, -5 0 * -inf + -5 = -5
3695 inf/ 5 = inf, 0 inf * 5 + 0 = inf
3696 -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
3697 inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
3698 -inf/ -5 = inf, 0 inf * -5 + 0 = -inf
3699 5/ 5 = 1, 0 1 * 5 + 0 = 5
3700 -5/ -5 = 1, 0 1 * -5 + 0 = -5
3701 inf/ inf = 1, 0 1 * inf + 0 = inf
3702 -inf/-inf = 1, 0 1 * -inf + 0 = -inf
3703 inf/-inf = -1, 0 -1 * -inf + 0 = inf
3704 -inf/ inf = -1, 0 1 * -inf + 0 = -inf
3705 8/ 0 = inf, 8 inf * 0 + 8 = 8
3706 inf/ 0 = inf, inf inf * 0 + inf = inf
3709 These cases below violate the "remainder has the sign of the second of the two
3710 arguments", since they wouldn't match up otherwise.
3712 A / B = C, R so that C * B + R = A
3713 ========================================================
3714 -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
3715 -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
3717 =item Modifying and =
3721 $x = Math::BigFloat->new(5);
3724 It will not do what you think, e.g. making a copy of $x. Instead it just makes
3725 a second reference to the B<same> object and stores it in $y. Thus anything
3726 that modifies $x (except overloaded operators) will modify $y, and vice versa.
3727 Or in other words, C<=> is only safe if you modify your BigInts only via
3728 overloaded math. As soon as you use a method call it breaks:
3731 print "$x, $y\n"; # prints '10, 10'
3733 If you want a true copy of $x, use:
3737 You can also chain the calls like this, this will make first a copy and then
3740 $y = $x->copy()->bmul(2);
3742 See also the documentation for overload.pm regarding C<=>.
3746 C<bpow()> (and the rounding functions) now modifies the first argument and
3747 returns it, unlike the old code which left it alone and only returned the
3748 result. This is to be consistent with C<badd()> etc. The first three will
3749 modify $x, the last one won't:
3751 print bpow($x,$i),"\n"; # modify $x
3752 print $x->bpow($i),"\n"; # ditto
3753 print $x **= $i,"\n"; # the same
3754 print $x ** $i,"\n"; # leave $x alone
3756 The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
3758 =item Overloading -$x
3768 since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
3769 needs to preserve $x since it does not know that it later will get overwritten.
3770 This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
3772 With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
3773 since it is slower for all other things.
3775 =item Mixing different object types
3777 In Perl you will get a floating point value if you do one of the following:
3783 With overloaded math, only the first two variants will result in a BigFloat:
3788 $mbf = Math::BigFloat->new(5);
3789 $mbi2 = Math::BigInteger->new(5);
3790 $mbi = Math::BigInteger->new(2);
3792 # what actually gets called:
3793 $float = $mbf + $mbi; # $mbf->badd()
3794 $float = $mbf / $mbi; # $mbf->bdiv()
3795 $integer = $mbi + $mbf; # $mbi->badd()
3796 $integer = $mbi2 / $mbi; # $mbi2->bdiv()
3797 $integer = $mbi2 / $mbf; # $mbi2->bdiv()
3799 This is because math with overloaded operators follows the first (dominating)
3800 operand, and the operation of that is called and returns thus the result. So,
3801 Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
3802 the result should be a Math::BigFloat or the second operant is one.
3804 To get a Math::BigFloat you either need to call the operation manually,
3805 make sure the operands are already of the proper type or casted to that type
3806 via Math::BigFloat->new():
3808 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
3810 Beware of simple "casting" the entire expression, this would only convert
3811 the already computed result:
3813 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
3815 Beware also of the order of more complicated expressions like:
3817 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
3818 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
3820 If in doubt, break the expression into simpler terms, or cast all operands
3821 to the desired resulting type.
3823 Scalar values are a bit different, since:
3828 will both result in the proper type due to the way the overloaded math works.
3830 This section also applies to other overloaded math packages, like Math::String.
3832 One solution to you problem might be L<autoupgrading|upgrading>.
3836 C<bsqrt()> works only good if the result is a big integer, e.g. the square
3837 root of 144 is 12, but from 12 the square root is 3, regardless of rounding
3840 If you want a better approximation of the square root, then use:
3842 $x = Math::BigFloat->new(12);
3843 Math::BigFloat->precision(0);
3844 Math::BigFloat->round_mode('even');
3845 print $x->copy->bsqrt(),"\n"; # 4
3847 Math::BigFloat->precision(2);
3848 print $x->bsqrt(),"\n"; # 3.46
3849 print $x->bsqrt(3),"\n"; # 3.464
3853 For negative numbers in base see also L<brsft|brsft>.
3859 This program is free software; you may redistribute it and/or modify it under
3860 the same terms as Perl itself.
3864 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
3865 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
3868 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
3869 more documentation including a full version history, testcases, empty
3870 subclass files and benchmarks.
3874 Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
3875 Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.