This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Math::BigInt 1.55, from Tels.
[perl5.git] / lib / Math / BigInt.pm
CommitLineData
13a12e00
JH
1package Math::BigInt;
2
3#
4# "Mike had an infinite amount to do and a negative amount of time in which
5# to do it." - Before and After
6#
7
58cde26e 8# The following hash values are used:
0716bf9b 9# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
58cde26e
JH
10# sign : +,-,NaN,+inf,-inf
11# _a : accuracy
12# _p : precision
0716bf9b 13# _f : flags, used by MBF to flag parts of a float as untouchable
b4f14daa 14
574bacfe
JH
15# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
16# underlying lib might change the reference!
17
58cde26e 18my $class = "Math::BigInt";
0716bf9b 19require 5.005;
58cde26e 20
56b9c951 21$VERSION = '1.55';
58cde26e
JH
22use Exporter;
23@ISA = qw( Exporter );
61f5c3f5 24@EXPORT_OK = qw( objectify _swap bgcd blcm);
027dc388 25use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
b3abae2a 26use vars qw/$upgrade $downgrade/;
58cde26e
JH
27use strict;
28
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.
34
35# For overloaded ops with only one argument we simple use $_[0]->copy() to
36# preserve the argument.
37
38# Thus inheritance of overload operators becomes possible and transparent for
39# our subclasses without the need to repeat the entire overload section there.
a0d0e21e 40
a5f75d66 41use overload
58cde26e
JH
42'=' => sub { $_[0]->copy(); },
43
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]) :
49 $c->bsub( $_[1]) },
50'+' => sub { $_[0]->copy()->badd($_[1]); },
51
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]); },
027dc388
JH
59'%=' => sub { $_[0]->bmod($_[1]); },
60'^=' => sub { $_[0]->bxor($_[1]); },
61'&=' => sub { $_[0]->band($_[1]); },
62'|=' => sub { $_[0]->bior($_[1]); },
58cde26e
JH
63'**=' => sub { $_[0]->bpow($_[1]); },
64
b3abae2a 65# not supported by Perl yet
027dc388
JH
66'..' => \&_pointpoint,
67
58cde26e 68'<=>' => sub { $_[2] ?
bd05a461
JH
69 ref($_[0])->bcmp($_[1],$_[0]) :
70 ref($_[0])->bcmp($_[0],$_[1])},
027dc388 71'cmp' => sub {
58cde26e 72 $_[2] ?
b3abae2a
JH
73 "$_[1]" cmp $_[0]->bstr() :
74 $_[0]->bstr() cmp "$_[1]" },
58cde26e 75
61f5c3f5 76'log' => sub { $_[0]->copy()->blog(); },
58cde26e
JH
77'int' => sub { $_[0]->copy(); },
78'neg' => sub { $_[0]->copy()->bneg(); },
79'abs' => sub { $_[0]->copy()->babs(); },
b3abae2a 80'sqrt' => sub { $_[0]->copy()->bsqrt(); },
58cde26e
JH
81'~' => sub { $_[0]->copy()->bnot(); },
82
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]); },
89
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]); },
93
94# can modify arg of ++ and --, so avoid a new-copy for speed, but don't
574bacfe 95# use $_[0]->__one(), it modifies $_[0] to be 1!
58cde26e
JH
96'++' => sub { $_[0]->binc() },
97'--' => sub { $_[0]->bdec() },
98
99# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
100'bool' => sub {
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();
104 undef $t if $t == 0;
b3abae2a 105 $t;
58cde26e 106 },
a0d0e21e 107
027dc388
JH
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(); }
a5f75d66 112;
a0d0e21e 113
58cde26e
JH
114##############################################################################
115# global constants, flags and accessory
116
0716bf9b
JH
117use constant MB_NEVER_ROUND => 0x0001;
118
119my $NaNOK=1; # are NaNs ok?
120my $nan = 'NaN'; # constants for easier life
121
122my $CALC = 'Math::BigInt::Calc'; # module to do low level math
61f5c3f5 123my $IMPORT = 0; # did import() yet?
0716bf9b 124
ee15d750
JH
125$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
126$accuracy = undef;
127$precision = undef;
128$div_scale = 40;
58cde26e 129
b3abae2a
JH
130$upgrade = undef; # default is no upgrade
131$downgrade = undef; # default is no downgrade
132
027dc388
JH
133##############################################################################
134# the old code had $rnd_mode, so we need to support it, too
135
136$rnd_mode = 'even';
137sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; }
138sub FETCH { return $round_mode; }
139sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
140
141BEGIN { tie $rnd_mode, 'Math::BigInt'; }
142
143##############################################################################
144
58cde26e
JH
145sub round_mode
146 {
ee15d750 147 no strict 'refs';
58cde26e 148 # make Class->round_mode() work
ee15d750
JH
149 my $self = shift;
150 my $class = ref($self) || $self || __PACKAGE__;
58cde26e
JH
151 if (defined $_[0])
152 {
153 my $m = shift;
154 die "Unknown round mode $m"
155 if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
b3abae2a 156 return ${"${class}::round_mode"} = $m;
58cde26e 157 }
ee15d750
JH
158 return ${"${class}::round_mode"};
159 }
160
b3abae2a
JH
161sub upgrade
162 {
163 no strict 'refs';
28df3e88 164 # make Class->upgrade() work
b3abae2a
JH
165 my $self = shift;
166 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
167 # need to set new value?
168 if (@_ > 0)
b3abae2a
JH
169 {
170 my $u = shift;
171 return ${"${class}::upgrade"} = $u;
172 }
173 return ${"${class}::upgrade"};
174 }
175
28df3e88
JH
176sub downgrade
177 {
178 no strict 'refs';
179 # make Class->downgrade() work
180 my $self = shift;
181 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
182 # need to set new value?
183 if (@_ > 0)
28df3e88
JH
184 {
185 my $u = shift;
186 return ${"${class}::downgrade"} = $u;
187 }
188 return ${"${class}::downgrade"};
189 }
190
ee15d750
JH
191sub div_scale
192 {
193 no strict 'refs';
194 # make Class->round_mode() work
195 my $self = shift;
196 my $class = ref($self) || $self || __PACKAGE__;
197 if (defined $_[0])
198 {
199 die ('div_scale must be greater than zero') if $_[0] < 0;
200 ${"${class}::div_scale"} = shift;
201 }
202 return ${"${class}::div_scale"};
58cde26e
JH
203 }
204
205sub accuracy
206 {
ee15d750
JH
207 # $x->accuracy($a); ref($x) $a
208 # $x->accuracy(); ref($x)
209 # Class->accuracy(); class
210 # Class->accuracy($a); class $a
58cde26e 211
ee15d750
JH
212 my $x = shift;
213 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 214
ee15d750
JH
215 no strict 'refs';
216 # need to set new value?
58cde26e
JH
217 if (@_ > 0)
218 {
ee15d750
JH
219 my $a = shift;
220 die ('accuracy must not be zero') if defined $a && $a == 0;
221 if (ref($x))
222 {
223 # $object->accuracy() or fallback to global
224 $x->bround($a) if defined $a;
225 $x->{_a} = $a; # set/overwrite, even if not rounded
226 $x->{_p} = undef; # clear P
227 }
228 else
229 {
230 # set global
231 ${"${class}::accuracy"} = $a;
b3abae2a 232 ${"${class}::precision"} = undef; # clear P
ee15d750
JH
233 }
234 return $a; # shortcut
235 }
236
237 if (ref($x))
238 {
239 # $object->accuracy() or fallback to global
240 return $x->{_a} || ${"${class}::accuracy"};
58cde26e 241 }
ee15d750 242 return ${"${class}::accuracy"};
58cde26e
JH
243 }
244
245sub precision
246 {
ee15d750
JH
247 # $x->precision($p); ref($x) $p
248 # $x->precision(); ref($x)
249 # Class->precision(); class
250 # Class->precision($p); class $p
58cde26e 251
ee15d750
JH
252 my $x = shift;
253 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 254
ee15d750
JH
255 no strict 'refs';
256 # need to set new value?
58cde26e
JH
257 if (@_ > 0)
258 {
ee15d750
JH
259 my $p = shift;
260 if (ref($x))
261 {
262 # $object->precision() or fallback to global
263 $x->bfround($p) if defined $p;
264 $x->{_p} = $p; # set/overwrite, even if not rounded
b3abae2a 265 $x->{_a} = undef; # clear A
ee15d750
JH
266 }
267 else
268 {
269 # set global
270 ${"${class}::precision"} = $p;
b3abae2a 271 ${"${class}::accuracy"} = undef; # clear A
ee15d750
JH
272 }
273 return $p; # shortcut
58cde26e 274 }
ee15d750
JH
275
276 if (ref($x))
277 {
278 # $object->precision() or fallback to global
279 return $x->{_p} || ${"${class}::precision"};
280 }
281 return ${"${class}::precision"};
58cde26e
JH
282 }
283
b3abae2a
JH
284sub config
285 {
286 # return (later set?) configuration data as hash ref
287 my $class = shift || 'Math::BigInt';
288
289 no strict 'refs';
290 my $lib = $CALC;
291 my $cfg = {
292 lib => $lib,
293 lib_version => ${"${lib}::VERSION"},
294 class => $class,
295 };
296 foreach (
28df3e88 297 qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
b3abae2a
JH
298 {
299 $cfg->{lc($_)} = ${"${class}::$_"};
300 };
301 $cfg;
302 }
303
58cde26e
JH
304sub _scale_a
305 {
306 # select accuracy parameter based on precedence,
307 # used by bround() and bfround(), may return undef for scale (means no op)
308 my ($x,$s,$m,$scale,$mode) = @_;
309 $scale = $x->{_a} if !defined $scale;
310 $scale = $s if (!defined $scale);
311 $mode = $m if !defined $mode;
312 return ($scale,$mode);
313 }
314
315sub _scale_p
316 {
317 # select precision parameter based on precedence,
318 # used by bround() and bfround(), may return undef for scale (means no op)
319 my ($x,$s,$m,$scale,$mode) = @_;
320 $scale = $x->{_p} if !defined $scale;
321 $scale = $s if (!defined $scale);
322 $mode = $m if !defined $mode;
323 return ($scale,$mode);
324 }
325
326##############################################################################
327# constructors
328
329sub copy
330 {
331 my ($c,$x);
332 if (@_ > 1)
333 {
334 # if two arguments, the first one is the class to "swallow" subclasses
335 ($c,$x) = @_;
336 }
337 else
338 {
339 $x = shift;
340 $c = ref($x);
341 }
342 return unless ref($x); # only for objects
343
344 my $self = {}; bless $self,$c;
394e6ffb 345 my $r;
58cde26e
JH
346 foreach my $k (keys %$x)
347 {
0716bf9b
JH
348 if ($k eq 'value')
349 {
394e6ffb
JH
350 $self->{value} = $CALC->_copy($x->{value}); next;
351 }
352 if (!($r = ref($x->{$k})))
353 {
354 $self->{$k} = $x->{$k}; next;
0716bf9b 355 }
394e6ffb 356 if ($r eq 'SCALAR')
0716bf9b
JH
357 {
358 $self->{$k} = \${$x->{$k}};
359 }
394e6ffb 360 elsif ($r eq 'ARRAY')
58cde26e
JH
361 {
362 $self->{$k} = [ @{$x->{$k}} ];
363 }
394e6ffb 364 elsif ($r eq 'HASH')
58cde26e
JH
365 {
366 # only one level deep!
367 foreach my $h (keys %{$x->{$k}})
368 {
369 $self->{$k}->{$h} = $x->{$k}->{$h};
370 }
371 }
394e6ffb 372 else # normal ref
58cde26e 373 {
61f5c3f5 374 my $xk = $x->{$k};
394e6ffb
JH
375 if ($xk->can('copy'))
376 {
377 $self->{$k} = $xk->copy();
378 }
379 else
380 {
381 $self->{$k} = $xk->new($xk);
382 }
58cde26e
JH
383 }
384 }
385 $self;
386 }
387
388sub new
389 {
b22b3e31 390 # create a new BigInt object from a string or another BigInt object.
0716bf9b 391 # see hash keys documented at top
58cde26e
JH
392
393 # the argument could be an object, so avoid ||, && etc on it, this would
b22b3e31
PN
394 # cause costly overloaded code to be called. The only allowed ops are
395 # ref() and defined.
58cde26e 396
61f5c3f5 397 my ($class,$wanted,$a,$p,$r) = @_;
58cde26e 398
61f5c3f5
T
399 # avoid numify-calls by not using || on $wanted!
400 return $class->bzero($a,$p) if !defined $wanted; # default to 0
9393ace2
JH
401 return $class->copy($wanted,$a,$p,$r)
402 if ref($wanted) && $wanted->isa($class); # MBI or subclass
58cde26e 403
61f5c3f5
T
404 $class->import() if $IMPORT == 0; # make require work
405
9393ace2
JH
406 my $self = bless {}, $class;
407
408 # shortcut for "normal" numbers
409 if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*$/))
410 {
411 $self->{sign} = $1 || '+';
412 my $ref = \$wanted;
413 if ($wanted =~ /^[+-]/)
414 {
415 # remove sign without touching wanted
416 my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
417 }
418 $self->{value} = $CALC->_new($ref);
419 no strict 'refs';
420 if ( (defined $a) || (defined $p)
421 || (defined ${"${class}::precision"})
422 || (defined ${"${class}::accuracy"})
423 )
424 {
425 $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
426 }
427 return $self;
428 }
429
58cde26e 430 # handle '+inf', '-inf' first
ee15d750 431 if ($wanted =~ /^[+-]?inf$/)
58cde26e 432 {
0716bf9b 433 $self->{value} = $CALC->_zero();
ee15d750 434 $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
58cde26e
JH
435 return $self;
436 }
437 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
438 my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
58cde26e
JH
439 if (!ref $mis)
440 {
441 die "$wanted is not a number initialized to $class" if !$NaNOK;
442 #print "NaN 1\n";
0716bf9b 443 $self->{value} = $CALC->_zero();
58cde26e
JH
444 $self->{sign} = $nan;
445 return $self;
446 }
574bacfe
JH
447 if (!ref $miv)
448 {
449 # _from_hex or _from_bin
450 $self->{value} = $mis->{value};
451 $self->{sign} = $mis->{sign};
452 return $self; # throw away $mis
453 }
58cde26e
JH
454 # make integer from mantissa by adjusting exp, then convert to bigint
455 $self->{sign} = $$mis; # store sign
0716bf9b 456 $self->{value} = $CALC->_zero(); # for all the NaN cases
58cde26e
JH
457 my $e = int("$$es$$ev"); # exponent (avoid recursion)
458 if ($e > 0)
459 {
460 my $diff = $e - CORE::length($$mfv);
461 if ($diff < 0) # Not integer
462 {
463 #print "NOI 1\n";
b3abae2a 464 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
465 $self->{sign} = $nan;
466 }
467 else # diff >= 0
468 {
469 # adjust fraction and add it to value
470 # print "diff > 0 $$miv\n";
471 $$miv = $$miv . ($$mfv . '0' x $diff);
472 }
473 }
474 else
475 {
476 if ($$mfv ne '') # e <= 0
477 {
478 # fraction and negative/zero E => NOI
479 #print "NOI 2 \$\$mfv '$$mfv'\n";
b3abae2a 480 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
481 $self->{sign} = $nan;
482 }
483 elsif ($e < 0)
484 {
485 # xE-y, and empty mfv
486 #print "xE-y\n";
487 $e = abs($e);
488 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
489 {
490 #print "NOI 3\n";
b3abae2a 491 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
492 $self->{sign} = $nan;
493 }
494 }
495 }
496 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
0716bf9b 497 $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
0716bf9b 498 # if any of the globals is set, use them to round and store them inside $self
61f5c3f5
T
499 # do not round for new($x,undef,undef) since that is used by MBF to signal
500 # no rounding
501 $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
9393ace2 502 $self;
58cde26e
JH
503 }
504
58cde26e
JH
505sub bnan
506 {
507 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
b4f14daa 508 my $self = shift;
58cde26e
JH
509 $self = $class if !defined $self;
510 if (!ref($self))
511 {
512 my $c = $self; $self = {}; bless $self, $c;
513 }
61f5c3f5 514 $self->import() if $IMPORT == 0; # make require work
58cde26e 515 return if $self->modify('bnan');
13a12e00
JH
516 my $c = ref($self);
517 if ($self->can('_bnan'))
518 {
519 # use subclass to initialize
520 $self->_bnan();
521 }
522 else
523 {
524 # otherwise do our own thing
525 $self->{value} = $CALC->_zero();
526 }
0716bf9b 527 $self->{value} = $CALC->_zero();
58cde26e 528 $self->{sign} = $nan;
394e6ffb 529 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
58cde26e 530 return $self;
b4f14daa 531 }
58cde26e
JH
532
533sub binf
534 {
535 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
536 # the sign is either '+', or if given, used from there
537 my $self = shift;
56b9c951 538 my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
58cde26e
JH
539 $self = $class if !defined $self;
540 if (!ref($self))
541 {
542 my $c = $self; $self = {}; bless $self, $c;
543 }
61f5c3f5 544 $self->import() if $IMPORT == 0; # make require work
58cde26e 545 return if $self->modify('binf');
13a12e00
JH
546 my $c = ref($self);
547 if ($self->can('_binf'))
548 {
549 # use subclass to initialize
550 $self->_binf();
551 }
552 else
553 {
554 # otherwise do our own thing
555 $self->{value} = $CALC->_zero();
556 }
56b9c951
JH
557 $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
558 $self->{sign} = $sign;
394e6ffb 559 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
58cde26e
JH
560 return $self;
561 }
562
563sub bzero
564 {
565 # create a bigint '+0', if given a BigInt, set it to 0
566 my $self = shift;
567 $self = $class if !defined $self;
0716bf9b 568
58cde26e
JH
569 if (!ref($self))
570 {
571 my $c = $self; $self = {}; bless $self, $c;
572 }
61f5c3f5 573 $self->import() if $IMPORT == 0; # make require work
58cde26e 574 return if $self->modify('bzero');
13a12e00
JH
575
576 if ($self->can('_bzero'))
577 {
578 # use subclass to initialize
579 $self->_bzero();
580 }
581 else
582 {
583 # otherwise do our own thing
584 $self->{value} = $CALC->_zero();
585 }
58cde26e 586 $self->{sign} = '+';
61f5c3f5
T
587 if (@_ > 0)
588 {
589 $self->{_a} = $_[0]
590 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
591 $self->{_p} = $_[1]
592 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
593 }
58cde26e
JH
594 return $self;
595 }
596
574bacfe
JH
597sub bone
598 {
599 # create a bigint '+1' (or -1 if given sign '-'),
600 # if given a BigInt, set it to +1 or -1, respecively
601 my $self = shift;
602 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
603 $self = $class if !defined $self;
394e6ffb 604
574bacfe
JH
605 if (!ref($self))
606 {
607 my $c = $self; $self = {}; bless $self, $c;
608 }
61f5c3f5 609 $self->import() if $IMPORT == 0; # make require work
574bacfe 610 return if $self->modify('bone');
13a12e00
JH
611
612 if ($self->can('_bone'))
613 {
614 # use subclass to initialize
615 $self->_bone();
616 }
617 else
618 {
619 # otherwise do our own thing
620 $self->{value} = $CALC->_one();
621 }
574bacfe 622 $self->{sign} = $sign;
61f5c3f5
T
623 if (@_ > 0)
624 {
625 $self->{_a} = $_[0]
626 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
627 $self->{_p} = $_[1]
628 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
629 }
574bacfe
JH
630 return $self;
631 }
632
58cde26e
JH
633##############################################################################
634# string conversation
635
636sub bsstr
637 {
638 # (ref to BFLOAT or num_str ) return num_str
639 # Convert number from internal format to scientific string format.
640 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
dccbb853
JH
641 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
642 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 643
574bacfe
JH
644 if ($x->{sign} !~ /^[+-]$/)
645 {
646 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
647 return 'inf'; # +inf
648 }
58cde26e 649 my ($m,$e) = $x->parts();
574bacfe 650 # e can only be positive
58cde26e
JH
651 my $sign = 'e+';
652 # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
653 return $m->bstr().$sign.$e->bstr();
654 }
655
656sub bstr
657 {
0716bf9b 658 # make a string from bigint object
ee15d750
JH
659 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
660 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
56b9c951 661
574bacfe
JH
662 if ($x->{sign} !~ /^[+-]$/)
663 {
664 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
665 return 'inf'; # +inf
666 }
0716bf9b
JH
667 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
668 return $es.${$CALC->_str($x->{value})};
58cde26e
JH
669 }
670
671sub numify
672 {
394e6ffb 673 # Make a "normal" scalar from a BigInt object
58cde26e 674 my $x = shift; $x = $class->new($x) unless ref $x;
0716bf9b
JH
675 return $x->{sign} if $x->{sign} !~ /^[+-]$/;
676 my $num = $CALC->_num($x->{value});
677 return -$num if $x->{sign} eq '-';
9393ace2 678 $num;
58cde26e
JH
679 }
680
681##############################################################################
682# public stuff (usually prefixed with "b")
683
684sub sign
685 {
9393ace2 686 # return the sign of the number: +/-/-inf/+inf/NaN
ee15d750
JH
687 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
688
9393ace2 689 $x->{sign};
58cde26e
JH
690 }
691
ee15d750 692sub _find_round_parameters
58cde26e
JH
693 {
694 # After any operation or when calling round(), the result is rounded by
695 # regarding the A & P from arguments, local parameters, or globals.
61f5c3f5
T
696
697 # This procedure finds the round parameters, but it is for speed reasons
698 # duplicated in round. Otherwise, it is tested by the testsuite and used
699 # by fdiv().
700
394e6ffb
JH
701 my ($self,$a,$p,$r,@args) = @_;
702 # $a accuracy, if given by caller
703 # $p precision, if given by caller
704 # $r round_mode, if given by caller
705 # @args all 'other' arguments (0 for unary, 1 for binary ops)
58cde26e 706
17baacb7 707 # leave bigfloat parts alone
ee15d750 708 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
17baacb7 709
394e6ffb 710 my $c = ref($self); # find out class of argument(s)
574bacfe 711 no strict 'refs';
574bacfe 712
58cde26e 713 # now pick $a or $p, but only if we have got "arguments"
61f5c3f5 714 if (!defined $a)
58cde26e 715 {
61f5c3f5 716 foreach ($self,@args)
58cde26e
JH
717 {
718 # take the defined one, or if both defined, the one that is smaller
719 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
720 }
61f5c3f5
T
721 }
722 if (!defined $p)
ee15d750 723 {
61f5c3f5
T
724 # even if $a is defined, take $p, to signal error for both defined
725 foreach ($self,@args)
726 {
727 # take the defined one, or if both defined, the one that is bigger
728 # -2 > -3, and 3 > 2
729 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
730 }
ee15d750 731 }
61f5c3f5
T
732 # if still none defined, use globals (#2)
733 $a = ${"$c\::accuracy"} unless defined $a;
734 $p = ${"$c\::precision"} unless defined $p;
735
736 # no rounding today?
737 return ($self) unless defined $a || defined $p; # early out
738
739 # set A and set P is an fatal error
740 return ($self->bnan()) if defined $a && defined $p;
741
742 $r = ${"$c\::round_mode"} unless defined $r;
743 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
744
745 return ($self,$a,$p,$r);
ee15d750
JH
746 }
747
748sub round
749 {
61f5c3f5 750 # Round $self according to given parameters, or given second argument's
ee15d750 751 # parameters or global defaults
ee15d750 752
61f5c3f5
T
753 # for speed reasons, _find_round_parameters is embeded here:
754
755 my ($self,$a,$p,$r,@args) = @_;
756 # $a accuracy, if given by caller
757 # $p precision, if given by caller
758 # $r round_mode, if given by caller
759 # @args all 'other' arguments (0 for unary, 1 for binary ops)
760
761 # leave bigfloat parts alone
762 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
763
764 my $c = ref($self); # find out class of argument(s)
765 no strict 'refs';
766
767 # now pick $a or $p, but only if we have got "arguments"
768 if (!defined $a)
58cde26e 769 {
61f5c3f5
T
770 foreach ($self,@args)
771 {
772 # take the defined one, or if both defined, the one that is smaller
773 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
774 }
58cde26e 775 }
61f5c3f5
T
776 if (!defined $p)
777 {
778 # even if $a is defined, take $p, to signal error for both defined
779 foreach ($self,@args)
780 {
781 # take the defined one, or if both defined, the one that is bigger
782 # -2 > -3, and 3 > 2
783 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
784 }
785 }
786 # if still none defined, use globals (#2)
787 $a = ${"$c\::accuracy"} unless defined $a;
788 $p = ${"$c\::precision"} unless defined $p;
789
790 # no rounding today?
791 return $self unless defined $a || defined $p; # early out
792
793 # set A and set P is an fatal error
794 return $self->bnan() if defined $a && defined $p;
795
796 $r = ${"$c\::round_mode"} unless defined $r;
797 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
798
799 # now round, by calling either fround or ffround:
800 if (defined $a)
801 {
802 $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
803 }
804 else # both can't be undefined due to early out
58cde26e 805 {
61f5c3f5 806 $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
58cde26e 807 }
61f5c3f5 808 $self->bnorm(); # after round, normalize
58cde26e
JH
809 }
810
17baacb7 811sub bnorm
58cde26e 812 {
027dc388 813 # (numstr or BINT) return BINT
58cde26e 814 # Normalize number -- no-op here
dccbb853 815 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
b3abae2a 816 $x;
58cde26e
JH
817 }
818
819sub babs
820 {
821 # (BINT or num_str) return BINT
822 # make number absolute, or return absolute BINT from string
ee15d750
JH
823 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
824
58cde26e
JH
825 return $x if $x->modify('babs');
826 # post-normalized abs for internal use (does nothing for NaN)
827 $x->{sign} =~ s/^-/+/;
828 $x;
829 }
830
831sub bneg
832 {
833 # (BINT or num_str) return BINT
834 # negate number or make a negated number from string
ee15d750
JH
835 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
836
58cde26e 837 return $x if $x->modify('bneg');
b3abae2a 838
58cde26e 839 # for +0 dont negate (to have always normalized)
b3abae2a 840 $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
58cde26e
JH
841 $x;
842 }
843
844sub bcmp
845 {
846 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
847 # (BINT or num_str, BINT or num_str) return cond_code
848 my ($self,$x,$y) = objectify(2,@_);
0716bf9b
JH
849
850 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
851 {
852 # handle +-inf and NaN
853 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
574bacfe 854 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
0716bf9b
JH
855 return +1 if $x->{sign} eq '+inf';
856 return -1 if $x->{sign} eq '-inf';
857 return -1 if $y->{sign} eq '+inf';
b3abae2a 858 return +1;
0716bf9b 859 }
574bacfe
JH
860 # check sign for speed first
861 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
862 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
863
864 # shortcut
865 my $xz = $x->is_zero();
866 my $yz = $y->is_zero();
867 return 0 if $xz && $yz; # 0 <=> 0
868 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
869 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
dccbb853
JH
870
871 # post-normalized compare for internal use (honors signs)
872 if ($x->{sign} eq '+')
873 {
56b9c951 874 # $x and $y both > 0
dccbb853
JH
875 return $CALC->_acmp($x->{value},$y->{value});
876 }
877
56b9c951 878 # $x && $y both < 0
b3abae2a 879 $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
58cde26e
JH
880 }
881
882sub bacmp
883 {
884 # Compares 2 values, ignoring their signs.
885 # Returns one of undef, <0, =0, >0. (suitable for sort)
886 # (BINT, BINT) return cond_code
887 my ($self,$x,$y) = objectify(2,@_);
574bacfe
JH
888
889 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
890 {
891 # handle +-inf and NaN
892 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
893 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
894 return +1; # inf is always bigger
895 }
b3abae2a 896 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
58cde26e
JH
897 }
898
899sub badd
900 {
901 # add second arg (BINT or string) to first (BINT) (modifies first)
902 # return result as BINT
61f5c3f5 903 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
904
905 return $x if $x->modify('badd');
b3abae2a
JH
906# print "mbi badd ",join(' ',caller()),"\n";
907# print "upgrade => ",$upgrade||'undef',
908# " \$x (",ref($x),") \$y (",ref($y),")\n";
56b9c951
JH
909 return $upgrade->badd($x,$y,@r) if defined $upgrade &&
910 ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
b3abae2a 911# print "still badd\n";
58cde26e 912
61f5c3f5 913 $r[3] = $y; # no push!
574bacfe
JH
914 # inf and NaN handling
915 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
916 {
917 # NaN first
918 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
13a12e00
JH
919 # inf handling
920 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
574bacfe 921 {
b3abae2a
JH
922 # +inf++inf or -inf+-inf => same, rest is NaN
923 return $x if $x->{sign} eq $y->{sign};
924 return $x->bnan();
574bacfe
JH
925 }
926 # +-inf + something => +inf
927 # something +-inf => +-inf
928 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
929 return $x;
930 }
931
58cde26e
JH
932 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
933
934 if ($sx eq $sy)
935 {
574bacfe 936 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
58cde26e
JH
937 $x->{sign} = $sx;
938 }
939 else
940 {
574bacfe 941 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
58cde26e
JH
942 if ($a > 0)
943 {
944 #print "swapped sub (a=$a)\n";
574bacfe 945 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
58cde26e
JH
946 $x->{sign} = $sy;
947 }
948 elsif ($a == 0)
949 {
950 # speedup, if equal, set result to 0
0716bf9b
JH
951 #print "equal sub, result = 0\n";
952 $x->{value} = $CALC->_zero();
58cde26e
JH
953 $x->{sign} = '+';
954 }
955 else # a < 0
956 {
957 #print "unswapped sub (a=$a)\n";
574bacfe 958 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
58cde26e 959 $x->{sign} = $sx;
a0d0e21e 960 }
a0d0e21e 961 }
61f5c3f5 962 $x->round(@r);
58cde26e
JH
963 }
964
965sub bsub
966 {
967 # (BINT or num_str, BINT or num_str) return num_str
968 # subtract second arg from first, modify first
b3abae2a 969 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e 970
58cde26e 971 return $x if $x->modify('bsub');
b3abae2a
JH
972# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
973# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
974
975 if ($y->is_zero())
976 {
977 return $x->round(@r);
e745a66c 978 }
b3abae2a
JH
979
980 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
981 $x->badd($y,@r); # badd does not leave internal zeros
982 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
61f5c3f5 983 $x; # already rounded by badd() or no round necc.
58cde26e
JH
984 }
985
986sub binc
987 {
988 # increment arg by one
ee15d750 989 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 990 return $x if $x->modify('binc');
e745a66c
JH
991
992 if ($x->{sign} eq '+')
993 {
994 $x->{value} = $CALC->_inc($x->{value});
995 return $x->round($a,$p,$r);
996 }
997 elsif ($x->{sign} eq '-')
998 {
999 $x->{value} = $CALC->_dec($x->{value});
1000 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1001 return $x->round($a,$p,$r);
1002 }
1003 # inf, nan handling etc
61f5c3f5 1004 $x->badd($self->__one(),$a,$p,$r); # badd does round
58cde26e
JH
1005 }
1006
1007sub bdec
1008 {
1009 # decrement arg by one
ee15d750 1010 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1011 return $x if $x->modify('bdec');
e745a66c
JH
1012
1013 my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
1014 # <= 0
1015 if (($x->{sign} eq '-') || $zero)
1016 {
1017 $x->{value} = $CALC->_inc($x->{value});
1018 $x->{sign} = '-' if $zero; # 0 => 1 => -1
1019 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1020 return $x->round($a,$p,$r);
1021 }
1022 # > 0
1023 elsif ($x->{sign} eq '+')
1024 {
1025 $x->{value} = $CALC->_dec($x->{value});
1026 return $x->round($a,$p,$r);
1027 }
1028 # inf, nan handling etc
61f5c3f5 1029 $x->badd($self->__one('-'),$a,$p,$r); # badd does round
58cde26e
JH
1030 }
1031
61f5c3f5
T
1032sub blog
1033 {
1034 # not implemented yet
b3abae2a 1035 my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
61f5c3f5 1036
b3abae2a
JH
1037 return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
1038
61f5c3f5
T
1039 return $x->bnan();
1040 }
1041
58cde26e
JH
1042sub blcm
1043 {
1044 # (BINT or num_str, BINT or num_str) return BINT
1045 # does not modify arguments, but returns new object
1046 # Lowest Common Multiplicator
58cde26e 1047
0716bf9b
JH
1048 my $y = shift; my ($x);
1049 if (ref($y))
1050 {
1051 $x = $y->copy();
1052 }
1053 else
1054 {
1055 $x = $class->new($y);
1056 }
dccbb853 1057 while (@_) { $x = __lcm($x,shift); }
58cde26e
JH
1058 $x;
1059 }
1060
1061sub bgcd
1062 {
1063 # (BINT or num_str, BINT or num_str) return BINT
1064 # does not modify arguments, but returns new object
1065 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
0716bf9b 1066
dccbb853
JH
1067 my $y = shift;
1068 $y = __PACKAGE__->new($y) if !ref($y);
1069 my $self = ref($y);
1070 my $x = $y->copy(); # keep arguments
0716bf9b
JH
1071 if ($CALC->can('_gcd'))
1072 {
1073 while (@_)
1074 {
dccbb853 1075 $y = shift; $y = $self->new($y) if !ref($y);
0716bf9b
JH
1076 next if $y->is_zero();
1077 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
1078 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
1079 }
1080 }
1081 else
1082 {
1083 while (@_)
1084 {
dccbb853
JH
1085 $y = shift; $y = $self->new($y) if !ref($y);
1086 $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
0716bf9b
JH
1087 }
1088 }
1089 $x->babs();
58cde26e
JH
1090 }
1091
58cde26e
JH
1092sub bnot
1093 {
1094 # (num_str or BINT) return BINT
1095 # represent ~x as twos-complement number
ee15d750
JH
1096 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1097 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1098
58cde26e 1099 return $x if $x->modify('bnot');
61f5c3f5 1100 $x->bneg()->bdec(); # bdec already does round
58cde26e
JH
1101 }
1102
b3abae2a
JH
1103# is_foo test routines
1104
58cde26e
JH
1105sub is_zero
1106 {
1107 # return true if arg (BINT or num_str) is zero (array '+', '0')
ee15d750
JH
1108 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1109 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1110
574bacfe 1111 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
17baacb7 1112 $CALC->_is_zero($x->{value});
58cde26e
JH
1113 }
1114
1115sub is_nan
1116 {
1117 # return true if arg (BINT or num_str) is NaN
ee15d750
JH
1118 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1119
1120 return 1 if $x->{sign} eq $nan;
28df3e88 1121 0;
58cde26e
JH
1122 }
1123
1124sub is_inf
1125 {
1126 # return true if arg (BINT or num_str) is +-inf
ee15d750
JH
1127 my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1128
1129 $sign = '' if !defined $sign;
9393ace2 1130 return 1 if $sign eq $x->{sign}; # match ("+inf" eq "+inf")
ee15d750 1131 return 0 if $sign !~ /^([+-]|)$/;
58cde26e 1132
ee15d750
JH
1133 if ($sign eq '')
1134 {
1135 return 1 if ($x->{sign} =~ /^[+-]inf$/);
1136 return 0;
1137 }
1138 $sign = quotemeta($sign.'inf');
1139 return 1 if ($x->{sign} =~ /^$sign$/);
28df3e88 1140 0;
58cde26e
JH
1141 }
1142
1143sub is_one
1144 {
b22b3e31
PN
1145 # return true if arg (BINT or num_str) is +1
1146 # or -1 if sign is given
ee15d750
JH
1147 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1148 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1149
1150 $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
0716bf9b 1151
ee15d750 1152 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
394e6ffb 1153 $CALC->_is_one($x->{value});
58cde26e
JH
1154 }
1155
1156sub is_odd
1157 {
1158 # return true when arg (BINT or num_str) is odd, false for even
ee15d750
JH
1159 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1160 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1161
b22b3e31 1162 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1163 $CALC->_is_odd($x->{value});
58cde26e
JH
1164 }
1165
1166sub is_even
1167 {
1168 # return true when arg (BINT or num_str) is even, false for odd
ee15d750
JH
1169 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1170 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1171
b22b3e31 1172 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1173 $CALC->_is_even($x->{value});
0716bf9b
JH
1174 }
1175
1176sub is_positive
1177 {
1178 # return true when arg (BINT or num_str) is positive (>= 0)
ee15d750
JH
1179 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1180 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1181
1182 return 1 if $x->{sign} =~ /^\+/;
394e6ffb 1183 0;
0716bf9b
JH
1184 }
1185
1186sub is_negative
1187 {
1188 # return true when arg (BINT or num_str) is negative (< 0)
ee15d750
JH
1189 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1190 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1191
1192 return 1 if ($x->{sign} =~ /^-/);
394e6ffb 1193 0;
58cde26e
JH
1194 }
1195
b3abae2a
JH
1196sub is_int
1197 {
1198 # return true when arg (BINT or num_str) is an integer
1199 # always true for BigInt, but different for Floats
1200 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1201 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1202
1203 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1204 }
1205
0716bf9b
JH
1206###############################################################################
1207
58cde26e
JH
1208sub bmul
1209 {
1210 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
1211 # (BINT or num_str, BINT or num_str) return BINT
61f5c3f5 1212 my ($self,$x,$y,@r) = objectify(2,@_);
0716bf9b 1213
58cde26e 1214 return $x if $x->modify('bmul');
61f5c3f5 1215
574bacfe 1216 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
b3abae2a 1217
574bacfe
JH
1218 # inf handling
1219 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1220 {
b3abae2a 1221 return $x->bnan() if $x->is_zero() || $y->is_zero();
574bacfe
JH
1222 # result will always be +-inf:
1223 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1224 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1225 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1226 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1227 return $x->binf('-');
1228 }
9393ace2
JH
1229
1230 return $upgrade->bmul($x,$y,@r)
1231 if defined $upgrade && $y->isa($upgrade);
1232
1233 $r[3] = $y; # no push here
58cde26e 1234
0716bf9b 1235 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
dccbb853 1236
b3abae2a
JH
1237 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1238 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1239 $x->round(@r);
dccbb853
JH
1240 }
1241
1242sub _div_inf
1243 {
1244 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1245 my ($self,$x,$y) = @_;
1246
1247 # NaN if x == NaN or y == NaN or x==y==0
1248 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1249 if (($x->is_nan() || $y->is_nan()) ||
1250 ($x->is_zero() && $y->is_zero()));
1251
b3abae2a
JH
1252 # +-inf / +-inf == NaN, reminder also NaN
1253 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
dccbb853 1254 {
b3abae2a 1255 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
dccbb853
JH
1256 }
1257 # x / +-inf => 0, remainder x (works even if x == 0)
1258 if ($y->{sign} =~ /^[+-]inf$/)
1259 {
1260 my $t = $x->copy(); # binf clobbers up $x
1261 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1262 }
1263
1264 # 5 / 0 => +inf, -6 / 0 => -inf
1265 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1266 # exception: -8 / 0 has remainder -8, not 8
1267 # exception: -inf / 0 has remainder -inf, not inf
1268 if ($y->is_zero())
1269 {
1270 # +-inf / 0 => special case for -inf
1271 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1272 if (!$x->is_zero() && !$x->is_inf())
1273 {
1274 my $t = $x->copy(); # binf clobbers up $x
1275 return wantarray ?
1276 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1277 }
1278 }
1279
1280 # last case: +-inf / ordinary number
1281 my $sign = '+inf';
1282 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1283 $x->{sign} = $sign;
1284 return wantarray ? ($x,$self->bzero()) : $x;
58cde26e
JH
1285 }
1286
1287sub bdiv
1288 {
1289 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1290 # (BINT,BINT) (quo,rem) or BINT (only rem)
61f5c3f5 1291 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
1292
1293 return $x if $x->modify('bdiv');
1294
dccbb853
JH
1295 return $self->_div_inf($x,$y)
1296 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
58cde26e 1297
9393ace2
JH
1298 return $upgrade->bdiv($upgrade->new($x),$y,@r)
1299 if defined $upgrade && $y->isa($upgrade);
1300
61f5c3f5
T
1301 $r[3] = $y; # no push!
1302
58cde26e 1303 # 0 / something
61f5c3f5
T
1304 return
1305 wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
58cde26e 1306
b3abae2a 1307 # Is $x in the interval [0, $y) (aka $x <= $y) ?
0716bf9b 1308 my $cmp = $CALC->_acmp($x->{value},$y->{value});
b3abae2a 1309 if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
58cde26e 1310 {
9393ace2
JH
1311 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1312 if defined $upgrade;
b3abae2a 1313
61f5c3f5 1314 return $x->bzero()->round(@r) unless wantarray;
58cde26e 1315 my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
61f5c3f5 1316 return ($x->bzero()->round(@r),$t);
58cde26e
JH
1317 }
1318 elsif ($cmp == 0)
1319 {
1320 # shortcut, both are the same, so set to +/- 1
574bacfe 1321 $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
58cde26e 1322 return $x unless wantarray;
61f5c3f5 1323 return ($x->round(@r),$self->bzero(@r));
58cde26e 1324 }
9393ace2
JH
1325 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1326 if defined $upgrade;
58cde26e
JH
1327
1328 # calc new sign and in case $y == +/- 1, return $x
dccbb853 1329 my $xsign = $x->{sign}; # keep
58cde26e
JH
1330 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1331 # check for / +-1 (cant use $y->is_one due to '-'
394e6ffb 1332 if ($CALC->_is_one($y->{value}))
58cde26e 1333 {
61f5c3f5 1334 return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
58cde26e
JH
1335 }
1336
58cde26e
JH
1337 if (wantarray)
1338 {
394e6ffb
JH
1339 my $rem = $self->bzero();
1340 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1341 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
61f5c3f5 1342 $x->round(@r);
dccbb853
JH
1343 if (! $CALC->_is_zero($rem->{value}))
1344 {
1345 $rem->{sign} = $y->{sign};
1346 $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
1347 }
1348 else
1349 {
1350 $rem->{sign} = '+'; # dont leave -0
1351 }
61f5c3f5 1352 $rem->round(@r);
58cde26e
JH
1353 return ($x,$rem);
1354 }
394e6ffb
JH
1355
1356 $x->{value} = $CALC->_div($x->{value},$y->{value});
1357 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
61f5c3f5 1358 $x->round(@r);
58cde26e
JH
1359 }
1360
dccbb853
JH
1361sub bmod
1362 {
1363 # modulus (or remainder)
1364 # (BINT or num_str, BINT or num_str) return BINT
61f5c3f5 1365 my ($self,$x,$y,@r) = objectify(2,@_);
28df3e88 1366
dccbb853 1367 return $x if $x->modify('bmod');
61f5c3f5 1368 $r[3] = $y; # no push!
dccbb853
JH
1369 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1370 {
1371 my ($d,$r) = $self->_div_inf($x,$y);
61f5c3f5 1372 return $r->round(@r);
dccbb853
JH
1373 }
1374
1375 if ($CALC->can('_mod'))
1376 {
1377 # calc new sign and in case $y == +/- 1, return $x
1378 $x->{value} = $CALC->_mod($x->{value},$y->{value});
dccbb853
JH
1379 if (!$CALC->_is_zero($x->{value}))
1380 {
b3abae2a 1381 my $xsign = $x->{sign};
dccbb853
JH
1382 $x->{sign} = $y->{sign};
1383 $x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
1384 }
1385 else
1386 {
1387 $x->{sign} = '+'; # dont leave -0
1388 }
61f5c3f5 1389 return $x->round(@r);
dccbb853 1390 }
b3abae2a
JH
1391 my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
1392 # modify in place
1393 foreach (qw/value sign _a _p/)
1394 {
1395 $x->{$_} = $rem->{$_};
1396 }
1397 $x;
dccbb853
JH
1398 }
1399
b3abae2a
JH
1400sub bfac
1401 {
1402 # (BINT or num_str, BINT or num_str) return BINT
1403 # compute factorial numbers
1404 # modifies first argument
1405 my ($self,$x,@r) = objectify(1,@_);
1406
1407 return $x if $x->modify('bfac');
1408
1409 return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
1410 return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
1411
1412 if ($CALC->can('_fac'))
1413 {
1414 $x->{value} = $CALC->_fac($x->{value});
1415 return $x->round(@r);
1416 }
1417
1418 my $n = $x->copy();
1419 $x->bone();
1420 my $f = $self->new(2);
1421 while ($f->bacmp($n) < 0)
1422 {
1423 $x->bmul($f); $f->binc();
1424 }
1425 $x->bmul($f); # last step
1426 $x->round(@r); # round
1427 }
1428
58cde26e
JH
1429sub bpow
1430 {
1431 # (BINT or num_str, BINT or num_str) return BINT
1432 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1433 # modifies first argument
61f5c3f5 1434 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
1435
1436 return $x if $x->modify('bpow');
9393ace2
JH
1437
1438 return $upgrade->bpow($upgrade->new($x),$y,@r)
1439 if defined $upgrade && $y->isa($upgrade);
1440
61f5c3f5 1441 $r[3] = $y; # no push!
0716bf9b 1442 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
58cde26e 1443 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
61f5c3f5
T
1444 return $x->bone(@r) if $y->is_zero();
1445 return $x->round(@r) if $x->is_one() || $y->is_one();
0716bf9b 1446 if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
58cde26e
JH
1447 {
1448 # if $x == -1 and odd/even y => +1/-1
61f5c3f5 1449 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
574bacfe 1450 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
58cde26e 1451 }
574bacfe
JH
1452 # 1 ** -y => 1 / (1 ** |y|)
1453 # so do test for negative $y after above's clause
58cde26e 1454 return $x->bnan() if $y->{sign} eq '-';
61f5c3f5 1455 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
58cde26e 1456
0716bf9b 1457 if ($CALC->can('_pow'))
58cde26e 1458 {
574bacfe 1459 $x->{value} = $CALC->_pow($x->{value},$y->{value});
61f5c3f5 1460 return $x->round(@r);
58cde26e 1461 }
027dc388
JH
1462
1463# based on the assumption that shifting in base 10 is fast, and that mul
1464# works faster if numbers are small: we count trailing zeros (this step is
1465# O(1)..O(N), but in case of O(N) we save much more time due to this),
1466# stripping them out of the multiplication, and add $count * $y zeros
1467# afterwards like this:
1468# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1469# creates deep recursion?
574bacfe
JH
1470# my $zeros = $x->_trailing_zeros();
1471# if ($zeros > 0)
1472# {
1473# $x->brsft($zeros,10); # remove zeros
1474# $x->bpow($y); # recursion (will not branch into here again)
1475# $zeros = $y * $zeros; # real number of zeros to add
1476# $x->blsft($zeros,10);
1477# return $x->round($a,$p,$r);
1478# }
1479
1480 my $pow2 = $self->__one();
58cde26e 1481 my $y1 = $class->new($y);
dccbb853 1482 my $two = $self->new(2);
58cde26e
JH
1483 while (!$y1->is_one())
1484 {
dccbb853
JH
1485 $pow2->bmul($x) if $y1->is_odd();
1486 $y1->bdiv($two);
027dc388 1487 $x->bmul($x);
58cde26e 1488 }
dccbb853 1489 $x->bmul($pow2) unless $pow2->is_one();
56b9c951 1490 $x->round(@r);
58cde26e
JH
1491 }
1492
1493sub blsft
1494 {
1495 # (BINT or num_str, BINT or num_str) return BINT
1496 # compute x << y, base n, y >= 0
b3abae2a 1497 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1498
1499 return $x if $x->modify('blsft');
1500 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
b3abae2a 1501 return $x->round($a,$p,$r) if $y->is_zero();
58cde26e 1502
574bacfe
JH
1503 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1504
027dc388 1505 my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
574bacfe
JH
1506 if (defined $t)
1507 {
b3abae2a 1508 $x->{value} = $t; return $x->round($a,$p,$r);
574bacfe
JH
1509 }
1510 # fallback
b3abae2a 1511 return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
58cde26e
JH
1512 }
1513
1514sub brsft
1515 {
1516 # (BINT or num_str, BINT or num_str) return BINT
1517 # compute x >> y, base n, y >= 0
b3abae2a 1518 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1519
1520 return $x if $x->modify('brsft');
1521 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
b3abae2a
JH
1522 return $x->round($a,$p,$r) if $y->is_zero();
1523 return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
58cde26e
JH
1524
1525 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
574bacfe 1526
b3abae2a
JH
1527 # this only works for negative numbers when shifting in base 2
1528 if (($x->{sign} eq '-') && ($n == 2))
1529 {
1530 return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
1531 if (!$y->is_one())
1532 {
1533 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1534 # but perhaps there is a better emulation for two's complement shift...
1535 # if $y != 1, we must simulate it by doing:
1536 # convert to bin, flip all bits, shift, and be done
1537 $x->binc(); # -3 => -2
1538 my $bin = $x->as_bin();
1539 $bin =~ s/^-0b//; # strip '-0b' prefix
1540 $bin =~ tr/10/01/; # flip bits
1541 # now shift
1542 if (length($bin) <= $y)
1543 {
1544 $bin = '0'; # shifting to far right creates -1
1545 # 0, because later increment makes
1546 # that 1, attached '-' makes it '-1'
1547 # because -1 >> x == -1 !
1548 }
1549 else
1550 {
1551 $bin =~ s/.{$y}$//; # cut off at the right side
1552 $bin = '1' . $bin; # extend left side by one dummy '1'
1553 $bin =~ tr/10/01/; # flip bits back
1554 }
1555 my $res = $self->new('0b'.$bin); # add prefix and convert back
1556 $res->binc(); # remember to increment
1557 $x->{value} = $res->{value}; # take over value
1558 return $x->round($a,$p,$r); # we are done now, magic, isn't?
1559 }
1560 $x->bdec(); # n == 2, but $y == 1: this fixes it
1561 }
1562
027dc388 1563 my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
574bacfe
JH
1564 if (defined $t)
1565 {
b3abae2a
JH
1566 $x->{value} = $t;
1567 return $x->round($a,$p,$r);
574bacfe
JH
1568 }
1569 # fallback
b3abae2a
JH
1570 $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
1571 $x;
58cde26e
JH
1572 }
1573
1574sub band
1575 {
1576 #(BINT or num_str, BINT or num_str) return BINT
1577 # compute x & y
0716bf9b 1578 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1579
1580 return $x if $x->modify('band');
1581
b3abae2a
JH
1582 local $Math::BigInt::upgrade = undef;
1583
58cde26e 1584 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
394e6ffb 1585 return $x->bzero() if $y->is_zero() || $x->is_zero();
0716bf9b 1586
574bacfe
JH
1587 my $sign = 0; # sign of result
1588 $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1589 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1590 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1591
1592 if ($CALC->can('_and') && $sx == 1 && $sy == 1)
0716bf9b 1593 {
574bacfe 1594 $x->{value} = $CALC->_and($x->{value},$y->{value});
0716bf9b
JH
1595 return $x->round($a,$p,$r);
1596 }
574bacfe 1597
b3abae2a
JH
1598 my $m = $self->bone(); my ($xr,$yr);
1599 my $x10000 = $self->new (0x1000);
574bacfe
JH
1600 my $y1 = copy(ref($x),$y); # make copy
1601 $y1->babs(); # and positive
1602 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1603 use integer; # need this for negative bools
0716bf9b 1604 while (!$x1->is_zero() && !$y1->is_zero())
58cde26e 1605 {
0716bf9b 1606 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1607 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe
JH
1608 # make both op's numbers!
1609 $x->badd( bmul( $class->new(
1610 abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1611 $m));
58cde26e
JH
1612 $m->bmul($x10000);
1613 }
574bacfe 1614 $x->bneg() if $sign;
0716bf9b 1615 return $x->round($a,$p,$r);
58cde26e
JH
1616 }
1617
1618sub bior
1619 {
1620 #(BINT or num_str, BINT or num_str) return BINT
1621 # compute x | y
0716bf9b 1622 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1623
1624 return $x if $x->modify('bior');
1625
b3abae2a
JH
1626 local $Math::BigInt::upgrade = undef;
1627
58cde26e
JH
1628 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1629 return $x if $y->is_zero();
574bacfe
JH
1630
1631 my $sign = 0; # sign of result
1632 $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1633 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1634 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1635
1636 # don't use lib for negative values
1637 if ($CALC->can('_or') && $sx == 1 && $sy == 1)
0716bf9b 1638 {
574bacfe 1639 $x->{value} = $CALC->_or($x->{value},$y->{value});
0716bf9b
JH
1640 return $x->round($a,$p,$r);
1641 }
1642
b3abae2a
JH
1643 my $m = $self->bone(); my ($xr,$yr);
1644 my $x10000 = $self->new(0x10000);
574bacfe
JH
1645 my $y1 = copy(ref($x),$y); # make copy
1646 $y1->babs(); # and positive
1647 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1648 use integer; # need this for negative bools
0716bf9b 1649 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1650 {
0716bf9b 1651 ($x1, $xr) = bdiv($x1,$x10000);
58cde26e 1652 ($y1, $yr) = bdiv($y1,$x10000);
574bacfe
JH
1653 # make both op's numbers!
1654 $x->badd( bmul( $class->new(
1655 abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1656 $m));
58cde26e
JH
1657 $m->bmul($x10000);
1658 }
574bacfe 1659 $x->bneg() if $sign;
0716bf9b 1660 return $x->round($a,$p,$r);
58cde26e
JH
1661 }
1662
1663sub bxor
1664 {
1665 #(BINT or num_str, BINT or num_str) return BINT
1666 # compute x ^ y
0716bf9b 1667 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1668
1669 return $x if $x->modify('bxor');
1670
b3abae2a
JH
1671 local $Math::BigInt::upgrade = undef;
1672
0716bf9b 1673 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
58cde26e 1674 return $x if $y->is_zero();
0716bf9b 1675
574bacfe
JH
1676 my $sign = 0; # sign of result
1677 $sign = 1 if $x->{sign} ne $y->{sign};
1678 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1679 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1680
1681 # don't use lib for negative values
1682 if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
0716bf9b 1683 {
574bacfe 1684 $x->{value} = $CALC->_xor($x->{value},$y->{value});
0716bf9b
JH
1685 return $x->round($a,$p,$r);
1686 }
1687
394e6ffb 1688 my $m = $self->bone(); my ($xr,$yr);
b3abae2a 1689 my $x10000 = $self->new(0x10000);
58cde26e 1690 my $y1 = copy(ref($x),$y); # make copy
574bacfe
JH
1691 $y1->babs(); # and positive
1692 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1693 use integer; # need this for negative bools
0716bf9b 1694 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1695 {
0716bf9b 1696 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1697 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe
JH
1698 # make both op's numbers!
1699 $x->badd( bmul( $class->new(
1700 abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1701 $m));
58cde26e
JH
1702 $m->bmul($x10000);
1703 }
574bacfe 1704 $x->bneg() if $sign;
0716bf9b 1705 return $x->round($a,$p,$r);
58cde26e
JH
1706 }
1707
1708sub length
1709 {
ee15d750 1710 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1711
0716bf9b 1712 my $e = $CALC->_len($x->{value});
0716bf9b 1713 return wantarray ? ($e,0) : $e;
58cde26e
JH
1714 }
1715
1716sub digit
1717 {
0716bf9b 1718 # return the nth decimal digit, negative values count backward, 0 is right
56b9c951
JH
1719 my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1720 $n = 0 if !defined $n;
58cde26e 1721
56b9c951 1722 $CALC->_digit($x->{value},$n);
58cde26e
JH
1723 }
1724
1725sub _trailing_zeros
1726 {
1727 # return the amount of trailing zeros in $x
1728 my $x = shift;
1729 $x = $class->new($x) unless ref $x;
1730
dccbb853 1731 return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
0716bf9b
JH
1732
1733 return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1734
b22b3e31 1735 # if not: since we do not know underlying internal representation:
0716bf9b 1736 my $es = "$x"; $es =~ /([0]*)$/;
0716bf9b
JH
1737 return 0 if !defined $1; # no zeros
1738 return CORE::length("$1"); # as string, not as +0!
58cde26e
JH
1739 }
1740
1741sub bsqrt
1742 {
394e6ffb 1743 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1744
b3abae2a
JH
1745 return $x if $x->modify('bsqrt');
1746
394e6ffb
JH
1747 return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
1748 return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
1749 return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
b3abae2a
JH
1750
1751 return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
58cde26e 1752
394e6ffb
JH
1753 if ($CALC->can('_sqrt'))
1754 {
1755 $x->{value} = $CALC->_sqrt($x->{value});
1756 return $x->round($a,$p,$r);
1757 }
1758
b3abae2a 1759 return $x->bone($a,$p) if $x < 4; # 2,3 => 1
394e6ffb 1760 my $y = $x->copy();
58cde26e
JH
1761 my $l = int($x->length()/2);
1762
394e6ffb
JH
1763 $x->bone(); # keep ref($x), but modify it
1764 $x->blsft($l,10);
58cde26e
JH
1765
1766 my $last = $self->bzero();
394e6ffb
JH
1767 my $two = $self->new(2);
1768 my $lastlast = $x+$two;
1769 while ($last != $x && $lastlast != $x)
58cde26e 1770 {
394e6ffb 1771 $lastlast = $last; $last = $x;
58cde26e 1772 $x += $y / $x;
394e6ffb 1773 $x /= $two;
58cde26e 1774 }
394e6ffb 1775 $x-- if $x * $x > $y; # overshot?
b3abae2a 1776 $x->round($a,$p,$r);
58cde26e
JH
1777 }
1778
1779sub exponent
1780 {
1781 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
ee15d750 1782 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1783
ee15d750
JH
1784 if ($x->{sign} !~ /^[+-]$/)
1785 {
1786 my $s = $x->{sign}; $s =~ s/^[+-]//;
1787 return $self->new($s); # -inf,+inf => inf
1788 }
58cde26e
JH
1789 my $e = $class->bzero();
1790 return $e->binc() if $x->is_zero();
1791 $e += $x->_trailing_zeros();
56b9c951 1792 $e;
58cde26e
JH
1793 }
1794
1795sub mantissa
1796 {
ee15d750
JH
1797 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
1798 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1799
ee15d750
JH
1800 if ($x->{sign} !~ /^[+-]$/)
1801 {
28df3e88 1802 return $self->new($x->{sign}); # keep + or - sign
ee15d750 1803 }
58cde26e
JH
1804 my $m = $x->copy();
1805 # that's inefficient
1806 my $zeros = $m->_trailing_zeros();
56b9c951
JH
1807 $m->brsft($zeros,10) if $zeros != 0;
1808# $m /= 10 ** $zeros if $zeros != 0;
1809 $m;
58cde26e
JH
1810 }
1811
1812sub parts
1813 {
ee15d750
JH
1814 # return a copy of both the exponent and the mantissa
1815 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1816
ee15d750 1817 return ($x->mantissa(),$x->exponent());
58cde26e
JH
1818 }
1819
1820##############################################################################
1821# rounding functions
1822
1823sub bfround
1824 {
1825 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
ee15d750 1826 # $n == 0 || $n == 1 => round to integer
58cde26e 1827 my $x = shift; $x = $class->new($x) unless ref $x;
dccbb853 1828 my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
58cde26e 1829 return $x if !defined $scale; # no-op
b3abae2a 1830 return $x if $x->modify('bfround');
58cde26e
JH
1831
1832 # no-op for BigInts if $n <= 0
ee15d750
JH
1833 if ($scale <= 0)
1834 {
61f5c3f5 1835 $x->{_a} = undef; # clear an eventual set A
ee15d750
JH
1836 $x->{_p} = $scale; return $x;
1837 }
58cde26e
JH
1838
1839 $x->bround( $x->length()-$scale, $mode);
ee15d750
JH
1840 $x->{_a} = undef; # bround sets {_a}
1841 $x->{_p} = $scale; # so correct it
1842 $x;
58cde26e
JH
1843 }
1844
1845sub _scan_for_nonzero
1846 {
1847 my $x = shift;
1848 my $pad = shift;
0716bf9b 1849 my $xs = shift;
58cde26e
JH
1850
1851 my $len = $x->length();
1852 return 0 if $len == 1; # '5' is trailed by invisible zeros
1853 my $follow = $pad - 1;
1854 return 0 if $follow > $len || $follow < 1;
0716bf9b 1855
b22b3e31 1856 # since we do not know underlying represention of $x, use decimal string
0716bf9b 1857 #my $r = substr ($$xs,-$follow);
58cde26e
JH
1858 my $r = substr ("$x",-$follow);
1859 return 1 if $r =~ /[^0]/; return 0;
58cde26e
JH
1860 }
1861
1862sub fround
1863 {
1864 # to make life easier for switch between MBF and MBI (autoload fxxx()
1865 # like MBF does for bxxx()?)
1866 my $x = shift;
1867 return $x->bround(@_);
1868 }
1869
1870sub bround
1871 {
1872 # accuracy: +$n preserve $n digits from left,
1873 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1874 # no-op for $n == 0
1875 # and overwrite the rest with 0's, return normalized number
1876 # do not return $x->bnorm(), but $x
61f5c3f5 1877
58cde26e 1878 my $x = shift; $x = $class->new($x) unless ref $x;
dccbb853 1879 my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
61f5c3f5 1880 return $x if !defined $scale; # no-op
b3abae2a 1881 return $x if $x->modify('bround');
58cde26e 1882
61f5c3f5
T
1883 if ($x->is_zero() || $scale == 0)
1884 {
1885 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
1886 return $x;
1887 }
1888 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
58cde26e
JH
1889
1890 # we have fewer digits than we want to scale to
1891 my $len = $x->length();
ee15d750
JH
1892 # scale < 0, but > -len (not >=!)
1893 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
1894 {
61f5c3f5 1895 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
ee15d750
JH
1896 return $x;
1897 }
58cde26e
JH
1898
1899 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1900 my ($pad,$digit_round,$digit_after);
1901 $pad = $len - $scale;
ee15d750
JH
1902 $pad = abs($scale-1) if $scale < 0;
1903
0716bf9b 1904 # do not use digit(), it is costly for binary => decimal
ee15d750 1905
0716bf9b
JH
1906 my $xs = $CALC->_str($x->{value});
1907 my $pl = -$pad-1;
ee15d750 1908
0716bf9b
JH
1909 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1910 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
1911 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1912 $pl++; $pl ++ if $pad >= $len;
61f5c3f5 1913 $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
ee15d750
JH
1914
1915 # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
58cde26e
JH
1916
1917 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1918 # closer at the remaining digits of the original $x, remember decision
1919 my $round_up = 1; # default round up
1920 $round_up -- if
1921 ($mode eq 'trunc') || # trunc by round down
1922 ($digit_after =~ /[01234]/) || # round down anyway,
1923 # 6789 => round up
1924 ($digit_after eq '5') && # not 5000...0000
0716bf9b 1925 ($x->_scan_for_nonzero($pad,$xs) == 0) &&
58cde26e
JH
1926 (
1927 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1928 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
1929 ($mode eq '+inf') && ($x->{sign} eq '-') ||
1930 ($mode eq '-inf') && ($x->{sign} eq '+') ||
1931 ($mode eq 'zero') # round down if zero, sign adjusted below
1932 );
61f5c3f5
T
1933 my $put_back = 0; # not yet modified
1934
1935 # old code, depend on internal representation
1936 # split mantissa at $pad and then pad with zeros
1937 #my $s5 = int($pad / 5);
1938 #my $i = 0;
1939 #while ($i < $s5)
1940 # {
1941 # $x->{value}->[$i++] = 0; # replace with 5 x 0
1942 # }
1943 #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
1944 #my $rem = $pad % 5; # so much left over
1945 #if ($rem > 0)
1946 # {
1947 # #print "remainder $rem\n";
1948 ## #print "elem $x->{value}->[$s5]\n";
1949 # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
1950 # }
1951 #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
1952 #print ${$CALC->_str($pad->{value})}," $len\n";
1953
1954 if (($pad > 0) && ($pad <= $len))
1955 {
1956 substr($$xs,-$pad,$pad) = '0' x $pad;
1957 $put_back = 1;
58cde26e 1958 }
61f5c3f5
T
1959 elsif ($pad > $len)
1960 {
1961 $x->bzero(); # round to '0'
1962 }
1963
58cde26e
JH
1964 if ($round_up) # what gave test above?
1965 {
61f5c3f5
T
1966 $put_back = 1;
1967 $pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
1968
1969 # we modify directly the string variant instead of creating a number and
1970 # adding it
1971 my $c = 0; $pad ++; # for $pad == $len case
1972 while ($pad <= $len)
1973 {
1974 $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
1975 substr($$xs,-$pad,1) = $c; $pad++;
1976 last if $c != 0; # no overflow => early out
1977 }
1978 $$xs = '1'.$$xs if $c == 0;
1979
1980 # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
58cde26e 1981 }
61f5c3f5 1982 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
ee15d750
JH
1983
1984 $x->{_a} = $scale if $scale >= 0;
1985 if ($scale < 0)
1986 {
1987 $x->{_a} = $len+$scale;
1988 $x->{_a} = 0 if $scale < -$len;
1989 }
58cde26e
JH
1990 $x;
1991 }
1992
1993sub bfloor
1994 {
1995 # return integer less or equal then number, since it is already integer,
1996 # always returns $self
ee15d750 1997 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e
JH
1998
1999 # not needed: return $x if $x->modify('bfloor');
58cde26e
JH
2000 return $x->round($a,$p,$r);
2001 }
2002
2003sub bceil
2004 {
2005 # return integer greater or equal then number, since it is already integer,
2006 # always returns $self
ee15d750 2007 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e
JH
2008
2009 # not needed: return $x if $x->modify('bceil');
58cde26e
JH
2010 return $x->round($a,$p,$r);
2011 }
2012
2013##############################################################################
2014# private stuff (internal use only)
2015
574bacfe 2016sub __one
58cde26e
JH
2017 {
2018 # internal speedup, set argument to 1, or create a +/- 1
2019 my $self = shift;
dccbb853 2020 my $x = $self->bone(); # $x->{value} = $CALC->_one();
0716bf9b
JH
2021 $x->{sign} = shift || '+';
2022 return $x;
58cde26e
JH
2023 }
2024
2025sub _swap
2026 {
2027 # Overload will swap params if first one is no object ref so that the first
2028 # one is always an object ref. In this case, third param is true.
2029 # This routine is to overcome the effect of scalar,$object creating an object
2030 # of the class of this package, instead of the second param $object. This
2031 # happens inside overload, when the overload section of this package is
2032 # inherited by sub classes.
2033 # For overload cases (and this is used only there), we need to preserve the
2034 # args, hence the copy().
2035 # You can override this method in a subclass, the overload section will call
2036 # $object->_swap() to make sure it arrives at the proper subclass, with some
394e6ffb
JH
2037 # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
2038 # specify your own overload for them.
58cde26e
JH
2039
2040 # object, (object|scalar) => preserve first and make copy
2041 # scalar, object => swapped, re-swap and create new from first
2042 # (using class of second object, not $class!!)
2043 my $self = shift; # for override in subclass
58cde26e
JH
2044 if ($_[2])
2045 {
2046 my $c = ref ($_[0]) || $class; # fallback $class should not happen
2047 return ( $c->new($_[1]), $_[0] );
2048 }
17baacb7 2049 return ( $_[0]->copy(), $_[1] );
58cde26e
JH
2050 }
2051
2052sub objectify
2053 {
2054 # check for strings, if yes, return objects instead
2055
2056 # the first argument is number of args objectify() should look at it will
2057 # return $count+1 elements, the first will be a classname. This is because
2058 # overloaded '""' calls bstr($object,undef,undef) and this would result in
2059 # useless objects beeing created and thrown away. So we cannot simple loop
2060 # over @_. If the given count is 0, all arguments will be used.
2061
2062 # If the second arg is a ref, use it as class.
2063 # If not, try to use it as classname, unless undef, then use $class
2064 # (aka Math::BigInt). The latter shouldn't happen,though.
2065
2066 # caller: gives us:
2067 # $x->badd(1); => ref x, scalar y
2068 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2069 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2070 # Math::BigInt::badd(1,2); => scalar x, scalar y
2071 # In the last case we check number of arguments to turn it silently into
574bacfe 2072 # $class,1,2. (We can not take '1' as class ;o)
58cde26e
JH
2073 # badd($class,1) is not supported (it should, eventually, try to add undef)
2074 # currently it tries 'Math::BigInt' + 1, which will not work.
ee15d750
JH
2075
2076 # some shortcut for the common cases
2077
2078 # $x->unary_op();
2079 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
ee15d750 2080
58cde26e
JH
2081 my $count = abs(shift || 0);
2082
9393ace2 2083 my (@a,$k,$d); # resulting array, temp, and downgrade
58cde26e
JH
2084 if (ref $_[0])
2085 {
2086 # okay, got object as first
2087 $a[0] = ref $_[0];
2088 }
2089 else
2090 {
2091 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2092 $a[0] = $class;
58cde26e
JH
2093 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2094 }
9393ace2
JH
2095 no strict 'refs';
2096 # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
2097 if (defined ${"$a[0]::downgrade"})
2098 {
2099 $d = ${"$a[0]::downgrade"};
2100 ${"$a[0]::downgrade"} = undef;
2101 }
2102
58cde26e 2103 # print "Now in objectify, my class is today $a[0]\n";
58cde26e
JH
2104 if ($count == 0)
2105 {
2106 while (@_)
2107 {
2108 $k = shift;
2109 if (!ref($k))
2110 {
2111 $k = $a[0]->new($k);
2112 }
2113 elsif (ref($k) ne $a[0])
2114 {
2115 # foreign object, try to convert to integer
2116 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2117 }
58cde26e
JH
2118 push @a,$k;
2119 }
2120 }
2121 else
2122 {
2123 while ($count > 0)
2124 {
58cde26e
JH
2125 $count--;
2126 $k = shift;
2127 if (!ref($k))
2128 {
2129 $k = $a[0]->new($k);
2130 }
2131 elsif (ref($k) ne $a[0])
2132 {
2133 # foreign object, try to convert to integer
2134 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2135 }
58cde26e
JH
2136 push @a,$k;
2137 }
2138 push @a,@_; # return other params, too
2139 }
58cde26e 2140 die "$class objectify needs list context" unless wantarray;
9393ace2 2141 ${"$a[0]::downgrade"} = $d;
58cde26e
JH
2142 @a;
2143 }
2144
2145sub import
2146 {
2147 my $self = shift;
61f5c3f5
T
2148
2149 $IMPORT++;
0716bf9b
JH
2150 my @a = @_; my $l = scalar @_; my $j = 0;
2151 for ( my $i = 0; $i < $l ; $i++,$j++ )
58cde26e 2152 {
0716bf9b 2153 if ($_[$i] eq ':constant')
58cde26e 2154 {
0716bf9b 2155 # this causes overlord er load to step in
58cde26e 2156 overload::constant integer => sub { $self->new(shift) };
56b9c951 2157 overload::constant binary => sub { $self->new(shift) };
0716bf9b
JH
2158 splice @a, $j, 1; $j --;
2159 }
b3abae2a
JH
2160 elsif ($_[$i] eq 'upgrade')
2161 {
2162 # this causes upgrading
2163 $upgrade = $_[$i+1]; # or undef to disable
2164 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
2165 splice @a, $j, $s; $j -= $s;
2166 }
0716bf9b
JH
2167 elsif ($_[$i] =~ /^lib$/i)
2168 {
2169 # this causes a different low lib to take care...
61f5c3f5 2170 $CALC = $_[$i+1] || '';
b3abae2a 2171 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
0716bf9b 2172 splice @a, $j, $s; $j -= $s;
58cde26e
JH
2173 }
2174 }
2175 # any non :constant stuff is handled by our parent, Exporter
2176 # even if @_ is empty, to give it a chance
dccbb853
JH
2177 $self->SUPER::import(@a); # need it for subclasses
2178 $self->export_to_level(1,$self,@a); # need it for MBF
58cde26e 2179
574bacfe
JH
2180 # try to load core math lib
2181 my @c = split /\s*,\s*/,$CALC;
2182 push @c,'Calc'; # if all fail, try this
61f5c3f5 2183 $CALC = ''; # signal error
574bacfe
JH
2184 foreach my $lib (@c)
2185 {
2186 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2187 $lib =~ s/\.pm$//;
61f5c3f5 2188 if ($] < 5.006)
574bacfe
JH
2189 {
2190 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
2191 # used in the same script, or eval inside import().
2192 (my $mod = $lib . '.pm') =~ s!::!/!g;
2193 # require does not automatically :: => /, so portability problems arise
bd05a461 2194 eval { require $mod; $lib->import( @c ); }
574bacfe
JH
2195 }
2196 else
2197 {
61f5c3f5 2198 eval "use $lib qw/@c/;";
574bacfe 2199 }
bd05a461 2200 $CALC = $lib, last if $@ eq ''; # no error in loading lib?
574bacfe 2201 }
61f5c3f5 2202 die "Couldn't load any math lib, not even the default" if $CALC eq '';
58cde26e
JH
2203 }
2204
574bacfe 2205sub __from_hex
58cde26e
JH
2206 {
2207 # convert a (ref to) big hex string to BigInt, return undef for error
2208 my $hs = shift;
2209
2210 my $x = Math::BigInt->bzero();
394e6ffb
JH
2211
2212 # strip underscores
2213 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2214 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2215
58cde26e
JH
2216 return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
2217
b22b3e31 2218 my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
58cde26e 2219
b22b3e31 2220 $$hs =~ s/^[+-]//; # strip sign
0716bf9b 2221 if ($CALC->can('_from_hex'))
58cde26e 2222 {
0716bf9b 2223 $x->{value} = $CALC->_from_hex($hs);
58cde26e 2224 }
0716bf9b 2225 else
58cde26e 2226 {
0716bf9b
JH
2227 # fallback to pure perl
2228 my $mul = Math::BigInt->bzero(); $mul++;
2229 my $x65536 = Math::BigInt->new(65536);
2230 my $len = CORE::length($$hs)-2;
2231 $len = int($len/4); # 4-digit parts, w/o '0x'
2232 my $val; my $i = -4;
2233 while ($len >= 0)
2234 {
2235 $val = substr($$hs,$i,4);
b22b3e31 2236 $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
0716bf9b 2237 $val = hex($val); # hex does not like wrong chars
0716bf9b
JH
2238 $i -= 4; $len --;
2239 $x += $mul * $val if $val != 0;
2240 $mul *= $x65536 if $len >= 0; # skip last mul
2241 }
58cde26e 2242 }
13a12e00
JH
2243 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2244 $x;
58cde26e
JH
2245 }
2246
574bacfe 2247sub __from_bin
58cde26e
JH
2248 {
2249 # convert a (ref to) big binary string to BigInt, return undef for error
2250 my $bs = shift;
2251
2252 my $x = Math::BigInt->bzero();
394e6ffb
JH
2253 # strip underscores
2254 $$bs =~ s/([01])_([01])/$1$2/g;
2255 $$bs =~ s/([01])_([01])/$1$2/g;
b22b3e31 2256 return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
58cde26e 2257
0716bf9b 2258 my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
b22b3e31 2259 $$bs =~ s/^[+-]//; # strip sign
0716bf9b 2260 if ($CALC->can('_from_bin'))
58cde26e 2261 {
0716bf9b 2262 $x->{value} = $CALC->_from_bin($bs);
58cde26e 2263 }
0716bf9b 2264 else
58cde26e 2265 {
13a12e00
JH
2266 my $mul = Math::BigInt->bzero(); $mul++;
2267 my $x256 = Math::BigInt->new(256);
0716bf9b
JH
2268 my $len = CORE::length($$bs)-2;
2269 $len = int($len/8); # 8-digit parts, w/o '0b'
2270 my $val; my $i = -8;
2271 while ($len >= 0)
2272 {
2273 $val = substr($$bs,$i,8);
b22b3e31
PN
2274 $val =~ s/^[+-]?0b// if $len == 0; # for last part only
2275 #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
394e6ffb
JH
2276 # slower:
2277 # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
2278 $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
0716bf9b
JH
2279 $i -= 8; $len --;
2280 $x += $mul * $val if $val != 0;
2281 $mul *= $x256 if $len >= 0; # skip last mul
2282 }
58cde26e 2283 }
13a12e00
JH
2284 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2285 $x;
58cde26e
JH
2286 }
2287
2288sub _split
2289 {
2290 # (ref to num_str) return num_str
2291 # internal, take apart a string and return the pieces
dccbb853 2292 # strip leading/trailing whitespace, leading zeros, underscore and reject
574bacfe 2293 # invalid input
58cde26e
JH
2294 my $x = shift;
2295
574bacfe
JH
2296 # strip white space at front, also extranous leading zeros
2297 $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2298 $$x =~ s/^\s+//; # but this will
58cde26e 2299 $$x =~ s/\s+$//g; # strip white space at end
58cde26e 2300
574bacfe
JH
2301 # shortcut, if nothing to split, return early
2302 if ($$x =~ /^[+-]?\d+$/)
2303 {
2304 $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2305 return (\$sign, $x, \'', \'', \0);
2306 }
58cde26e 2307
574bacfe
JH
2308 # invalid starting char?
2309 return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
58cde26e 2310
574bacfe
JH
2311 return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
2312 return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
394e6ffb
JH
2313
2314 # strip underscores between digits
2315 $$x =~ s/(\d)_(\d)/$1$2/g;
2316 $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
574bacfe 2317
58cde26e
JH
2318 # some possible inputs:
2319 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
2320 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
2321
027dc388
JH
2322 return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
2323
58cde26e
JH
2324 my ($m,$e) = split /[Ee]/,$$x;
2325 $e = '0' if !defined $e || $e eq "";
58cde26e
JH
2326 # sign,value for exponent,mantint,mantfrac
2327 my ($es,$ev,$mis,$miv,$mfv);
2328 # valid exponent?
2329 if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2330 {
2331 $es = $1; $ev = $2;
58cde26e
JH
2332 # valid mantissa?
2333 return if $m eq '.' || $m eq '';
2334 my ($mi,$mf) = split /\./,$m;
2335 $mi = '0' if !defined $mi;
2336 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2337 $mf = '0' if !defined $mf || $mf eq '';
2338 if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2339 {
2340 $mis = $1||'+'; $miv = $2;
58cde26e
JH
2341 return unless ($mf =~ /^(\d*?)0*$/); # strip trailing zeros
2342 $mfv = $1;
58cde26e
JH
2343 return (\$mis,\$miv,\$mfv,\$es,\$ev);
2344 }
2345 }
2346 return; # NaN, not a number
2347 }
2348
58cde26e
JH
2349sub as_number
2350 {
2351 # an object might be asked to return itself as bigint on certain overloaded
2352 # operations, this does exactly this, so that sub classes can simple inherit
2353 # it or override with their own integer conversion routine
2354 my $self = shift;
2355
17baacb7 2356 $self->copy();
58cde26e
JH
2357 }
2358
bd05a461
JH
2359sub as_hex
2360 {
2361 # return as hex string, with prefixed 0x
2362 my $x = shift; $x = $class->new($x) if !ref($x);
2363
2364 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2365 return '0x0' if $x->is_zero();
2366
2367 my $es = ''; my $s = '';
2368 $s = $x->{sign} if $x->{sign} eq '-';
bd05a461
JH
2369 if ($CALC->can('_as_hex'))
2370 {
ee15d750 2371 $es = ${$CALC->_as_hex($x->{value})};
bd05a461
JH
2372 }
2373 else
2374 {
2375 my $x1 = $x->copy()->babs(); my $xr;
61f5c3f5 2376 my $x10000 = Math::BigInt->new (0x10000);
bd05a461
JH
2377 while (!$x1->is_zero())
2378 {
61f5c3f5
T
2379 ($x1, $xr) = bdiv($x1,$x10000);
2380 $es .= unpack('h4',pack('v',$xr->numify()));
bd05a461
JH
2381 }
2382 $es = reverse $es;
2383 $es =~ s/^[0]+//; # strip leading zeros
ee15d750 2384 $s .= '0x';
bd05a461
JH
2385 }
2386 $s . $es;
2387 }
2388
2389sub as_bin
2390 {
2391 # return as binary string, with prefixed 0b
2392 my $x = shift; $x = $class->new($x) if !ref($x);
2393
2394 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2395 return '0b0' if $x->is_zero();
2396
2397 my $es = ''; my $s = '';
2398 $s = $x->{sign} if $x->{sign} eq '-';
bd05a461
JH
2399 if ($CALC->can('_as_bin'))
2400 {
ee15d750 2401 $es = ${$CALC->_as_bin($x->{value})};
bd05a461
JH
2402 }
2403 else
2404 {
2405 my $x1 = $x->copy()->babs(); my $xr;
61f5c3f5 2406 my $x10000 = Math::BigInt->new (0x10000);
bd05a461
JH
2407 while (!$x1->is_zero())
2408 {
61f5c3f5
T
2409 ($x1, $xr) = bdiv($x1,$x10000);
2410 $es .= unpack('b16',pack('v',$xr->numify()));
bd05a461
JH
2411 }
2412 $es = reverse $es;
2413 $es =~ s/^[0]+//; # strip leading zeros
ee15d750 2414 $s .= '0b';
bd05a461
JH
2415 }
2416 $s . $es;
2417 }
2418
58cde26e 2419##############################################################################
0716bf9b 2420# internal calculation routines (others are in Math::BigInt::Calc etc)
58cde26e 2421
dccbb853 2422sub __lcm
58cde26e
JH
2423 {
2424 # (BINT or num_str, BINT or num_str) return BINT
2425 # does modify first argument
2426 # LCM
2427
2428 my $x = shift; my $ty = shift;
2429 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
2430 return $x * $ty / bgcd($x,$ty);
2431 }
2432
574bacfe 2433sub __gcd
58cde26e
JH
2434 {
2435 # (BINT or num_str, BINT or num_str) return BINT
dccbb853 2436 # does modify both arguments
58cde26e 2437 # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
dccbb853
JH
2438 my ($x,$ty) = @_;
2439
0716bf9b 2440 return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
58cde26e
JH
2441
2442 while (!$ty->is_zero())
2443 {
2444 ($x, $ty) = ($ty,bmod($x,$ty));
2445 }
2446 $x;
2447 }
2448
58cde26e
JH
2449###############################################################################
2450# this method return 0 if the object can be modified, or 1 for not
2451# We use a fast use constant statement here, to avoid costly calls. Subclasses
2452# may override it with special code (f.i. Math::BigInt::Constant does so)
2453
0716bf9b 2454sub modify () { 0; }
e16b8f49 2455
a0d0e21e 24561;
a5f75d66
AD
2457__END__
2458
2459=head1 NAME
2460
2461Math::BigInt - Arbitrary size integer math package
2462
2463=head1 SYNOPSIS
2464
2465 use Math::BigInt;
58cde26e
JH
2466
2467 # Number creation
574bacfe
JH
2468 $x = Math::BigInt->new($str); # defaults to 0
2469 $nan = Math::BigInt->bnan(); # create a NotANumber
2470 $zero = Math::BigInt->bzero(); # create a +0
2471 $inf = Math::BigInt->binf(); # create a +inf
2472 $inf = Math::BigInt->binf('-'); # create a -inf
2473 $one = Math::BigInt->bone(); # create a +1
2474 $one = Math::BigInt->bone('-'); # create a -1
58cde26e
JH
2475
2476 # Testing
574bacfe
JH
2477 $x->is_zero(); # true if arg is +0
2478 $x->is_nan(); # true if arg is NaN
0716bf9b
JH
2479 $x->is_one(); # true if arg is +1
2480 $x->is_one('-'); # true if arg is -1
2481 $x->is_odd(); # true if odd, false for even
2482 $x->is_even(); # true if even, false for odd
2483 $x->is_positive(); # true if >= 0
2484 $x->is_negative(); # true if < 0
2485 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
b3abae2a 2486 $x->is_int(); # true if $x is an integer (not a float)
0716bf9b 2487
58cde26e
JH
2488 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2489 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2490 $x->sign(); # return the sign, either +,- or NaN
2491 $x->digit($n); # return the nth digit, counting from right
2492 $x->digit(-$n); # return the nth digit, counting from left
2493
2494 # The following all modify their first argument:
2495
2496 # set
2497 $x->bzero(); # set $x to 0
2498 $x->bnan(); # set $x to NaN
574bacfe
JH
2499 $x->bone(); # set $x to +1
2500 $x->bone('-'); # set $x to -1
b3abae2a
JH
2501 $x->binf(); # set $x to inf
2502 $x->binf('-'); # set $x to -inf
58cde26e
JH
2503
2504 $x->bneg(); # negation
2505 $x->babs(); # absolute value
2506 $x->bnorm(); # normalize (no-op)
2507 $x->bnot(); # two's complement (bit wise not)
2508 $x->binc(); # increment x by 1
2509 $x->bdec(); # decrement x by 1
2510
2511 $x->badd($y); # addition (add $y to $x)
2512 $x->bsub($y); # subtraction (subtract $y from $x)
2513 $x->bmul($y); # multiplication (multiply $x by $y)
2514 $x->bdiv($y); # divide, set $x to quotient
2515 # return (quo,rem) or quo if scalar
2516
2517 $x->bmod($y); # modulus (x % y)
2518 $x->bpow($y); # power of arguments (x ** y)
2519 $x->blsft($y); # left shift
2520 $x->brsft($y); # right shift
2521 $x->blsft($y,$n); # left shift, by base $n (like 10)
2522 $x->brsft($y,$n); # right shift, by base $n (like 10)
2523
2524 $x->band($y); # bitwise and
2525 $x->bior($y); # bitwise inclusive or
2526 $x->bxor($y); # bitwise exclusive or
2527 $x->bnot(); # bitwise not (two's complement)
2528
2529 $x->bsqrt(); # calculate square-root
b3abae2a 2530 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
58cde26e
JH
2531
2532 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2533 $x->bround($N); # accuracy: preserve $N digits
2534 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2535
2536 # The following do not modify their arguments in BigInt, but do in BigFloat:
2537 $x->bfloor(); # return integer less or equal than $x
2538 $x->bceil(); # return integer greater or equal than $x
2539
2540 # The following do not modify their arguments:
2541
dccbb853
JH
2542 bgcd(@values); # greatest common divisor (no OO style)
2543 blcm(@values); # lowest common multiplicator (no OO style)
bd05a461 2544
58cde26e 2545 $x->length(); # return number of digits in number
bd05a461
JH
2546 ($x,$f) = $x->length(); # length of number and length of fraction part,
2547 # latter is always 0 digits long for BigInt's
58cde26e
JH
2548
2549 $x->exponent(); # return exponent as BigInt
ee15d750 2550 $x->mantissa(); # return (signed) mantissa as BigInt
58cde26e 2551 $x->parts(); # return (mantissa,exponent) as BigInt
0716bf9b
JH
2552 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2553 $x->as_number(); # return as BigInt (in BigInt: same as copy())
bd05a461
JH
2554
2555 # conversation to string
2556 $x->bstr(); # normalized string
2557 $x->bsstr(); # normalized string in scientific notation
2558 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2559 $x->as_bin(); # as signed binary string with prefixed 0b
2560
a5f75d66
AD
2561=head1 DESCRIPTION
2562
58cde26e
JH
2563All operators (inlcuding basic math operations) are overloaded if you
2564declare your big integers as
a5f75d66 2565
58cde26e 2566 $i = new Math::BigInt '123_456_789_123_456_789';
a5f75d66 2567
58cde26e
JH
2568Operations with overloaded operators preserve the arguments which is
2569exactly what you expect.
a5f75d66
AD
2570
2571=over 2
2572
2573=item Canonical notation
2574
58cde26e 2575Big integer values are strings of the form C</^[+-]\d+$/> with leading
a5f75d66
AD
2576zeros suppressed.
2577
58cde26e
JH
2578 '-0' canonical value '-0', normalized '0'
2579 ' -123_123_123' canonical value '-123123123'
2580 '1_23_456_7890' canonical value '1234567890'
2581
a5f75d66
AD
2582=item Input
2583
58cde26e
JH
2584Input values to these routines may be either Math::BigInt objects or
2585strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2586
2587You can include one underscore between any two digits.
2588
2589This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2590Non integer values result in NaN.
2591
2592Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2593in 'NaN'.
2594
2595bnorm() on a BigInt object is now effectively a no-op, since the numbers
2596are always stored in normalized form. On a string, it creates a BigInt
2597object.
a5f75d66
AD
2598
2599=item Output
2600
58cde26e
JH
2601Output values are BigInt objects (normalized), except for bstr(), which
2602returns a string in normalized form.
2603Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2604C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2605return either undef, <0, 0 or >0 and are suited for sort.
a5f75d66
AD
2606
2607=back
2608
b3abae2a
JH
2609=head1 METHODS
2610
2611Each of the methods below accepts three additional parameters. These arguments
2612$A, $P and $R are accuracy, precision and round_mode. Please see more in the
2613section about ACCURACY and ROUNDIND.
2614
13a12e00
JH
2615=head2 accuracy
2616
2617 $x->accuracy(5); # local for $x
2618 $class->accuracy(5); # global for all members of $class
2619
2620Set or get the global or local accuracy, aka how many significant digits the
2621results have. Please see the section about L<ACCURACY AND PRECISION> for
2622further details.
2623
2624Value must be greater than zero. Pass an undef value to disable it:
2625
2626 $x->accuracy(undef);
2627 Math::BigInt->accuracy(undef);
2628
2629Returns the current accuracy. For C<$x->accuracy()> it will return either the
2630local accuracy, or if not defined, the global. This means the return value
2631represents the accuracy that will be in effect for $x:
2632
2633 $y = Math::BigInt->new(1234567); # unrounded
2634 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
2635 $x = Math::BigInt->new(123456); # will be automatically rounded
2636 print "$x $y\n"; # '123500 1234567'
2637 print $x->accuracy(),"\n"; # will be 4
2638 print $y->accuracy(),"\n"; # also 4, since global is 4
2639 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
2640 print $x->accuracy(),"\n"; # still 4
2641 print $y->accuracy(),"\n"; # 5, since global is 5
2642
b3abae2a
JH
2643=head2 brsft
2644
2645 $x->brsft($y,$n);
2646
2647Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
26482, but others work, too.
2649
2650Right shifting usually amounts to dividing $x by $n ** $y and truncating the
2651result:
2652
2653
2654 $x = Math::BigInt->new(10);
2655 $x->brsft(1); # same as $x >> 1: 5
2656 $x = Math::BigInt->new(1234);
2657 $x->brsft(2,10); # result 12
2658
2659There is one exception, and that is base 2 with negative $x:
2660
2661
2662 $x = Math::BigInt->new(-5);
2663 print $x->brsft(1);
2664
2665This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
2666result).
2667
2668=head2 new
2669
2670 $x = Math::BigInt->new($str,$A,$P,$R);
2671
2672Creates a new BigInt object from a string or another BigInt object. The
2673input is accepted as decimal, hex (with leading '0x') or binary (with leading
2674'0b').
2675
2676=head2 bnan
2677
2678 $x = Math::BigInt->bnan();
2679
2680Creates a new BigInt object representing NaN (Not A Number).
2681If used on an object, it will set it to NaN:
2682
2683 $x->bnan();
2684
2685=head2 bzero
2686
2687 $x = Math::BigInt->bzero();
2688
2689Creates a new BigInt object representing zero.
2690If used on an object, it will set it to zero:
2691
2692 $x->bzero();
2693
2694=head2 binf
2695
2696 $x = Math::BigInt->binf($sign);
2697
2698Creates a new BigInt object representing infinity. The optional argument is
2699either '-' or '+', indicating whether you want infinity or minus infinity.
2700If used on an object, it will set it to infinity:
2701
2702 $x->binf();
2703 $x->binf('-');
2704
2705=head2 bone
2706
2707 $x = Math::BigInt->binf($sign);
2708
2709Creates a new BigInt object representing one. The optional argument is
2710either '-' or '+', indicating whether you want one or minus one.
2711If used on an object, it will set it to one:
2712
2713 $x->bone(); # +1
2714 $x->bone('-'); # -1
2715
56b9c951
JH
2716=head2 is_one()/is_zero()/is_nan()/is_inf()
2717
b3abae2a
JH
2718
2719 $x->is_zero(); # true if arg is +0
2720 $x->is_nan(); # true if arg is NaN
2721 $x->is_one(); # true if arg is +1
2722 $x->is_one('-'); # true if arg is -1
b3abae2a
JH
2723 $x->is_inf(); # true if +inf
2724 $x->is_inf('-'); # true if -inf (sign is default '+')
56b9c951
JH
2725
2726These methods all test the BigInt for beeing one specific value and return
2727true or false depending on the input. These are faster than doing something
2728like:
2729
2730 if ($x == 0)
2731
2732=head2 is_positive()/is_negative()
2733
2734 $x->is_positive(); # true if >= 0
2735 $x->is_negative(); # true if < 0
2736
2737The methods return true if the argument is positive or negative, respectively.
2738C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
2739C<-inf> is negative. A C<zero> is positive.
2740
2741These methods are only testing the sign, and not the value.
2742
2743=head2 is_odd()/is_even()/is_int()
2744
2745 $x->is_odd(); # true if odd, false for even
2746 $x->is_even(); # true if even, false for odd
b3abae2a
JH
2747 $x->is_int(); # true if $x is an integer
2748
56b9c951
JH
2749The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
2750C<-inf> are not integers and are neither odd nor even.
b3abae2a
JH
2751
2752=head2 bcmp
2753
56b9c951
JH
2754 $x->bcmp($y);
2755
2756Compares $x with $y and takes the sign into account.
2757Returns -1, 0, 1 or undef.
b3abae2a
JH
2758
2759=head2 bacmp
2760
56b9c951
JH
2761 $x->bacmp($y);
2762
2763Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
b3abae2a
JH
2764
2765=head2 sign
2766
56b9c951
JH
2767 $x->sign();
2768
2769Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
b3abae2a
JH
2770
2771=head2 bcmp
2772
2773 $x->digit($n); # return the nth digit, counting from right
2774
2775=head2 bneg
2776
2777 $x->bneg();
2778
2779Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
2780and '-inf', respectively. Does nothing for NaN or zero.
2781
2782=head2 babs
2783
2784 $x->babs();
2785
2786Set the number to it's absolute value, e.g. change the sign from '-' to '+'
2787and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
2788numbers.
2789
2790=head2 bnorm
2791
2792 $x->bnorm(); # normalize (no-op)
2793
2794=head2 bnot
2795
2796 $x->bnot(); # two's complement (bit wise not)
2797
2798=head2 binc
2799
2800 $x->binc(); # increment x by 1
2801
2802=head2 bdec
2803
2804 $x->bdec(); # decrement x by 1
2805
2806=head2 badd
2807
2808 $x->badd($y); # addition (add $y to $x)
2809
2810=head2 bsub
2811
2812 $x->bsub($y); # subtraction (subtract $y from $x)
2813
2814=head2 bmul
2815
2816 $x->bmul($y); # multiplication (multiply $x by $y)
2817
2818=head2 bdiv
2819
2820 $x->bdiv($y); # divide, set $x to quotient
2821 # return (quo,rem) or quo if scalar
2822
2823=head2 bmod
2824
2825 $x->bmod($y); # modulus (x % y)
2826
2827=head2 bpow
2828
2829 $x->bpow($y); # power of arguments (x ** y)
2830
2831=head2 blsft
2832
2833 $x->blsft($y); # left shift
2834 $x->blsft($y,$n); # left shift, by base $n (like 10)
2835
2836=head2 brsft
2837
2838 $x->brsft($y); # right shift
2839 $x->brsft($y,$n); # right shift, by base $n (like 10)
2840
2841=head2 band
2842
2843 $x->band($y); # bitwise and
2844
2845=head2 bior
2846
2847 $x->bior($y); # bitwise inclusive or
2848
2849=head2 bxor
2850
2851 $x->bxor($y); # bitwise exclusive or
2852
2853=head2 bnot
2854
2855 $x->bnot(); # bitwise not (two's complement)
2856
2857=head2 bsqrt
2858
2859 $x->bsqrt(); # calculate square-root
2860
2861=head2 bfac
2862
2863 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
2864
2865=head2 round
2866
2867 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2868
2869=head2 bround
2870
2871 $x->bround($N); # accuracy: preserve $N digits
2872
2873=head2 bfround
2874
2875 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2876
2877=head2 bfloor
2878
2879 $x->bfloor();
2880
2881Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
2882does change $x in BigFloat.
2883
2884=head2 bceil
2885
2886 $x->bceil();
2887
2888Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
2889does change $x in BigFloat.
2890
2891=head2 bgcd
2892
2893 bgcd(@values); # greatest common divisor (no OO style)
2894
2895=head2 blcm
2896
2897 blcm(@values); # lowest common multiplicator (no OO style)
2898
2899head2 length
2900
2901 $x->length();
2902 ($xl,$fl) = $x->length();
2903
2904Returns the number of digits in the decimal representation of the number.
2905In list context, returns the length of the integer and fraction part. For
2906BigInt's, the length of the fraction part will always be 0.
2907
2908=head2 exponent
2909
2910 $x->exponent();
2911
2912Return the exponent of $x as BigInt.
2913
2914=head2 mantissa
2915
2916 $x->mantissa();
2917
2918Return the signed mantissa of $x as BigInt.
2919
2920=head2 parts
2921
2922 $x->parts(); # return (mantissa,exponent) as BigInt
2923
2924=head2 copy
2925
2926 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2927
2928=head2 as_number
2929
2930 $x->as_number(); # return as BigInt (in BigInt: same as copy())
2931
2932=head2 bsrt
2933
2934 $x->bstr(); # normalized string
2935
2936=head2 bsstr
2937
2938 $x->bsstr(); # normalized string in scientific notation
2939
2940=head2 as_hex
2941
2942 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2943
2944=head2 as_bin
2945
2946 $x->as_bin(); # as signed binary string with prefixed 0b
2947
0716bf9b
JH
2948=head1 ACCURACY and PRECISION
2949
b22b3e31 2950Since version v1.33, Math::BigInt and Math::BigFloat have full support for
0716bf9b 2951accuracy and precision based rounding, both automatically after every
b22b3e31 2952operation as well as manually.
0716bf9b
JH
2953
2954This section describes the accuracy/precision handling in Math::Big* as it
b22b3e31 2955used to be and as it is now, complete with an explanation of all terms and
0716bf9b
JH
2956abbreviations.
2957
2958Not yet implemented things (but with correct description) are marked with '!',
2959things that need to be answered are marked with '?'.
2960
2961In the next paragraph follows a short description of terms used here (because
574bacfe 2962these may differ from terms used by others people or documentation).
0716bf9b 2963
b22b3e31 2964During the rest of this document, the shortcuts A (for accuracy), P (for
0716bf9b
JH
2965precision), F (fallback) and R (rounding mode) will be used.
2966
2967=head2 Precision P
2968
2969A fixed number of digits before (positive) or after (negative)
b22b3e31
PN
2970the decimal point. For example, 123.45 has a precision of -2. 0 means an
2971integer like 123 (or 120). A precision of 2 means two digits to the left
2972of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2973numbers with zeros before the decimal point may have different precisions,
2974because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2975was). It could also have p < 0, when the digits after the decimal point
2976are zero.
0716bf9b 2977
574bacfe
JH
2978The string output (of floating point numbers) will be padded with zeros:
2979
2980 Initial value P A Result String
2981 ------------------------------------------------------------
2982 1234.01 -3 1000 1000
2983 1234 -2 1200 1200
2984 1234.5 -1 1230 1230
2985 1234.001 1 1234 1234.0
2986 1234.01 0 1234 1234
2987 1234.01 2 1234.01 1234.01
2988 1234.01 5 1234.01 1234.01000
2989
2990For BigInts, no padding occurs.
0716bf9b
JH
2991
2992=head2 Accuracy A
2993
2994Number of significant digits. Leading zeros are not counted. A
2995number may have an accuracy greater than the non-zero digits
b22b3e31
PN
2996when there are zeros in it or trailing zeros. For example, 123.456 has
2997A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
0716bf9b 2998
574bacfe
JH
2999The string output (of floating point numbers) will be padded with zeros:
3000
3001 Initial value P A Result String
3002 ------------------------------------------------------------
3003 1234.01 3 1230 1230
3004 1234.01 6 1234.01 1234.01
3005 1234.1 8 1234.1 1234.1000
3006
3007For BigInts, no padding occurs.
3008
0716bf9b 3009=head2 Fallback F
a5f75d66 3010
574bacfe
JH
3011When both A and P are undefined, this is used as a fallback accuracy when
3012dividing numbers.
0716bf9b
JH
3013
3014=head2 Rounding mode R
3015
3016When rounding a number, different 'styles' or 'kinds'
3017of rounding are possible. (Note that random rounding, as in
3018Math::Round, is not implemented.)
58cde26e
JH
3019
3020=over 2
a5f75d66 3021
0716bf9b
JH
3022=item 'trunc'
3023
3024truncation invariably removes all digits following the
3025rounding place, replacing them with zeros. Thus, 987.65 rounded
b22b3e31 3026to tens (P=1) becomes 980, and rounded to the fourth sigdig
0716bf9b 3027becomes 987.6 (A=4). 123.456 rounded to the second place after the
b22b3e31 3028decimal point (P=-2) becomes 123.46.
0716bf9b
JH
3029
3030All other implemented styles of rounding attempt to round to the
3031"nearest digit." If the digit D immediately to the right of the
3032rounding place (skipping the decimal point) is greater than 5, the
3033number is incremented at the rounding place (possibly causing a
3034cascade of incrementation): e.g. when rounding to units, 0.9 rounds
3035to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
3036truncated at the rounding place: e.g. when rounding to units, 0.4
3037rounds to 0, and -19.4 rounds to -19.
3038
3039However the results of other styles of rounding differ if the
3040digit immediately to the right of the rounding place (skipping the
3041decimal point) is 5 and if there are no digits, or no digits other
3042than 0, after that 5. In such cases:
3043
3044=item 'even'
3045
3046rounds the digit at the rounding place to 0, 2, 4, 6, or 8
3047if it is not already. E.g., when rounding to the first sigdig, 0.45
3048becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
3049
3050=item 'odd'
3051
3052rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
3053it is not already. E.g., when rounding to the first sigdig, 0.45
3054becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
3055
3056=item '+inf'
3057
3058round to plus infinity, i.e. always round up. E.g., when
3059rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
b22b3e31 3060and 0.4501 also becomes 0.5.
0716bf9b
JH
3061
3062=item '-inf'
3063
3064round to minus infinity, i.e. always round down. E.g., when
3065rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
3066but 0.4501 becomes 0.5.
3067
3068=item 'zero'
3069
3070round to zero, i.e. positive numbers down, negative ones up.
3071E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
3072becomes -0.5, but 0.4501 becomes 0.5.
3073
3074=back
3075
3076The handling of A & P in MBI/MBF (the old core code shipped with Perl
3077versions <= 5.7.2) is like this:
3078
3079=over 2
a5f75d66 3080
0716bf9b
JH
3081=item Precision
3082
b22b3e31
PN
3083 * ffround($p) is able to round to $p number of digits after the decimal
3084 point
0716bf9b
JH
3085 * otherwise P is unused
3086
3087=item Accuracy (significant digits)
3088
3089 * fround($a) rounds to $a significant digits
3090 * only fdiv() and fsqrt() take A as (optional) paramater
b22b3e31 3091 + other operations simply create the same number (fneg etc), or more (fmul)
0716bf9b
JH
3092 of digits
3093 + rounding/truncating is only done when explicitly calling one of fround
3094 or ffround, and never for BigInt (not implemented)
b22b3e31 3095 * fsqrt() simply hands its accuracy argument over to fdiv.
0716bf9b
JH
3096 * the documentation and the comment in the code indicate two different ways
3097 on how fdiv() determines the maximum number of digits it should calculate,
3098 and the actual code does yet another thing
3099 POD:
3100 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
3101 Comment:
3102 result has at most max(scale, length(dividend), length(divisor)) digits
3103 Actual code:
3104 scale = max(scale, length(dividend)-1,length(divisor)-1);
3105 scale += length(divisior) - length(dividend);
b22b3e31 3106 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
0716bf9b
JH
3107 Actually, the 'difference' added to the scale is calculated from the
3108 number of "significant digits" in dividend and divisor, which is derived
3109 by looking at the length of the mantissa. Which is wrong, since it includes
3110 the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
3111 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
3112 assumption that 124 has 3 significant digits, while 120/7 will get you
3113 '17', not '17.1' since 120 is thought to have 2 significant digits.
dccbb853 3114 The rounding after the division then uses the remainder and $y to determine
0716bf9b 3115 wether it must round up or down.
b22b3e31
PN
3116 ? I have no idea which is the right way. That's why I used a slightly more
3117 ? simple scheme and tweaked the few failing testcases to match it.
58cde26e 3118
0716bf9b 3119=back
5dc6f178 3120
0716bf9b 3121This is how it works now:
5dc6f178 3122
0716bf9b 3123=over 2
5dc6f178 3124
0716bf9b
JH
3125=item Setting/Accessing
3126
b3abae2a
JH
3127 * You can set the A global via Math::BigInt->accuracy() or
3128 Math::BigFloat->accuracy() or whatever class you are using.
3129 * You can also set P globally by using Math::SomeClass->precision() likewise.
0716bf9b 3130 * Globals are classwide, and not inherited by subclasses.
b3abae2a
JH
3131 * to undefine A, use Math::SomeCLass->accuracy(undef);
3132 * to undefine P, use Math::SomeClass->precision(undef);
3133 * Setting Math::SomeClass->accuracy() clears automatically
3134 Math::SomeClass->precision(), and vice versa.
0716bf9b 3135 * To be valid, A must be > 0, P can have any value.
b22b3e31
PN
3136 * If P is negative, this means round to the P'th place to the right of the
3137 decimal point; positive values mean to the left of the decimal point.
3138 P of 0 means round to integer.
b3abae2a
JH
3139 * to find out the current global A, take Math::SomeClass->accuracy()
3140 * to find out the current global P, take Math::SomeClass->precision()
3141 * use $x->accuracy() respective $x->precision() for the local setting of $x.
3142 * Please note that $x->accuracy() respecive $x->precision() fall back to the
3143 defined globals, when $x's A or P is not set.
0716bf9b
JH
3144
3145=item Creating numbers
3146
b3abae2a
JH
3147 * When you create a number, you can give it's desired A or P via:
3148 $x = Math::BigInt->new($number,$A,$P);
3149 * Only one of A or P can be defined, otherwise the result is NaN
3150 * If no A or P is give ($x = Math::BigInt->new($number) form), then the
3151 globals (if set) will be used. Thus changing the global defaults later on
b22b3e31 3152 will not change the A or P of previously created numbers (i.e., A and P of
b3abae2a
JH
3153 $x will be what was in effect when $x was created)
3154 * If given undef for A and P, B<no> rounding will occur, and the globals will
3155 B<not> be used. This is used by subclasses to create numbers without
3156 suffering rounding in the parent. Thus a subclass is able to have it's own
3157 globals enforced upon creation of a number by using
3158 $x = Math::BigInt->new($number,undef,undef):
3159
3160 use Math::Bigint::SomeSubclass;
3161 use Math::BigInt;
3162
3163 Math::BigInt->accuracy(2);
3164 Math::BigInt::SomeSubClass->accuracy(3);
3165 $x = Math::BigInt::SomeSubClass->new(1234);
3166
3167 $x is now 1230, and not 1200. A subclass might choose to implement
3168 this otherwise, e.g. falling back to the parent's A and P.
0716bf9b
JH
3169
3170=item Usage
3171
b22b3e31 3172 * If A or P are enabled/defined, they are used to round the result of each
0716bf9b 3173 operation according to the rules below
b22b3e31
PN
3174 * Negative P is ignored in Math::BigInt, since BigInts never have digits
3175 after the decimal point
574bacfe
JH
3176 * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
3177 Math::BigInt as globals should not tamper with the parts of a BigFloat.
3178 Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
0716bf9b
JH
3179
3180=item Precedence
3181
b22b3e31
PN
3182 * It only makes sense that a number has only one of A or P at a time.
3183 Since you can set/get both A and P, there is a rule that will practically
3184 enforce only A or P to be in effect at a time, even if both are set.
3185 This is called precedence.
b3abae2a
JH
3186 * If two objects are involved in an operation, and one of them has A in
3187 effect, and the other P, this results in an error (NaN).
0716bf9b 3188 * A takes precendence over P (Hint: A comes before P). If A is defined, it
b22b3e31
PN
3189 is used, otherwise P is used. If neither of them is defined, nothing is
3190 used, i.e. the result will have as many digits as it can (with an
3191 exception for fdiv/fsqrt) and will not be rounded.
3192 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
3193 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
3194 If either the dividend's or the divisor's mantissa has more digits than
3195 the value of F, the higher value will be used instead of F.
3196 This is to limit the digits (A) of the result (just consider what would
3197 happen with unlimited A and P in the case of 1/3 :-)
b3abae2a 3198 * fdiv will calculate (at least) 4 more digits than required (determined by
0716bf9b 3199 A, P or F), and, if F is not used, round the result
b22b3e31 3200 (this will still fail in the case of a result like 0.12345000000001 with A
574bacfe 3201 or P of 5, but this can not be helped - or can it?)
b22b3e31 3202 * Thus you can have the math done by on Math::Big* class in three modes:
0716bf9b
JH
3203 + never round (this is the default):
3204 This is done by setting A and P to undef. No math operation
b22b3e31 3205 will round the result, with fdiv() and fsqrt() as exceptions to guard
0716bf9b 3206 against overflows. You must explicitely call bround(), bfround() or
b22b3e31
PN
3207 round() (the latter with parameters).
3208 Note: Once you have rounded a number, the settings will 'stick' on it
3209 and 'infect' all other numbers engaged in math operations with it, since
0716bf9b
JH
3210 local settings have the highest precedence. So, to get SaferRound[tm],
3211 use a copy() before rounding like this:
3212
3213 $x = Math::BigFloat->new(12.34);
3214 $y = Math::BigFloat->new(98.76);
3215 $z = $x * $y; # 1218.6984
3216 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
3217 $z = $x * $y; # still 1218.6984, without
3218 # copy would have been 1210!
3219
3220 + round after each op:
b22b3e31
PN
3221 After each single operation (except for testing like is_zero()), the
3222 method round() is called and the result is rounded appropriately. By
0716bf9b 3223 setting proper values for A and P, you can have all-the-same-A or
b22b3e31
PN
3224 all-the-same-P modes. For example, Math::Currency might set A to undef,
3225 and P to -2, globally.
0716bf9b 3226
b22b3e31
PN
3227 ?Maybe an extra option that forbids local A & P settings would be in order,
3228 ?so that intermediate rounding does not 'poison' further math?
0716bf9b
JH
3229
3230=item Overriding globals
3231
3232 * you will be able to give A, P and R as an argument to all the calculation
b22b3e31 3233 routines; the second parameter is A, the third one is P, and the fourth is
b3abae2a 3234 R (shift right by one for binary operations like badd). P is used only if
b22b3e31
PN
3235 the first parameter (A) is undefined. These three parameters override the
3236 globals in the order detailed as follows, i.e. the first defined value
0716bf9b 3237 wins:
b22b3e31 3238 (local: per object, global: global default, parameter: argument to sub)
0716bf9b
JH
3239 + parameter A
3240 + parameter P
3241 + local A (if defined on both of the operands: smaller one is taken)
b3abae2a 3242 + local P (if defined on both of the operands: bigger one is taken)
0716bf9b
JH
3243 + global A
3244 + global P
3245 + global F
b22b3e31 3246 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
0716bf9b
JH
3247 arguments (A and P) instead of one
3248
3249=item Local settings
3250
3251 * You can set A and P locally by using $x->accuracy() and $x->precision()
3252 and thus force different A and P for different objects/numbers.
b22b3e31 3253 * Setting A or P this way immediately rounds $x to the new value.
b3abae2a 3254 * $x->accuracy() clears $x->precision(), and vice versa.
0716bf9b
JH
3255
3256=item Rounding
3257
b22b3e31 3258 * the rounding routines will use the respective global or local settings.
0716bf9b
JH
3259 fround()/bround() is for accuracy rounding, while ffround()/bfround()
3260 is for precision
3261 * the two rounding functions take as the second parameter one of the
3262 following rounding modes (R):
3263 'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
3264 * you can set and get the global R by using Math::SomeClass->round_mode()
ee15d750 3265 or by setting $Math::SomeClass::round_mode
0716bf9b 3266 * after each operation, $result->round() is called, and the result may
b22b3e31
PN
3267 eventually be rounded (that is, if A or P were set either locally,
3268 globally or as parameter to the operation)
ee15d750 3269 * to manually round a number, call $x->round($A,$P,$round_mode);
b22b3e31 3270 this will round the number by using the appropriate rounding function
0716bf9b 3271 and then normalize it.
b22b3e31 3272 * rounding modifies the local settings of the number:
0716bf9b
JH
3273
3274 $x = Math::BigFloat->new(123.456);
3275 $x->accuracy(5);
3276 $x->bround(4);
3277
3278 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
3279 will be 4 from now on.
3280
3281=item Default values
3282
3283 * R: 'even'
3284 * F: 40
3285 * A: undef
3286 * P: undef
3287
3288=item Remarks
3289
3290 * The defaults are set up so that the new code gives the same results as
3291 the old code (except in a few cases on fdiv):
3292 + Both A and P are undefined and thus will not be used for rounding
3293 after each operation.
3294 + round() is thus a no-op, unless given extra parameters A and P
58cde26e
JH
3295
3296=back
3297
0716bf9b
JH
3298=head1 INTERNALS
3299
574bacfe
JH
3300The actual numbers are stored as unsigned big integers (with seperate sign).
3301You should neither care about nor depend on the internal representation; it
3302might change without notice. Use only method calls like C<< $x->sign(); >>
3303instead relying on the internal hash keys like in C<< $x->{sign}; >>.
3304
3305=head2 MATH LIBRARY
58cde26e 3306
574bacfe
JH
3307Math with the numbers is done (by default) by a module called
3308Math::BigInt::Calc. This is equivalent to saying:
3309
3310 use Math::BigInt lib => 'Calc';
58cde26e 3311
0716bf9b 3312You can change this by using:
58cde26e 3313
0716bf9b 3314 use Math::BigInt lib => 'BitVect';
58cde26e 3315
574bacfe
JH
3316The following would first try to find Math::BigInt::Foo, then
3317Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
0716bf9b 3318
574bacfe 3319 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
58cde26e 3320
574bacfe 3321Calc.pm uses as internal format an array of elements of some decimal base
b3abae2a
JH
3322(usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm
3323uses a bit vector of base 2, most significant bit first. Other modules might
3324use even different means of representing the numbers. See the respective
3325module documentation for further details.
58cde26e 3326
574bacfe
JH
3327=head2 SIGN
3328
3329The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
3330
3331A sign of 'NaN' is used to represent the result when input arguments are not
3332numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
3333minus infinity. You will get '+inf' when dividing a positive number by 0, and
3334'-inf' when dividing any negative number by 0.
58cde26e
JH
3335
3336=head2 mantissa(), exponent() and parts()
3337
3338C<mantissa()> and C<exponent()> return the said parts of the BigInt such
3339that:
3340
3341 $m = $x->mantissa();
3342 $e = $x->exponent();
3343 $y = $m * ( 10 ** $e );
3344 print "ok\n" if $x == $y;
3345
b22b3e31
PN
3346C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
3347in one go. Both the returned mantissa and exponent have a sign.
58cde26e 3348
574bacfe
JH
3349Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
3350where it will be NaN; and for $x == 0, where it will be 1
3351(to be compatible with Math::BigFloat's internal representation of a zero as
3352C<0E1>).
58cde26e
JH
3353
3354C<$m> will always be a copy of the original number. The relation between $e
b22b3e31 3355and $m might change in the future, but will always be equivalent in a
0716bf9b
JH
3356numerical sense, e.g. $m might get minimized.
3357
58cde26e
JH
3358=head1 EXAMPLES
3359
394e6ffb 3360 use Math::BigInt;
574bacfe
JH
3361
3362 sub bint { Math::BigInt->new(shift); }
3363
394e6ffb 3364 $x = Math::BigInt->bstr("1234") # string "1234"
58cde26e 3365 $x = "$x"; # same as bstr()
58cde26e
JH
3366 $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
3367 $x = Math::BigInt->babs("-12345"); # Bigint "12345"
3368 $x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
3369 $x = bint(1) + bint(2); # BigInt "3"
3370 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
3371 $x = bint(1); # BigInt "1"
3372 $x = $x + 5 / 2; # BigInt "3"
3373 $x = $x ** 3; # BigInt "27"
3374 $x *= 2; # BigInt "54"
394e6ffb 3375 $x = Math::BigInt->new(0); # BigInt "0"
58cde26e
JH
3376 $x--; # BigInt "-1"
3377 $x = Math::BigInt->badd(4,5) # BigInt "9"
58cde26e 3378 print $x->bsstr(); # 9e+0
a5f75d66 3379
0716bf9b
JH
3380Examples for rounding:
3381
3382 use Math::BigFloat;
3383 use Test;
3384
3385 $x = Math::BigFloat->new(123.4567);
3386 $y = Math::BigFloat->new(123.456789);
394e6ffb 3387 Math::BigFloat->accuracy(4); # no more A than 4
0716bf9b
JH
3388
3389 ok ($x->copy()->fround(),123.4); # even rounding
3390 print $x->copy()->fround(),"\n"; # 123.4
3391 Math::BigFloat->round_mode('odd'); # round to odd
3392 print $x->copy()->fround(),"\n"; # 123.5
394e6ffb 3393 Math::BigFloat->accuracy(5); # no more A than 5
0716bf9b
JH
3394 Math::BigFloat->round_mode('odd'); # round to odd
3395 print $x->copy()->fround(),"\n"; # 123.46
3396 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
3397 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
3398
394e6ffb
JH
3399 Math::BigFloat->accuracy(undef); # A not important now
3400 Math::BigFloat->precision(2); # P important
3401 print $x->copy()->bnorm(),"\n"; # 123.46
3402 print $x->copy()->fround(),"\n"; # 123.46
0716bf9b 3403
bd05a461
JH
3404Examples for converting:
3405
3406 my $x = Math::BigInt->new('0b1'.'01' x 123);
3407 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
3408
b3ac6de7
IZ
3409=head1 Autocreating constants
3410
56b9c951
JH
3411After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
3412and binary constants in the given scope are converted to C<Math::BigInt>.
3413This conversion happens at compile time.
b3ac6de7 3414
b22b3e31 3415In particular,
b3ac6de7 3416
58cde26e
JH
3417 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
3418
56b9c951 3419prints the integer value of C<2**100>. Note that without conversion of
0716bf9b 3420constants the expression 2**100 will be calculated as perl scalar.
58cde26e
JH
3421
3422Please note that strings and floating point constants are not affected,
3423so that
3424
3425 use Math::BigInt qw/:constant/;
3426
3427 $x = 1234567890123456789012345678901234567890
3428 + 123456789123456789;
b22b3e31 3429 $y = '1234567890123456789012345678901234567890'
58cde26e 3430 + '123456789123456789';
b3ac6de7 3431
b22b3e31 3432do not work. You need an explicit Math::BigInt->new() around one of the
394e6ffb
JH
3433operands. You should also quote large constants to protect loss of precision:
3434
3435 use Math::Bigint;
3436
3437 $x = Math::BigInt->new('1234567889123456789123456789123456789');
3438
3439Without the quotes Perl would convert the large number to a floating point
3440constant at compile time and then hand the result to BigInt, which results in
3441an truncated result or a NaN.
58cde26e 3442
56b9c951
JH
3443This also applies to integers that look like floating point constants:
3444
3445 use Math::BigInt ':constant';
3446
3447 print ref(123e2),"\n";
3448 print ref(123.2e2),"\n";
3449
3450will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
3451to get this to work.
3452
58cde26e
JH
3453=head1 PERFORMANCE
3454
3455Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
3456must be made in the second case. For long numbers, the copy can eat up to 20%
b22b3e31 3457of the work (in the case of addition/subtraction, less for
58cde26e
JH
3458multiplication/division). If $y is very small compared to $x, the form
3459$x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
3460more time then the actual addition.
3461
b22b3e31 3462With a technique called copy-on-write, the cost of copying with overload could
394e6ffb
JH
3463be minimized or even completely avoided. A test implementation of COW did show
3464performance gains for overloaded math, but introduced a performance loss due
3465to a constant overhead for all other operatons.
3466
3467The rewritten version of this module is slower on certain operations, like
3468new(), bstr() and numify(). The reason are that it does now more work and
3469handles more cases. The time spent in these operations is usually gained in
3470the other operations so that programs on the average should get faster. If
3471they don't, please contect the author.
58cde26e 3472
394e6ffb
JH
3473Some operations may be slower for small numbers, but are significantly faster
3474for big numbers. Other operations are now constant (O(1), like bneg(), babs()
3475etc), instead of O(N) and thus nearly always take much less time. These
3476optimizations were done on purpose.
58cde26e 3477
574bacfe
JH
3478If you find the Calc module to slow, try to install any of the replacement
3479modules and see if they help you.
b3ac6de7 3480
574bacfe 3481=head2 Alternative math libraries
0716bf9b
JH
3482
3483You can use an alternative library to drive Math::BigInt via:
3484
3485 use Math::BigInt lib => 'Module';
3486
394e6ffb 3487See L<MATH LIBRARY> for more information.
0716bf9b 3488
394e6ffb 3489For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
574bacfe 3490
b3abae2a
JH
3491=head2 SUBCLASSING
3492
3493=head1 Subclassing Math::BigInt
3494
3495The basic design of Math::BigInt allows simple subclasses with very little
3496work, as long as a few simple rules are followed:
3497
3498=over 2
3499
3500=item *
3501
3502The public API must remain consistent, i.e. if a sub-class is overloading
3503addition, the sub-class must use the same name, in this case badd(). The
3504reason for this is that Math::BigInt is optimized to call the object methods
3505directly.
3506
3507=item *
3508
3509The private object hash keys like C<$x->{sign}> may not be changed, but
3510additional keys can be added, like C<$x->{_custom}>.
3511
3512=item *
3513
3514Accessor functions are available for all existing object hash keys and should
3515be used instead of directly accessing the internal hash keys. The reason for
3516this is that Math::BigInt itself has a pluggable interface which permits it
3517to support different storage methods.
3518
3519=back
3520
3521More complex sub-classes may have to replicate more of the logic internal of
3522Math::BigInt if they need to change more basic behaviors. A subclass that
3523needs to merely change the output only needs to overload C<bstr()>.
3524
3525All other object methods and overloaded functions can be directly inherited
3526from the parent class.
3527
3528At the very minimum, any subclass will need to provide it's own C<new()> and can
3529store additional hash keys in the object. There are also some package globals
3530that must be defined, e.g.:
3531
3532 # Globals
3533 $accuracy = undef;
3534 $precision = -2; # round to 2 decimal places
3535 $round_mode = 'even';
3536 $div_scale = 40;
3537
3538Additionally, you might want to provide the following two globals to allow
3539auto-upgrading and auto-downgrading to work correctly:
3540
3541 $upgrade = undef;
3542 $downgrade = undef;
3543
3544This allows Math::BigInt to correctly retrieve package globals from the
3545subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
3546t/Math/BigFloat/SubClass.pm completely functional subclass examples.
3547
3548Don't forget to
3549
3550 use overload;
3551
3552in your subclass to automatically inherit the overloading from the parent. If
3553you like, you can change part of the overloading, look at Math::String for an
3554example.
3555
3556=head1 UPGRADING
3557
3558When used like this:
3559
3560 use Math::BigInt upgrade => 'Foo::Bar';
3561
3562certain operations will 'upgrade' their calculation and thus the result to
3563the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
3564
3565 use Math::BigInt upgrade => 'Math::BigFloat';
3566
3567As a shortcut, you can use the module C<bignum>:
3568
3569 use bignum;
3570
3571Also good for oneliners:
3572
3573 perl -Mbignum -le 'print 2 ** 255'
3574
3575This makes it possible to mix arguments of different classes (as in 2.5 + 2)
3576as well es preserve accuracy (as in sqrt(3)).
3577
3578Beware: This feature is not fully implemented yet.
3579
3580=head2 Auto-upgrade
3581
3582The following methods upgrade themselves unconditionally; that is if upgrade
3583is in effect, they will always hand up their work:
3584
3585=over 2
3586
3587=item bsqrt()
3588
3589=item div()
3590
3591=item blog()
3592
3593=back
3594
3595Beware: This list is not complete.
3596
3597All other methods upgrade themselves only when one (or all) of their
3598arguments are of the class mentioned in $upgrade (This might change in later
3599versions to a more sophisticated scheme):
3600
a5f75d66
AD
3601=head1 BUGS
3602
58cde26e
JH
3603=over 2
3604
574bacfe 3605=item Out of Memory!
58cde26e
JH
3606
3607Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
3608C<eval()> in your code will crash with "Out of memory". This is probably an
3609overload/exporter bug. You can workaround by not having C<eval()>
574bacfe
JH
3610and ':constant' at the same time or upgrade your Perl to a newer version.
3611
3612=item Fails to load Calc on Perl prior 5.6.0
3613
3614Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
3615will fall back to eval { require ... } when loading the math lib on Perls
3616prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
3617filesystems using a different seperator.
58cde26e
JH
3618
3619=back
3620
3621=head1 CAVEATS
3622
3623Some things might not work as you expect them. Below is documented what is
3624known to be troublesome:
3625
3626=over 1
3627
3628=item stringify, bstr(), bsstr() and 'cmp'
3629
3630Both stringify and bstr() now drop the leading '+'. The old code would return
3631'+3', the new returns '3'. This is to be consistent with Perl and to make
3632cmp (especially with overloading) to work as you expect. It also solves
3633problems with Test.pm, it's ok() uses 'eq' internally.
3634
3635Mark said, when asked about to drop the '+' altogether, or make only cmp work:
3636
3637 I agree (with the first alternative), don't add the '+' on positive
3638 numbers. It's not as important anymore with the new internal
3639 form for numbers. It made doing things like abs and neg easier,
3640 but those have to be done differently now anyway.
3641
3642So, the following examples will now work all as expected:
3643
3644 use Test;
3645 BEGIN { plan tests => 1 }
3646 use Math::BigInt;
3647
3648 my $x = new Math::BigInt 3*3;
3649 my $y = new Math::BigInt 3*3;
3650
3651 ok ($x,3*3);
3652 print "$x eq 9" if $x eq $y;
3653 print "$x eq 9" if $x eq '9';
3654 print "$x eq 9" if $x eq 3*3;
3655
3656Additionally, the following still works:
3657
3658 print "$x == 9" if $x == $y;
3659 print "$x == 9" if $x == 9;
3660 print "$x == 9" if $x == 3*3;
3661
3662There is now a C<bsstr()> method to get the string in scientific notation aka
3663C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
3664for comparisation, but Perl will represent some numbers as 100 and others
3665as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
3666
3667 use Test;
3668 BEGIN { plan tests => 3 }
3669 use Math::BigInt;
3670
3671 $x = Math::BigInt->new('1e56'); $y = 1e56;
3672 ok ($x,$y); # will fail
3673 ok ($x->bsstr(),$y); # okay
3674 $y = Math::BigInt->new($y);
3675 ok ($x,$y); # okay
3676
394e6ffb
JH
3677Alternatively, simple use <=> for comparisations, that will get it always
3678right. There is not yet a way to get a number automatically represented as
3679a string that matches exactly the way Perl represents it.
574bacfe 3680
58cde26e
JH
3681=item int()
3682
3683C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
3684Perl scalar:
3685
3686 $x = Math::BigInt->new(123);
3687 $y = int($x); # BigInt 123
3688 $x = Math::BigFloat->new(123.45);
3689 $y = int($x); # BigInt 123
3690
3691In all Perl versions you can use C<as_number()> for the same effect:
3692
3693 $x = Math::BigFloat->new(123.45);
3694 $y = $x->as_number(); # BigInt 123
3695
3696This also works for other subclasses, like Math::String.
3697
574bacfe
JH
3698It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
3699
dccbb853 3700=item length
58cde26e
JH
3701
3702The following will probably not do what you expect:
3703
bd05a461
JH
3704 $c = Math::BigInt->new(123);
3705 print $c->length(),"\n"; # prints 30
3706
3707It prints both the number of digits in the number and in the fraction part
3708since print calls C<length()> in list context. Use something like:
3709
3710 print scalar $c->length(),"\n"; # prints 3
3711
3712=item bdiv
3713
3714The following will probably not do what you expect:
3715
58cde26e
JH
3716 print $c->bdiv(10000),"\n";
3717
dccbb853 3718It prints both quotient and remainder since print calls C<bdiv()> in list
58cde26e
JH
3719context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
3720to use
3721
3722 print $c / 10000,"\n";
3723 print scalar $c->bdiv(10000),"\n"; # or if you want to modify $c
3724
3725instead.
3726
3727The quotient is always the greatest integer less than or equal to the
3728real-valued quotient of the two operands, and the remainder (when it is
3729nonzero) always has the same sign as the second operand; so, for
3730example,
3731
dccbb853
JH
3732 1 / 4 => ( 0, 1)
3733 1 / -4 => (-1,-3)
3734 -3 / 4 => (-1, 1)
3735 -3 / -4 => ( 0,-3)
3736 -11 / 2 => (-5,1)
3737 11 /-2 => (-5,-1)
58cde26e
JH
3738
3739As a consequence, the behavior of the operator % agrees with the
3740behavior of Perl's built-in % operator (as documented in the perlop
3741manpage), and the equation
3742
3743 $x == ($x / $y) * $y + ($x % $y)
3744
3745holds true for any $x and $y, which justifies calling the two return
dccbb853
JH
3746values of bdiv() the quotient and remainder. The only exception to this rule
3747are when $y == 0 and $x is negative, then the remainder will also be
3748negative. See below under "infinity handling" for the reasoning behing this.
58cde26e
JH
3749
3750Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
3751not change BigInt's way to do things. This is because under 'use integer' Perl
3752will do what the underlying C thinks is right and this is different for each
3753system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
3754the author to implement it ;)
3755
dccbb853
JH
3756=item infinity handling
3757
3758Here are some examples that explain the reasons why certain results occur while
3759handling infinity:
3760
3761The following table shows the result of the division and the remainder, so that
3762the equation above holds true. Some "ordinary" cases are strewn in to show more
3763clearly the reasoning:
3764
3765 A / B = C, R so that C * B + R = A
3766 =========================================================
3767 5 / 8 = 0, 5 0 * 8 + 5 = 5
3768 0 / 8 = 0, 0 0 * 8 + 0 = 0
3769 0 / inf = 0, 0 0 * inf + 0 = 0
3770 0 /-inf = 0, 0 0 * -inf + 0 = 0
3771 5 / inf = 0, 5 0 * inf + 5 = 5
3772 5 /-inf = 0, 5 0 * -inf + 5 = 5
3773 -5/ inf = 0, -5 0 * inf + -5 = -5
3774 -5/-inf = 0, -5 0 * -inf + -5 = -5
3775 inf/ 5 = inf, 0 inf * 5 + 0 = inf
3776 -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
3777 inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
3778 -inf/ -5 = inf, 0 inf * -5 + 0 = -inf
3779 5/ 5 = 1, 0 1 * 5 + 0 = 5
3780 -5/ -5 = 1, 0 1 * -5 + 0 = -5
3781 inf/ inf = 1, 0 1 * inf + 0 = inf
3782 -inf/-inf = 1, 0 1 * -inf + 0 = -inf
3783 inf/-inf = -1, 0 -1 * -inf + 0 = inf
3784 -inf/ inf = -1, 0 1 * -inf + 0 = -inf
3785 8/ 0 = inf, 8 inf * 0 + 8 = 8
3786 inf/ 0 = inf, inf inf * 0 + inf = inf
3787 0/ 0 = NaN
3788
3789These cases below violate the "remainder has the sign of the second of the two
3790arguments", since they wouldn't match up otherwise.
3791
3792 A / B = C, R so that C * B + R = A
3793 ========================================================
3794 -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
3795 -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
3796
58cde26e
JH
3797=item Modifying and =
3798
3799Beware of:
3800
3801 $x = Math::BigFloat->new(5);
3802 $y = $x;
3803
3804It will not do what you think, e.g. making a copy of $x. Instead it just makes
3805a second reference to the B<same> object and stores it in $y. Thus anything
17baacb7
JH
3806that modifies $x (except overloaded operators) will modify $y, and vice versa.
3807Or in other words, C<=> is only safe if you modify your BigInts only via
3808overloaded math. As soon as you use a method call it breaks:
58cde26e
JH
3809
3810 $x->bmul(2);
3811 print "$x, $y\n"; # prints '10, 10'
3812
3813If you want a true copy of $x, use:
3814
3815 $y = $x->copy();
3816
17baacb7
JH
3817You can also chain the calls like this, this will make first a copy and then
3818multiply it by 2:
3819
3820 $y = $x->copy()->bmul(2);
3821
b22b3e31 3822See also the documentation for overload.pm regarding C<=>.
58cde26e
JH
3823
3824=item bpow
3825
3826C<bpow()> (and the rounding functions) now modifies the first argument and
574bacfe 3827returns it, unlike the old code which left it alone and only returned the
58cde26e
JH
3828result. This is to be consistent with C<badd()> etc. The first three will
3829modify $x, the last one won't:
3830
3831 print bpow($x,$i),"\n"; # modify $x
3832 print $x->bpow($i),"\n"; # ditto
3833 print $x **= $i,"\n"; # the same
3834 print $x ** $i,"\n"; # leave $x alone
3835
3836The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
3837
3838=item Overloading -$x
3839
3840The following:
3841
3842 $x = -$x;
3843
3844is slower than
3845
3846 $x->bneg();
3847
3848since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
3849needs to preserve $x since it does not know that it later will get overwritten.
0716bf9b 3850This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
58cde26e 3851
394e6ffb
JH
3852With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
3853since it is slower for all other things.
58cde26e
JH
3854
3855=item Mixing different object types
3856
3857In Perl you will get a floating point value if you do one of the following:
3858
3859 $float = 5.0 + 2;
3860 $float = 2 + 5.0;
3861 $float = 5 / 2;
3862
3863With overloaded math, only the first two variants will result in a BigFloat:
3864
3865 use Math::BigInt;
3866 use Math::BigFloat;
3867
3868 $mbf = Math::BigFloat->new(5);
3869 $mbi2 = Math::BigInteger->new(5);
3870 $mbi = Math::BigInteger->new(2);
3871
3872 # what actually gets called:
3873 $float = $mbf + $mbi; # $mbf->badd()
3874 $float = $mbf / $mbi; # $mbf->bdiv()
3875 $integer = $mbi + $mbf; # $mbi->badd()
3876 $integer = $mbi2 / $mbi; # $mbi2->bdiv()
3877 $integer = $mbi2 / $mbf; # $mbi2->bdiv()
3878
3879This is because math with overloaded operators follows the first (dominating)
394e6ffb 3880operand, and the operation of that is called and returns thus the result. So,
58cde26e
JH
3881Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
3882the result should be a Math::BigFloat or the second operant is one.
3883
3884To get a Math::BigFloat you either need to call the operation manually,
3885make sure the operands are already of the proper type or casted to that type
3886via Math::BigFloat->new():
3887
3888 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
3889
3890Beware of simple "casting" the entire expression, this would only convert
3891the already computed result:
3892
3893 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
3894
0716bf9b 3895Beware also of the order of more complicated expressions like:
58cde26e
JH
3896
3897 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
3898 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
3899
3900If in doubt, break the expression into simpler terms, or cast all operands
3901to the desired resulting type.
3902
3903Scalar values are a bit different, since:
3904
3905 $float = 2 + $mbf;
3906 $float = $mbf + 2;
3907
3908will both result in the proper type due to the way the overloaded math works.
3909
3910This section also applies to other overloaded math packages, like Math::String.
3911
b3abae2a
JH
3912One solution to you problem might be L<autoupgrading|upgrading>.
3913
58cde26e
JH
3914=item bsqrt()
3915
394e6ffb 3916C<bsqrt()> works only good if the result is a big integer, e.g. the square
58cde26e
JH
3917root of 144 is 12, but from 12 the square root is 3, regardless of rounding
3918mode.
3919
3920If you want a better approximation of the square root, then use:
3921
3922 $x = Math::BigFloat->new(12);
394e6ffb 3923 Math::BigFloat->precision(0);
58cde26e
JH
3924 Math::BigFloat->round_mode('even');
3925 print $x->copy->bsqrt(),"\n"; # 4
3926
394e6ffb 3927 Math::BigFloat->precision(2);
58cde26e
JH
3928 print $x->bsqrt(),"\n"; # 3.46
3929 print $x->bsqrt(3),"\n"; # 3.464
3930
b3abae2a
JH
3931=item brsft()
3932
3933For negative numbers in base see also L<brsft|brsft>.
3934
58cde26e
JH
3935=back
3936
3937=head1 LICENSE
3938
3939This program is free software; you may redistribute it and/or modify it under
3940the same terms as Perl itself.
a5f75d66 3941
0716bf9b
JH
3942=head1 SEE ALSO
3943
027dc388
JH
3944L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
3945L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
0716bf9b 3946
027dc388
JH
3947The package at
3948L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
3949more documentation including a full version history, testcases, empty
3950subclass files and benchmarks.
574bacfe 3951
58cde26e 3952=head1 AUTHORS
a5f75d66 3953
58cde26e
JH
3954Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
3955Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
a5f75d66
AD
3956
3957=cut