This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: FreeBSD 4.6 imminent
[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
1ddff52a 21$VERSION = '1.59';
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 }
58cde26e 527 $self->{sign} = $nan;
394e6ffb 528 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
58cde26e 529 return $self;
b4f14daa 530 }
58cde26e
JH
531
532sub binf
533 {
534 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
535 # the sign is either '+', or if given, used from there
536 my $self = shift;
56b9c951 537 my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
58cde26e
JH
538 $self = $class if !defined $self;
539 if (!ref($self))
540 {
541 my $c = $self; $self = {}; bless $self, $c;
542 }
61f5c3f5 543 $self->import() if $IMPORT == 0; # make require work
58cde26e 544 return if $self->modify('binf');
13a12e00
JH
545 my $c = ref($self);
546 if ($self->can('_binf'))
547 {
548 # use subclass to initialize
549 $self->_binf();
550 }
551 else
552 {
553 # otherwise do our own thing
554 $self->{value} = $CALC->_zero();
555 }
56b9c951
JH
556 $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
557 $self->{sign} = $sign;
394e6ffb 558 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
58cde26e
JH
559 return $self;
560 }
561
562sub bzero
563 {
564 # create a bigint '+0', if given a BigInt, set it to 0
565 my $self = shift;
566 $self = $class if !defined $self;
0716bf9b 567
58cde26e
JH
568 if (!ref($self))
569 {
570 my $c = $self; $self = {}; bless $self, $c;
571 }
61f5c3f5 572 $self->import() if $IMPORT == 0; # make require work
58cde26e 573 return if $self->modify('bzero');
13a12e00
JH
574
575 if ($self->can('_bzero'))
576 {
577 # use subclass to initialize
578 $self->_bzero();
579 }
580 else
581 {
582 # otherwise do our own thing
583 $self->{value} = $CALC->_zero();
584 }
58cde26e 585 $self->{sign} = '+';
61f5c3f5
T
586 if (@_ > 0)
587 {
588 $self->{_a} = $_[0]
589 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
590 $self->{_p} = $_[1]
591 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
592 }
58cde26e
JH
593 return $self;
594 }
595
574bacfe
JH
596sub bone
597 {
598 # create a bigint '+1' (or -1 if given sign '-'),
599 # if given a BigInt, set it to +1 or -1, respecively
600 my $self = shift;
601 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
602 $self = $class if !defined $self;
394e6ffb 603
574bacfe
JH
604 if (!ref($self))
605 {
606 my $c = $self; $self = {}; bless $self, $c;
607 }
61f5c3f5 608 $self->import() if $IMPORT == 0; # make require work
574bacfe 609 return if $self->modify('bone');
13a12e00
JH
610
611 if ($self->can('_bone'))
612 {
613 # use subclass to initialize
614 $self->_bone();
615 }
616 else
617 {
618 # otherwise do our own thing
619 $self->{value} = $CALC->_one();
620 }
574bacfe 621 $self->{sign} = $sign;
61f5c3f5
T
622 if (@_ > 0)
623 {
624 $self->{_a} = $_[0]
625 if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
626 $self->{_p} = $_[1]
627 if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
628 }
574bacfe
JH
629 return $self;
630 }
631
58cde26e
JH
632##############################################################################
633# string conversation
634
635sub bsstr
636 {
637 # (ref to BFLOAT or num_str ) return num_str
638 # Convert number from internal format to scientific string format.
639 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
dccbb853
JH
640 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
641 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 642
574bacfe
JH
643 if ($x->{sign} !~ /^[+-]$/)
644 {
645 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
646 return 'inf'; # +inf
647 }
58cde26e 648 my ($m,$e) = $x->parts();
574bacfe 649 # e can only be positive
58cde26e
JH
650 my $sign = 'e+';
651 # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
652 return $m->bstr().$sign.$e->bstr();
653 }
654
655sub bstr
656 {
0716bf9b 657 # make a string from bigint object
ee15d750
JH
658 my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
659 # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
56b9c951 660
574bacfe
JH
661 if ($x->{sign} !~ /^[+-]$/)
662 {
663 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
664 return 'inf'; # +inf
665 }
0716bf9b
JH
666 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
667 return $es.${$CALC->_str($x->{value})};
58cde26e
JH
668 }
669
670sub numify
671 {
394e6ffb 672 # Make a "normal" scalar from a BigInt object
58cde26e 673 my $x = shift; $x = $class->new($x) unless ref $x;
0716bf9b
JH
674 return $x->{sign} if $x->{sign} !~ /^[+-]$/;
675 my $num = $CALC->_num($x->{value});
676 return -$num if $x->{sign} eq '-';
9393ace2 677 $num;
58cde26e
JH
678 }
679
680##############################################################################
681# public stuff (usually prefixed with "b")
682
683sub sign
684 {
9393ace2 685 # return the sign of the number: +/-/-inf/+inf/NaN
ee15d750
JH
686 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
687
9393ace2 688 $x->{sign};
58cde26e
JH
689 }
690
ee15d750 691sub _find_round_parameters
58cde26e
JH
692 {
693 # After any operation or when calling round(), the result is rounded by
694 # regarding the A & P from arguments, local parameters, or globals.
61f5c3f5
T
695
696 # This procedure finds the round parameters, but it is for speed reasons
697 # duplicated in round. Otherwise, it is tested by the testsuite and used
698 # by fdiv().
699
394e6ffb
JH
700 my ($self,$a,$p,$r,@args) = @_;
701 # $a accuracy, if given by caller
702 # $p precision, if given by caller
703 # $r round_mode, if given by caller
704 # @args all 'other' arguments (0 for unary, 1 for binary ops)
58cde26e 705
17baacb7 706 # leave bigfloat parts alone
ee15d750 707 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
17baacb7 708
394e6ffb 709 my $c = ref($self); # find out class of argument(s)
574bacfe 710 no strict 'refs';
574bacfe 711
58cde26e 712 # now pick $a or $p, but only if we have got "arguments"
61f5c3f5 713 if (!defined $a)
58cde26e 714 {
61f5c3f5 715 foreach ($self,@args)
58cde26e
JH
716 {
717 # take the defined one, or if both defined, the one that is smaller
718 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
719 }
61f5c3f5
T
720 }
721 if (!defined $p)
ee15d750 722 {
61f5c3f5
T
723 # even if $a is defined, take $p, to signal error for both defined
724 foreach ($self,@args)
725 {
726 # take the defined one, or if both defined, the one that is bigger
727 # -2 > -3, and 3 > 2
728 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
729 }
ee15d750 730 }
61f5c3f5
T
731 # if still none defined, use globals (#2)
732 $a = ${"$c\::accuracy"} unless defined $a;
733 $p = ${"$c\::precision"} unless defined $p;
734
735 # no rounding today?
736 return ($self) unless defined $a || defined $p; # early out
737
738 # set A and set P is an fatal error
739 return ($self->bnan()) if defined $a && defined $p;
740
741 $r = ${"$c\::round_mode"} unless defined $r;
742 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
743
744 return ($self,$a,$p,$r);
ee15d750
JH
745 }
746
747sub round
748 {
61f5c3f5 749 # Round $self according to given parameters, or given second argument's
ee15d750 750 # parameters or global defaults
ee15d750 751
61f5c3f5
T
752 # for speed reasons, _find_round_parameters is embeded here:
753
754 my ($self,$a,$p,$r,@args) = @_;
755 # $a accuracy, if given by caller
756 # $p precision, if given by caller
757 # $r round_mode, if given by caller
758 # @args all 'other' arguments (0 for unary, 1 for binary ops)
759
760 # leave bigfloat parts alone
761 return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
762
763 my $c = ref($self); # find out class of argument(s)
764 no strict 'refs';
765
766 # now pick $a or $p, but only if we have got "arguments"
767 if (!defined $a)
58cde26e 768 {
61f5c3f5
T
769 foreach ($self,@args)
770 {
771 # take the defined one, or if both defined, the one that is smaller
772 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
773 }
58cde26e 774 }
61f5c3f5
T
775 if (!defined $p)
776 {
777 # even if $a is defined, take $p, to signal error for both defined
778 foreach ($self,@args)
779 {
780 # take the defined one, or if both defined, the one that is bigger
781 # -2 > -3, and 3 > 2
782 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
783 }
784 }
785 # if still none defined, use globals (#2)
786 $a = ${"$c\::accuracy"} unless defined $a;
787 $p = ${"$c\::precision"} unless defined $p;
788
789 # no rounding today?
790 return $self unless defined $a || defined $p; # early out
791
792 # set A and set P is an fatal error
793 return $self->bnan() if defined $a && defined $p;
794
795 $r = ${"$c\::round_mode"} unless defined $r;
796 die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
797
798 # now round, by calling either fround or ffround:
799 if (defined $a)
800 {
801 $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
802 }
803 else # both can't be undefined due to early out
58cde26e 804 {
61f5c3f5 805 $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
58cde26e 806 }
61f5c3f5 807 $self->bnorm(); # after round, normalize
58cde26e
JH
808 }
809
17baacb7 810sub bnorm
58cde26e 811 {
027dc388 812 # (numstr or BINT) return BINT
58cde26e 813 # Normalize number -- no-op here
dccbb853 814 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
b3abae2a 815 $x;
58cde26e
JH
816 }
817
818sub babs
819 {
820 # (BINT or num_str) return BINT
821 # make number absolute, or return absolute BINT from string
ee15d750
JH
822 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
823
58cde26e
JH
824 return $x if $x->modify('babs');
825 # post-normalized abs for internal use (does nothing for NaN)
826 $x->{sign} =~ s/^-/+/;
827 $x;
828 }
829
830sub bneg
831 {
832 # (BINT or num_str) return BINT
833 # negate number or make a negated number from string
ee15d750
JH
834 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
835
58cde26e 836 return $x if $x->modify('bneg');
b3abae2a 837
58cde26e 838 # for +0 dont negate (to have always normalized)
b3abae2a 839 $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
58cde26e
JH
840 $x;
841 }
842
843sub bcmp
844 {
845 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
846 # (BINT or num_str, BINT or num_str) return cond_code
847 my ($self,$x,$y) = objectify(2,@_);
0716bf9b
JH
848
849 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
850 {
851 # handle +-inf and NaN
852 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
574bacfe 853 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
0716bf9b
JH
854 return +1 if $x->{sign} eq '+inf';
855 return -1 if $x->{sign} eq '-inf';
856 return -1 if $y->{sign} eq '+inf';
b3abae2a 857 return +1;
0716bf9b 858 }
574bacfe
JH
859 # check sign for speed first
860 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
861 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
862
863 # shortcut
864 my $xz = $x->is_zero();
865 my $yz = $y->is_zero();
866 return 0 if $xz && $yz; # 0 <=> 0
867 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
868 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
dccbb853
JH
869
870 # post-normalized compare for internal use (honors signs)
871 if ($x->{sign} eq '+')
872 {
56b9c951 873 # $x and $y both > 0
dccbb853
JH
874 return $CALC->_acmp($x->{value},$y->{value});
875 }
876
56b9c951 877 # $x && $y both < 0
b3abae2a 878 $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
58cde26e
JH
879 }
880
881sub bacmp
882 {
883 # Compares 2 values, ignoring their signs.
884 # Returns one of undef, <0, =0, >0. (suitable for sort)
885 # (BINT, BINT) return cond_code
886 my ($self,$x,$y) = objectify(2,@_);
574bacfe
JH
887
888 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
889 {
890 # handle +-inf and NaN
891 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
892 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
893 return +1; # inf is always bigger
894 }
b3abae2a 895 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
58cde26e
JH
896 }
897
898sub badd
899 {
900 # add second arg (BINT or string) to first (BINT) (modifies first)
901 # return result as BINT
61f5c3f5 902 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
903
904 return $x if $x->modify('badd');
56b9c951 905 return $upgrade->badd($x,$y,@r) if defined $upgrade &&
8f675a64 906 ((!$x->isa($self)) || (!$y->isa($self)));
58cde26e 907
61f5c3f5 908 $r[3] = $y; # no push!
574bacfe
JH
909 # inf and NaN handling
910 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
911 {
912 # NaN first
913 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
13a12e00
JH
914 # inf handling
915 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
574bacfe 916 {
b3abae2a
JH
917 # +inf++inf or -inf+-inf => same, rest is NaN
918 return $x if $x->{sign} eq $y->{sign};
919 return $x->bnan();
574bacfe
JH
920 }
921 # +-inf + something => +inf
922 # something +-inf => +-inf
923 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
924 return $x;
925 }
926
58cde26e
JH
927 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
928
929 if ($sx eq $sy)
930 {
574bacfe 931 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
58cde26e
JH
932 $x->{sign} = $sx;
933 }
934 else
935 {
574bacfe 936 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
58cde26e
JH
937 if ($a > 0)
938 {
939 #print "swapped sub (a=$a)\n";
574bacfe 940 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
58cde26e
JH
941 $x->{sign} = $sy;
942 }
943 elsif ($a == 0)
944 {
945 # speedup, if equal, set result to 0
0716bf9b
JH
946 #print "equal sub, result = 0\n";
947 $x->{value} = $CALC->_zero();
58cde26e
JH
948 $x->{sign} = '+';
949 }
950 else # a < 0
951 {
952 #print "unswapped sub (a=$a)\n";
574bacfe 953 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
58cde26e 954 $x->{sign} = $sx;
a0d0e21e 955 }
a0d0e21e 956 }
61f5c3f5 957 $x->round(@r);
58cde26e
JH
958 }
959
960sub bsub
961 {
962 # (BINT or num_str, BINT or num_str) return num_str
963 # subtract second arg from first, modify first
b3abae2a 964 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e 965
58cde26e 966 return $x if $x->modify('bsub');
8f675a64
JH
967
968# upgrade done by badd():
b3abae2a 969# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
8f675a64 970# ((!$x->isa($self)) || (!$y->isa($self)));
b3abae2a
JH
971
972 if ($y->is_zero())
973 {
974 return $x->round(@r);
e745a66c 975 }
b3abae2a
JH
976
977 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
978 $x->badd($y,@r); # badd does not leave internal zeros
979 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
61f5c3f5 980 $x; # already rounded by badd() or no round necc.
58cde26e
JH
981 }
982
983sub binc
984 {
985 # increment arg by one
ee15d750 986 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 987 return $x if $x->modify('binc');
e745a66c
JH
988
989 if ($x->{sign} eq '+')
990 {
991 $x->{value} = $CALC->_inc($x->{value});
992 return $x->round($a,$p,$r);
993 }
994 elsif ($x->{sign} eq '-')
995 {
996 $x->{value} = $CALC->_dec($x->{value});
997 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
998 return $x->round($a,$p,$r);
999 }
1000 # inf, nan handling etc
61f5c3f5 1001 $x->badd($self->__one(),$a,$p,$r); # badd does round
58cde26e
JH
1002 }
1003
1004sub bdec
1005 {
1006 # decrement arg by one
ee15d750 1007 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1008 return $x if $x->modify('bdec');
e745a66c
JH
1009
1010 my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+';
1011 # <= 0
1012 if (($x->{sign} eq '-') || $zero)
1013 {
1014 $x->{value} = $CALC->_inc($x->{value});
1015 $x->{sign} = '-' if $zero; # 0 => 1 => -1
1016 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
1017 return $x->round($a,$p,$r);
1018 }
1019 # > 0
1020 elsif ($x->{sign} eq '+')
1021 {
1022 $x->{value} = $CALC->_dec($x->{value});
1023 return $x->round($a,$p,$r);
1024 }
1025 # inf, nan handling etc
61f5c3f5 1026 $x->badd($self->__one('-'),$a,$p,$r); # badd does round
58cde26e
JH
1027 }
1028
61f5c3f5
T
1029sub blog
1030 {
1031 # not implemented yet
b3abae2a 1032 my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
61f5c3f5 1033
b3abae2a
JH
1034 return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
1035
61f5c3f5
T
1036 return $x->bnan();
1037 }
1038
58cde26e
JH
1039sub blcm
1040 {
1041 # (BINT or num_str, BINT or num_str) return BINT
1042 # does not modify arguments, but returns new object
1043 # Lowest Common Multiplicator
58cde26e 1044
0716bf9b
JH
1045 my $y = shift; my ($x);
1046 if (ref($y))
1047 {
1048 $x = $y->copy();
1049 }
1050 else
1051 {
1052 $x = $class->new($y);
1053 }
dccbb853 1054 while (@_) { $x = __lcm($x,shift); }
58cde26e
JH
1055 $x;
1056 }
1057
1058sub bgcd
1059 {
1060 # (BINT or num_str, BINT or num_str) return BINT
1061 # does not modify arguments, but returns new object
1062 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
0716bf9b 1063
dccbb853
JH
1064 my $y = shift;
1065 $y = __PACKAGE__->new($y) if !ref($y);
1066 my $self = ref($y);
1067 my $x = $y->copy(); # keep arguments
0716bf9b
JH
1068 if ($CALC->can('_gcd'))
1069 {
1070 while (@_)
1071 {
dccbb853 1072 $y = shift; $y = $self->new($y) if !ref($y);
0716bf9b
JH
1073 next if $y->is_zero();
1074 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
1075 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
1076 }
1077 }
1078 else
1079 {
1080 while (@_)
1081 {
dccbb853
JH
1082 $y = shift; $y = $self->new($y) if !ref($y);
1083 $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
0716bf9b
JH
1084 }
1085 }
1086 $x->babs();
58cde26e
JH
1087 }
1088
58cde26e
JH
1089sub bnot
1090 {
1091 # (num_str or BINT) return BINT
1092 # represent ~x as twos-complement number
ee15d750
JH
1093 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1094 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1095
58cde26e 1096 return $x if $x->modify('bnot');
61f5c3f5 1097 $x->bneg()->bdec(); # bdec already does round
58cde26e
JH
1098 }
1099
b3abae2a
JH
1100# is_foo test routines
1101
58cde26e
JH
1102sub is_zero
1103 {
1104 # return true if arg (BINT or num_str) is zero (array '+', '0')
ee15d750
JH
1105 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1106 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1107
574bacfe 1108 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
17baacb7 1109 $CALC->_is_zero($x->{value});
58cde26e
JH
1110 }
1111
1112sub is_nan
1113 {
1114 # return true if arg (BINT or num_str) is NaN
ee15d750
JH
1115 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1116
1117 return 1 if $x->{sign} eq $nan;
28df3e88 1118 0;
58cde26e
JH
1119 }
1120
1121sub is_inf
1122 {
1123 # return true if arg (BINT or num_str) is +-inf
ee15d750
JH
1124 my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1125
1126 $sign = '' if !defined $sign;
9393ace2 1127 return 1 if $sign eq $x->{sign}; # match ("+inf" eq "+inf")
ee15d750 1128 return 0 if $sign !~ /^([+-]|)$/;
58cde26e 1129
ee15d750
JH
1130 if ($sign eq '')
1131 {
1132 return 1 if ($x->{sign} =~ /^[+-]inf$/);
1133 return 0;
1134 }
1135 $sign = quotemeta($sign.'inf');
1136 return 1 if ($x->{sign} =~ /^$sign$/);
28df3e88 1137 0;
58cde26e
JH
1138 }
1139
1140sub is_one
1141 {
b22b3e31
PN
1142 # return true if arg (BINT or num_str) is +1
1143 # or -1 if sign is given
ee15d750
JH
1144 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1145 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1146
1147 $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
0716bf9b 1148
ee15d750 1149 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
394e6ffb 1150 $CALC->_is_one($x->{value});
58cde26e
JH
1151 }
1152
1153sub is_odd
1154 {
1155 # return true when arg (BINT or num_str) is odd, false for even
ee15d750
JH
1156 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1157 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1158
b22b3e31 1159 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1160 $CALC->_is_odd($x->{value});
58cde26e
JH
1161 }
1162
1163sub is_even
1164 {
1165 # return true when arg (BINT or num_str) is even, false for odd
ee15d750
JH
1166 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1167 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1168
b22b3e31 1169 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1170 $CALC->_is_even($x->{value});
0716bf9b
JH
1171 }
1172
1173sub is_positive
1174 {
1175 # return true when arg (BINT or num_str) is positive (>= 0)
ee15d750
JH
1176 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1177 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1178
1179 return 1 if $x->{sign} =~ /^\+/;
394e6ffb 1180 0;
0716bf9b
JH
1181 }
1182
1183sub is_negative
1184 {
1185 # return true when arg (BINT or num_str) is negative (< 0)
ee15d750
JH
1186 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1187 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1188
1189 return 1 if ($x->{sign} =~ /^-/);
394e6ffb 1190 0;
58cde26e
JH
1191 }
1192
b3abae2a
JH
1193sub is_int
1194 {
1195 # return true when arg (BINT or num_str) is an integer
1196 # always true for BigInt, but different for Floats
1197 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1198 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1199
1200 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1201 }
1202
0716bf9b
JH
1203###############################################################################
1204
58cde26e
JH
1205sub bmul
1206 {
1207 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
1208 # (BINT or num_str, BINT or num_str) return BINT
61f5c3f5 1209 my ($self,$x,$y,@r) = objectify(2,@_);
0716bf9b 1210
58cde26e 1211 return $x if $x->modify('bmul');
61f5c3f5 1212
574bacfe 1213 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
b3abae2a 1214
574bacfe
JH
1215 # inf handling
1216 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1217 {
b3abae2a 1218 return $x->bnan() if $x->is_zero() || $y->is_zero();
574bacfe
JH
1219 # result will always be +-inf:
1220 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1221 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1222 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1223 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1224 return $x->binf('-');
1225 }
9393ace2
JH
1226
1227 return $upgrade->bmul($x,$y,@r)
1228 if defined $upgrade && $y->isa($upgrade);
1229
1230 $r[3] = $y; # no push here
58cde26e 1231
0716bf9b 1232 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
dccbb853 1233
b3abae2a
JH
1234 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1235 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1236 $x->round(@r);
dccbb853
JH
1237 }
1238
1239sub _div_inf
1240 {
1241 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1242 my ($self,$x,$y) = @_;
1243
1244 # NaN if x == NaN or y == NaN or x==y==0
1245 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1246 if (($x->is_nan() || $y->is_nan()) ||
1247 ($x->is_zero() && $y->is_zero()));
1248
b3abae2a
JH
1249 # +-inf / +-inf == NaN, reminder also NaN
1250 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
dccbb853 1251 {
b3abae2a 1252 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
dccbb853
JH
1253 }
1254 # x / +-inf => 0, remainder x (works even if x == 0)
1255 if ($y->{sign} =~ /^[+-]inf$/)
1256 {
1257 my $t = $x->copy(); # binf clobbers up $x
1258 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1259 }
1260
1261 # 5 / 0 => +inf, -6 / 0 => -inf
1262 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1263 # exception: -8 / 0 has remainder -8, not 8
1264 # exception: -inf / 0 has remainder -inf, not inf
1265 if ($y->is_zero())
1266 {
1267 # +-inf / 0 => special case for -inf
1268 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1269 if (!$x->is_zero() && !$x->is_inf())
1270 {
1271 my $t = $x->copy(); # binf clobbers up $x
1272 return wantarray ?
1273 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1274 }
1275 }
1276
1277 # last case: +-inf / ordinary number
1278 my $sign = '+inf';
1279 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1280 $x->{sign} = $sign;
1281 return wantarray ? ($x,$self->bzero()) : $x;
58cde26e
JH
1282 }
1283
1284sub bdiv
1285 {
1286 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1287 # (BINT,BINT) (quo,rem) or BINT (only rem)
61f5c3f5 1288 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
1289
1290 return $x if $x->modify('bdiv');
1291
dccbb853
JH
1292 return $self->_div_inf($x,$y)
1293 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
58cde26e 1294
d614cd8b 1295 #print "mbi bdiv $x $y\n";
9393ace2 1296 return $upgrade->bdiv($upgrade->new($x),$y,@r)
8f675a64 1297 if defined $upgrade && !$y->isa($self);
9393ace2 1298
61f5c3f5
T
1299 $r[3] = $y; # no push!
1300
58cde26e 1301 # 0 / something
61f5c3f5
T
1302 return
1303 wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
58cde26e 1304
b3abae2a 1305 # Is $x in the interval [0, $y) (aka $x <= $y) ?
0716bf9b 1306 my $cmp = $CALC->_acmp($x->{value},$y->{value});
b3abae2a 1307 if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
58cde26e 1308 {
9393ace2
JH
1309 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1310 if defined $upgrade;
b3abae2a 1311
61f5c3f5 1312 return $x->bzero()->round(@r) unless wantarray;
58cde26e 1313 my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
61f5c3f5 1314 return ($x->bzero()->round(@r),$t);
58cde26e
JH
1315 }
1316 elsif ($cmp == 0)
1317 {
1318 # shortcut, both are the same, so set to +/- 1
574bacfe 1319 $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
58cde26e 1320 return $x unless wantarray;
61f5c3f5 1321 return ($x->round(@r),$self->bzero(@r));
58cde26e 1322 }
9393ace2
JH
1323 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1324 if defined $upgrade;
58cde26e
JH
1325
1326 # calc new sign and in case $y == +/- 1, return $x
dccbb853 1327 my $xsign = $x->{sign}; # keep
58cde26e
JH
1328 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
1329 # check for / +-1 (cant use $y->is_one due to '-'
394e6ffb 1330 if ($CALC->_is_one($y->{value}))
58cde26e 1331 {
61f5c3f5 1332 return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
58cde26e
JH
1333 }
1334
58cde26e
JH
1335 if (wantarray)
1336 {
394e6ffb
JH
1337 my $rem = $self->bzero();
1338 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1339 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
61f5c3f5 1340 $x->round(@r);
dccbb853
JH
1341 if (! $CALC->_is_zero($rem->{value}))
1342 {
1343 $rem->{sign} = $y->{sign};
1344 $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
1345 }
1346 else
1347 {
1348 $rem->{sign} = '+'; # dont leave -0
1349 }
61f5c3f5 1350 $rem->round(@r);
58cde26e
JH
1351 return ($x,$rem);
1352 }
394e6ffb
JH
1353
1354 $x->{value} = $CALC->_div($x->{value},$y->{value});
1355 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
61f5c3f5 1356 $x->round(@r);
58cde26e
JH
1357 }
1358
d614cd8b
JH
1359###############################################################################
1360# modulus functions
1361
dccbb853
JH
1362sub bmod
1363 {
1364 # modulus (or remainder)
1365 # (BINT or num_str, BINT or num_str) return BINT
61f5c3f5 1366 my ($self,$x,$y,@r) = objectify(2,@_);
28df3e88 1367
dccbb853 1368 return $x if $x->modify('bmod');
61f5c3f5 1369 $r[3] = $y; # no push!
dccbb853
JH
1370 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1371 {
1372 my ($d,$r) = $self->_div_inf($x,$y);
61f5c3f5 1373 return $r->round(@r);
dccbb853
JH
1374 }
1375
1376 if ($CALC->can('_mod'))
1377 {
1378 # calc new sign and in case $y == +/- 1, return $x
1379 $x->{value} = $CALC->_mod($x->{value},$y->{value});
dccbb853
JH
1380 if (!$CALC->_is_zero($x->{value}))
1381 {
b3abae2a 1382 my $xsign = $x->{sign};
dccbb853 1383 $x->{sign} = $y->{sign};
07d34614
T
1384 if ($xsign ne $y->{sign})
1385 {
1386 my $t = [ @{$x->{value}} ]; # copy $x
1387 $x->{value} = [ @{$y->{value}} ]; # copy $y to $x
1388 $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
1389 }
dccbb853
JH
1390 }
1391 else
1392 {
1393 $x->{sign} = '+'; # dont leave -0
1394 }
61f5c3f5 1395 return $x->round(@r);
dccbb853 1396 }
b3abae2a
JH
1397 my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
1398 # modify in place
1399 foreach (qw/value sign _a _p/)
1400 {
1401 $x->{$_} = $rem->{$_};
1402 }
1403 $x;
dccbb853
JH
1404 }
1405
07d34614 1406sub bmodinv
d614cd8b
JH
1407 {
1408 # modular inverse. given a number which is (hopefully) relatively
1409 # prime to the modulus, calculate its inverse using Euclid's
1410 # alogrithm. if the number is not relatively prime to the modulus
1411 # (i.e. their gcd is not one) then NaN is returned.
1412
1413 my ($self,$num,$mod,@r) = objectify(2,@_);
1414
1415 return $num if $num->modify('bmodinv');
1416
1417 return $num->bnan()
1418 if ($mod->{sign} ne '+' # -, NaN, +inf, -inf
1419 || $num->is_zero() # or num == 0
1420 || $num->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
1421 );
1ddff52a
JH
1422
1423 # put least residue into $num if $num was negative, and thus make it positive
1424 $num->bmod($mod) if $num->{sign} eq '-';
07d34614
T
1425
1426 if ($CALC->can('_modinv'))
1427 {
1ddff52a
JH
1428 $num->{value} = $CALC->_modinv($num->{value},$mod->{value});
1429 $num->bnan() if !defined $num->{value} ; # in case there was no
07d34614
T
1430 return $num;
1431 }
d614cd8b 1432
d614cd8b
JH
1433 my ($u, $u1) = ($self->bzero(), $self->bone());
1434 my ($a, $b) = ($mod->copy(), $num->copy());
1435
1ddff52a
JH
1436 # first step need always be done since $num (and thus $b) is never 0
1437 # Note that the loop is aligned so that the check occurs between #2 and #1
1438 # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
1439 # a case with 28 loops still gains about 3% with this layout.
1440 my $q;
1441 ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
07d34614
T
1442 # Euclid's Algorithm
1443 while (!$b->is_zero())
1444 {
1ddff52a
JH
1445 ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
1446 ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
d614cd8b
JH
1447 }
1448
07d34614 1449 # if the gcd is not 1, then return NaN! It would be pointless to
1ddff52a
JH
1450 # have called bgcd to check this first, because we would then be performing
1451 # the same Euclidean Algorithm *twice*
07d34614 1452 return $num->bnan() unless $a->is_one();
d614cd8b 1453
1ddff52a
JH
1454 $u1->bmod($mod);
1455 $num->{value} = $u1->{value};
1456 $num->{sign} = $u1->{sign};
07d34614 1457 $num;
d614cd8b
JH
1458 }
1459
07d34614 1460sub bmodpow
d614cd8b
JH
1461 {
1462 # takes a very large number to a very large exponent in a given very
1463 # large modulus, quickly, thanks to binary exponentation. supports
1464 # negative exponents.
1465 my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
1466
1467 return $num if $num->modify('bmodpow');
1468
1469 # check modulus for valid values
1470 return $num->bnan() if ($mod->{sign} ne '+' # NaN, - , -inf, +inf
1471 || $mod->is_zero());
1472
1473 # check exponent for valid values
1474 if ($exp->{sign} =~ /\w/)
1475 {
1476 # i.e., if it's NaN, +inf, or -inf...
1477 return $num->bnan();
1478 }
07d34614 1479
1ddff52a 1480 $num->bmodinv ($mod) if ($exp->{sign} eq '-');
d614cd8b 1481
1ddff52a 1482 # check num for valid values (also NaN if there was no inverse but $exp < 0)
07d34614 1483 return $num->bnan() if $num->{sign} !~ /^[+-]$/;
d614cd8b 1484
07d34614
T
1485 if ($CALC->can('_modpow'))
1486 {
1ddff52a 1487 # $mod is positive, sign on $exp is ignored, result also positive
07d34614
T
1488 $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
1489 return $num;
1490 }
d614cd8b 1491
07d34614
T
1492 # in the trivial case,
1493 return $num->bzero() if $mod->is_one();
1494 return $num->bone() if $num->is_zero() or $num->is_one();
d614cd8b 1495
1ddff52a
JH
1496 # $num->bmod($mod); # if $x is large, make it smaller first
1497 my $acc = $num->copy(); # but this is not really faster...
07d34614 1498
1ddff52a
JH
1499 $num->bone(); # keep ref to $num
1500
1501 my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
1502 my $len = length($expbin);
1503 while (--$len >= 0)
07d34614 1504 {
1ddff52a 1505 if( substr($expbin,$len,1) eq '1')
07d34614
T
1506 {
1507 $num->bmul($acc)->bmod($mod);
d614cd8b 1508 }
07d34614 1509 $acc->bmul($acc)->bmod($mod);
d614cd8b 1510 }
1ddff52a 1511
07d34614 1512 $num;
d614cd8b
JH
1513 }
1514
1515###############################################################################
1516
b3abae2a
JH
1517sub bfac
1518 {
1519 # (BINT or num_str, BINT or num_str) return BINT
1520 # compute factorial numbers
1521 # modifies first argument
1522 my ($self,$x,@r) = objectify(1,@_);
1523
1524 return $x if $x->modify('bfac');
1525
1526 return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
1527 return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
1528
1529 if ($CALC->can('_fac'))
1530 {
1531 $x->{value} = $CALC->_fac($x->{value});
1532 return $x->round(@r);
1533 }
1534
1535 my $n = $x->copy();
1536 $x->bone();
1537 my $f = $self->new(2);
1538 while ($f->bacmp($n) < 0)
1539 {
1540 $x->bmul($f); $f->binc();
1541 }
1542 $x->bmul($f); # last step
1543 $x->round(@r); # round
1544 }
1545
58cde26e
JH
1546sub bpow
1547 {
1548 # (BINT or num_str, BINT or num_str) return BINT
1549 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1550 # modifies first argument
61f5c3f5 1551 my ($self,$x,$y,@r) = objectify(2,@_);
58cde26e
JH
1552
1553 return $x if $x->modify('bpow');
9393ace2
JH
1554
1555 return $upgrade->bpow($upgrade->new($x),$y,@r)
8f675a64 1556 if defined $upgrade && !$y->isa($self);
9393ace2 1557
61f5c3f5 1558 $r[3] = $y; # no push!
0716bf9b 1559 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
58cde26e 1560 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
61f5c3f5
T
1561 return $x->bone(@r) if $y->is_zero();
1562 return $x->round(@r) if $x->is_one() || $y->is_one();
0716bf9b 1563 if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
58cde26e
JH
1564 {
1565 # if $x == -1 and odd/even y => +1/-1
61f5c3f5 1566 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
574bacfe 1567 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
58cde26e 1568 }
574bacfe
JH
1569 # 1 ** -y => 1 / (1 ** |y|)
1570 # so do test for negative $y after above's clause
58cde26e 1571 return $x->bnan() if $y->{sign} eq '-';
61f5c3f5 1572 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
58cde26e 1573
0716bf9b 1574 if ($CALC->can('_pow'))
58cde26e 1575 {
574bacfe 1576 $x->{value} = $CALC->_pow($x->{value},$y->{value});
61f5c3f5 1577 return $x->round(@r);
58cde26e 1578 }
027dc388
JH
1579
1580# based on the assumption that shifting in base 10 is fast, and that mul
1581# works faster if numbers are small: we count trailing zeros (this step is
1582# O(1)..O(N), but in case of O(N) we save much more time due to this),
1583# stripping them out of the multiplication, and add $count * $y zeros
1584# afterwards like this:
1585# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1586# creates deep recursion?
574bacfe
JH
1587# my $zeros = $x->_trailing_zeros();
1588# if ($zeros > 0)
1589# {
1590# $x->brsft($zeros,10); # remove zeros
1591# $x->bpow($y); # recursion (will not branch into here again)
1592# $zeros = $y * $zeros; # real number of zeros to add
1593# $x->blsft($zeros,10);
1594# return $x->round($a,$p,$r);
1595# }
1596
1597 my $pow2 = $self->__one();
1ddff52a
JH
1598 my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
1599 my $len = length($y_bin);
1600 while (--$len > 0)
58cde26e 1601 {
1ddff52a 1602 $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
027dc388 1603 $x->bmul($x);
58cde26e 1604 }
1ddff52a 1605 $x->bmul($pow2);
56b9c951 1606 $x->round(@r);
58cde26e
JH
1607 }
1608
1609sub blsft
1610 {
1611 # (BINT or num_str, BINT or num_str) return BINT
1612 # compute x << y, base n, y >= 0
b3abae2a 1613 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1614
1615 return $x if $x->modify('blsft');
1616 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
b3abae2a 1617 return $x->round($a,$p,$r) if $y->is_zero();
58cde26e 1618
574bacfe
JH
1619 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1620
027dc388 1621 my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
574bacfe
JH
1622 if (defined $t)
1623 {
b3abae2a 1624 $x->{value} = $t; return $x->round($a,$p,$r);
574bacfe
JH
1625 }
1626 # fallback
b3abae2a 1627 return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
58cde26e
JH
1628 }
1629
1630sub brsft
1631 {
1632 # (BINT or num_str, BINT or num_str) return BINT
1633 # compute x >> y, base n, y >= 0
b3abae2a 1634 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1635
1636 return $x if $x->modify('brsft');
1637 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
b3abae2a
JH
1638 return $x->round($a,$p,$r) if $y->is_zero();
1639 return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
58cde26e
JH
1640
1641 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
574bacfe 1642
b3abae2a
JH
1643 # this only works for negative numbers when shifting in base 2
1644 if (($x->{sign} eq '-') && ($n == 2))
1645 {
1646 return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
1647 if (!$y->is_one())
1648 {
1649 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1650 # but perhaps there is a better emulation for two's complement shift...
1651 # if $y != 1, we must simulate it by doing:
1652 # convert to bin, flip all bits, shift, and be done
1653 $x->binc(); # -3 => -2
1654 my $bin = $x->as_bin();
1655 $bin =~ s/^-0b//; # strip '-0b' prefix
1656 $bin =~ tr/10/01/; # flip bits
1657 # now shift
8f675a64 1658 if (CORE::length($bin) <= $y)
b3abae2a
JH
1659 {
1660 $bin = '0'; # shifting to far right creates -1
1661 # 0, because later increment makes
1662 # that 1, attached '-' makes it '-1'
1663 # because -1 >> x == -1 !
1664 }
1665 else
1666 {
1667 $bin =~ s/.{$y}$//; # cut off at the right side
1668 $bin = '1' . $bin; # extend left side by one dummy '1'
1669 $bin =~ tr/10/01/; # flip bits back
1670 }
1671 my $res = $self->new('0b'.$bin); # add prefix and convert back
1672 $res->binc(); # remember to increment
1673 $x->{value} = $res->{value}; # take over value
1674 return $x->round($a,$p,$r); # we are done now, magic, isn't?
1675 }
1676 $x->bdec(); # n == 2, but $y == 1: this fixes it
1677 }
1678
027dc388 1679 my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
574bacfe
JH
1680 if (defined $t)
1681 {
b3abae2a
JH
1682 $x->{value} = $t;
1683 return $x->round($a,$p,$r);
574bacfe
JH
1684 }
1685 # fallback
b3abae2a
JH
1686 $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
1687 $x;
58cde26e
JH
1688 }
1689
1690sub band
1691 {
1692 #(BINT or num_str, BINT or num_str) return BINT
1693 # compute x & y
0716bf9b 1694 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1695
1696 return $x if $x->modify('band');
1697
b3abae2a
JH
1698 local $Math::BigInt::upgrade = undef;
1699
58cde26e 1700 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
394e6ffb 1701 return $x->bzero() if $y->is_zero() || $x->is_zero();
0716bf9b 1702
574bacfe
JH
1703 my $sign = 0; # sign of result
1704 $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1705 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1706 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1707
1708 if ($CALC->can('_and') && $sx == 1 && $sy == 1)
0716bf9b 1709 {
574bacfe 1710 $x->{value} = $CALC->_and($x->{value},$y->{value});
0716bf9b
JH
1711 return $x->round($a,$p,$r);
1712 }
574bacfe 1713
b3abae2a
JH
1714 my $m = $self->bone(); my ($xr,$yr);
1715 my $x10000 = $self->new (0x1000);
574bacfe
JH
1716 my $y1 = copy(ref($x),$y); # make copy
1717 $y1->babs(); # and positive
1718 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1719 use integer; # need this for negative bools
0716bf9b 1720 while (!$x1->is_zero() && !$y1->is_zero())
58cde26e 1721 {
0716bf9b 1722 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1723 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe
JH
1724 # make both op's numbers!
1725 $x->badd( bmul( $class->new(
1726 abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1727 $m));
58cde26e
JH
1728 $m->bmul($x10000);
1729 }
574bacfe 1730 $x->bneg() if $sign;
0716bf9b 1731 return $x->round($a,$p,$r);
58cde26e
JH
1732 }
1733
1734sub bior
1735 {
1736 #(BINT or num_str, BINT or num_str) return BINT
1737 # compute x | y
0716bf9b 1738 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1739
1740 return $x if $x->modify('bior');
1741
b3abae2a
JH
1742 local $Math::BigInt::upgrade = undef;
1743
58cde26e
JH
1744 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1745 return $x if $y->is_zero();
574bacfe
JH
1746
1747 my $sign = 0; # sign of result
1748 $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1749 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1750 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1751
1752 # don't use lib for negative values
1753 if ($CALC->can('_or') && $sx == 1 && $sy == 1)
0716bf9b 1754 {
574bacfe 1755 $x->{value} = $CALC->_or($x->{value},$y->{value});
0716bf9b
JH
1756 return $x->round($a,$p,$r);
1757 }
1758
b3abae2a
JH
1759 my $m = $self->bone(); my ($xr,$yr);
1760 my $x10000 = $self->new(0x10000);
574bacfe
JH
1761 my $y1 = copy(ref($x),$y); # make copy
1762 $y1->babs(); # and positive
1763 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1764 use integer; # need this for negative bools
0716bf9b 1765 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1766 {
0716bf9b 1767 ($x1, $xr) = bdiv($x1,$x10000);
58cde26e 1768 ($y1, $yr) = bdiv($y1,$x10000);
574bacfe
JH
1769 # make both op's numbers!
1770 $x->badd( bmul( $class->new(
1771 abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1772 $m));
58cde26e
JH
1773 $m->bmul($x10000);
1774 }
574bacfe 1775 $x->bneg() if $sign;
0716bf9b 1776 return $x->round($a,$p,$r);
58cde26e
JH
1777 }
1778
1779sub bxor
1780 {
1781 #(BINT or num_str, BINT or num_str) return BINT
1782 # compute x ^ y
0716bf9b 1783 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e
JH
1784
1785 return $x if $x->modify('bxor');
1786
b3abae2a
JH
1787 local $Math::BigInt::upgrade = undef;
1788
0716bf9b 1789 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
58cde26e 1790 return $x if $y->is_zero();
0716bf9b 1791
574bacfe
JH
1792 my $sign = 0; # sign of result
1793 $sign = 1 if $x->{sign} ne $y->{sign};
1794 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1795 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1796
1797 # don't use lib for negative values
1798 if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
0716bf9b 1799 {
574bacfe 1800 $x->{value} = $CALC->_xor($x->{value},$y->{value});
0716bf9b
JH
1801 return $x->round($a,$p,$r);
1802 }
1803
394e6ffb 1804 my $m = $self->bone(); my ($xr,$yr);
b3abae2a 1805 my $x10000 = $self->new(0x10000);
58cde26e 1806 my $y1 = copy(ref($x),$y); # make copy
574bacfe
JH
1807 $y1->babs(); # and positive
1808 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1809 use integer; # need this for negative bools
0716bf9b 1810 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1811 {
0716bf9b 1812 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1813 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe
JH
1814 # make both op's numbers!
1815 $x->badd( bmul( $class->new(
1816 abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1817 $m));
58cde26e
JH
1818 $m->bmul($x10000);
1819 }
574bacfe 1820 $x->bneg() if $sign;
0716bf9b 1821 return $x->round($a,$p,$r);
58cde26e
JH
1822 }
1823
1824sub length
1825 {
ee15d750 1826 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1827
0716bf9b 1828 my $e = $CALC->_len($x->{value});
0716bf9b 1829 return wantarray ? ($e,0) : $e;
58cde26e
JH
1830 }
1831
1832sub digit
1833 {
0716bf9b 1834 # return the nth decimal digit, negative values count backward, 0 is right
56b9c951
JH
1835 my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1836 $n = 0 if !defined $n;
58cde26e 1837
56b9c951 1838 $CALC->_digit($x->{value},$n);
58cde26e
JH
1839 }
1840
1841sub _trailing_zeros
1842 {
1843 # return the amount of trailing zeros in $x
1844 my $x = shift;
1845 $x = $class->new($x) unless ref $x;
1846
dccbb853 1847 return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
0716bf9b
JH
1848
1849 return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1850
b22b3e31 1851 # if not: since we do not know underlying internal representation:
0716bf9b 1852 my $es = "$x"; $es =~ /([0]*)$/;
0716bf9b
JH
1853 return 0 if !defined $1; # no zeros
1854 return CORE::length("$1"); # as string, not as +0!
58cde26e
JH
1855 }
1856
1857sub bsqrt
1858 {
394e6ffb 1859 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1860
b3abae2a
JH
1861 return $x if $x->modify('bsqrt');
1862
394e6ffb
JH
1863 return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
1864 return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
1865 return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
b3abae2a
JH
1866
1867 return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
58cde26e 1868
394e6ffb
JH
1869 if ($CALC->can('_sqrt'))
1870 {
1871 $x->{value} = $CALC->_sqrt($x->{value});
1872 return $x->round($a,$p,$r);
1873 }
1874
b3abae2a 1875 return $x->bone($a,$p) if $x < 4; # 2,3 => 1
394e6ffb 1876 my $y = $x->copy();
58cde26e
JH
1877 my $l = int($x->length()/2);
1878
394e6ffb
JH
1879 $x->bone(); # keep ref($x), but modify it
1880 $x->blsft($l,10);
58cde26e
JH
1881
1882 my $last = $self->bzero();
394e6ffb
JH
1883 my $two = $self->new(2);
1884 my $lastlast = $x+$two;
1885 while ($last != $x && $lastlast != $x)
58cde26e 1886 {
394e6ffb 1887 $lastlast = $last; $last = $x;
58cde26e 1888 $x += $y / $x;
394e6ffb 1889 $x /= $two;
58cde26e 1890 }
394e6ffb 1891 $x-- if $x * $x > $y; # overshot?
b3abae2a 1892 $x->round($a,$p,$r);
58cde26e
JH
1893 }
1894
1895sub exponent
1896 {
1897 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
ee15d750 1898 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1899
ee15d750
JH
1900 if ($x->{sign} !~ /^[+-]$/)
1901 {
1902 my $s = $x->{sign}; $s =~ s/^[+-]//;
1903 return $self->new($s); # -inf,+inf => inf
1904 }
58cde26e
JH
1905 my $e = $class->bzero();
1906 return $e->binc() if $x->is_zero();
1907 $e += $x->_trailing_zeros();
56b9c951 1908 $e;
58cde26e
JH
1909 }
1910
1911sub mantissa
1912 {
ee15d750
JH
1913 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
1914 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1915
ee15d750
JH
1916 if ($x->{sign} !~ /^[+-]$/)
1917 {
28df3e88 1918 return $self->new($x->{sign}); # keep + or - sign
ee15d750 1919 }
58cde26e
JH
1920 my $m = $x->copy();
1921 # that's inefficient
1922 my $zeros = $m->_trailing_zeros();
56b9c951
JH
1923 $m->brsft($zeros,10) if $zeros != 0;
1924# $m /= 10 ** $zeros if $zeros != 0;
1925 $m;
58cde26e
JH
1926 }
1927
1928sub parts
1929 {
ee15d750
JH
1930 # return a copy of both the exponent and the mantissa
1931 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1932
ee15d750 1933 return ($x->mantissa(),$x->exponent());
58cde26e
JH
1934 }
1935
1936##############################################################################
1937# rounding functions
1938
1939sub bfround
1940 {
1941 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
ee15d750 1942 # $n == 0 || $n == 1 => round to integer
58cde26e 1943 my $x = shift; $x = $class->new($x) unless ref $x;
dccbb853 1944 my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
58cde26e 1945 return $x if !defined $scale; # no-op
b3abae2a 1946 return $x if $x->modify('bfround');
58cde26e
JH
1947
1948 # no-op for BigInts if $n <= 0
ee15d750
JH
1949 if ($scale <= 0)
1950 {
61f5c3f5 1951 $x->{_a} = undef; # clear an eventual set A
ee15d750
JH
1952 $x->{_p} = $scale; return $x;
1953 }
58cde26e
JH
1954
1955 $x->bround( $x->length()-$scale, $mode);
ee15d750
JH
1956 $x->{_a} = undef; # bround sets {_a}
1957 $x->{_p} = $scale; # so correct it
1958 $x;
58cde26e
JH
1959 }
1960
1961sub _scan_for_nonzero
1962 {
1963 my $x = shift;
1964 my $pad = shift;
0716bf9b 1965 my $xs = shift;
58cde26e
JH
1966
1967 my $len = $x->length();
1968 return 0 if $len == 1; # '5' is trailed by invisible zeros
1969 my $follow = $pad - 1;
1970 return 0 if $follow > $len || $follow < 1;
0716bf9b 1971
b22b3e31 1972 # since we do not know underlying represention of $x, use decimal string
0716bf9b 1973 #my $r = substr ($$xs,-$follow);
58cde26e
JH
1974 my $r = substr ("$x",-$follow);
1975 return 1 if $r =~ /[^0]/; return 0;
58cde26e
JH
1976 }
1977
1978sub fround
1979 {
1980 # to make life easier for switch between MBF and MBI (autoload fxxx()
1981 # like MBF does for bxxx()?)
1982 my $x = shift;
1983 return $x->bround(@_);
1984 }
1985
1986sub bround
1987 {
1988 # accuracy: +$n preserve $n digits from left,
1989 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1990 # no-op for $n == 0
1991 # and overwrite the rest with 0's, return normalized number
1992 # do not return $x->bnorm(), but $x
61f5c3f5 1993
58cde26e 1994 my $x = shift; $x = $class->new($x) unless ref $x;
dccbb853 1995 my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
61f5c3f5 1996 return $x if !defined $scale; # no-op
b3abae2a 1997 return $x if $x->modify('bround');
58cde26e 1998
61f5c3f5
T
1999 if ($x->is_zero() || $scale == 0)
2000 {
2001 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2002 return $x;
2003 }
2004 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
58cde26e
JH
2005
2006 # we have fewer digits than we want to scale to
2007 my $len = $x->length();
ee15d750
JH
2008 # scale < 0, but > -len (not >=!)
2009 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
2010 {
61f5c3f5 2011 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
ee15d750
JH
2012 return $x;
2013 }
58cde26e
JH
2014
2015 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
2016 my ($pad,$digit_round,$digit_after);
2017 $pad = $len - $scale;
ee15d750
JH
2018 $pad = abs($scale-1) if $scale < 0;
2019
0716bf9b 2020 # do not use digit(), it is costly for binary => decimal
ee15d750 2021
0716bf9b
JH
2022 my $xs = $CALC->_str($x->{value});
2023 my $pl = -$pad-1;
ee15d750 2024
0716bf9b
JH
2025 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
2026 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
2027 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
2028 $pl++; $pl ++ if $pad >= $len;
61f5c3f5 2029 $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
ee15d750
JH
2030
2031 # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
58cde26e
JH
2032
2033 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
2034 # closer at the remaining digits of the original $x, remember decision
2035 my $round_up = 1; # default round up
2036 $round_up -- if
2037 ($mode eq 'trunc') || # trunc by round down
2038 ($digit_after =~ /[01234]/) || # round down anyway,
2039 # 6789 => round up
2040 ($digit_after eq '5') && # not 5000...0000
0716bf9b 2041 ($x->_scan_for_nonzero($pad,$xs) == 0) &&
58cde26e
JH
2042 (
2043 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
2044 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
2045 ($mode eq '+inf') && ($x->{sign} eq '-') ||
2046 ($mode eq '-inf') && ($x->{sign} eq '+') ||
2047 ($mode eq 'zero') # round down if zero, sign adjusted below
2048 );
61f5c3f5
T
2049 my $put_back = 0; # not yet modified
2050
2051 # old code, depend on internal representation
2052 # split mantissa at $pad and then pad with zeros
2053 #my $s5 = int($pad / 5);
2054 #my $i = 0;
2055 #while ($i < $s5)
2056 # {
2057 # $x->{value}->[$i++] = 0; # replace with 5 x 0
2058 # }
2059 #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
2060 #my $rem = $pad % 5; # so much left over
2061 #if ($rem > 0)
2062 # {
2063 # #print "remainder $rem\n";
2064 ## #print "elem $x->{value}->[$s5]\n";
2065 # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
2066 # }
2067 #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
2068 #print ${$CALC->_str($pad->{value})}," $len\n";
2069
2070 if (($pad > 0) && ($pad <= $len))
2071 {
2072 substr($$xs,-$pad,$pad) = '0' x $pad;
2073 $put_back = 1;
58cde26e 2074 }
61f5c3f5
T
2075 elsif ($pad > $len)
2076 {
2077 $x->bzero(); # round to '0'
2078 }
2079
58cde26e
JH
2080 if ($round_up) # what gave test above?
2081 {
61f5c3f5
T
2082 $put_back = 1;
2083 $pad = $len, $$xs = '0'x$pad if $scale < 0; # tlr: whack 0.51=>1.0
2084
2085 # we modify directly the string variant instead of creating a number and
2086 # adding it
2087 my $c = 0; $pad ++; # for $pad == $len case
2088 while ($pad <= $len)
2089 {
2090 $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
2091 substr($$xs,-$pad,1) = $c; $pad++;
2092 last if $c != 0; # no overflow => early out
2093 }
2094 $$xs = '1'.$$xs if $c == 0;
2095
2096 # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
58cde26e 2097 }
61f5c3f5 2098 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in
ee15d750
JH
2099
2100 $x->{_a} = $scale if $scale >= 0;
2101 if ($scale < 0)
2102 {
2103 $x->{_a} = $len+$scale;
2104 $x->{_a} = 0 if $scale < -$len;
2105 }
58cde26e
JH
2106 $x;
2107 }
2108
2109sub bfloor
2110 {
2111 # return integer less or equal then number, since it is already integer,
2112 # always returns $self
ee15d750 2113 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e
JH
2114
2115 # not needed: return $x if $x->modify('bfloor');
58cde26e
JH
2116 return $x->round($a,$p,$r);
2117 }
2118
2119sub bceil
2120 {
2121 # return integer greater or equal then number, since it is already integer,
2122 # always returns $self
ee15d750 2123 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e
JH
2124
2125 # not needed: return $x if $x->modify('bceil');
58cde26e
JH
2126 return $x->round($a,$p,$r);
2127 }
2128
2129##############################################################################
2130# private stuff (internal use only)
2131
574bacfe 2132sub __one
58cde26e
JH
2133 {
2134 # internal speedup, set argument to 1, or create a +/- 1
2135 my $self = shift;
dccbb853 2136 my $x = $self->bone(); # $x->{value} = $CALC->_one();
0716bf9b
JH
2137 $x->{sign} = shift || '+';
2138 return $x;
58cde26e
JH
2139 }
2140
2141sub _swap
2142 {
2143 # Overload will swap params if first one is no object ref so that the first
2144 # one is always an object ref. In this case, third param is true.
2145 # This routine is to overcome the effect of scalar,$object creating an object
2146 # of the class of this package, instead of the second param $object. This
2147 # happens inside overload, when the overload section of this package is
2148 # inherited by sub classes.
2149 # For overload cases (and this is used only there), we need to preserve the
2150 # args, hence the copy().
2151 # You can override this method in a subclass, the overload section will call
2152 # $object->_swap() to make sure it arrives at the proper subclass, with some
394e6ffb
JH
2153 # exceptions like '+' and '-'. To make '+' and '-' work, you also need to
2154 # specify your own overload for them.
58cde26e
JH
2155
2156 # object, (object|scalar) => preserve first and make copy
2157 # scalar, object => swapped, re-swap and create new from first
2158 # (using class of second object, not $class!!)
2159 my $self = shift; # for override in subclass
58cde26e
JH
2160 if ($_[2])
2161 {
2162 my $c = ref ($_[0]) || $class; # fallback $class should not happen
2163 return ( $c->new($_[1]), $_[0] );
2164 }
17baacb7 2165 return ( $_[0]->copy(), $_[1] );
58cde26e
JH
2166 }
2167
2168sub objectify
2169 {
2170 # check for strings, if yes, return objects instead
2171
2172 # the first argument is number of args objectify() should look at it will
2173 # return $count+1 elements, the first will be a classname. This is because
2174 # overloaded '""' calls bstr($object,undef,undef) and this would result in
2175 # useless objects beeing created and thrown away. So we cannot simple loop
2176 # over @_. If the given count is 0, all arguments will be used.
2177
2178 # If the second arg is a ref, use it as class.
2179 # If not, try to use it as classname, unless undef, then use $class
2180 # (aka Math::BigInt). The latter shouldn't happen,though.
2181
2182 # caller: gives us:
2183 # $x->badd(1); => ref x, scalar y
2184 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2185 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2186 # Math::BigInt::badd(1,2); => scalar x, scalar y
2187 # In the last case we check number of arguments to turn it silently into
574bacfe 2188 # $class,1,2. (We can not take '1' as class ;o)
58cde26e
JH
2189 # badd($class,1) is not supported (it should, eventually, try to add undef)
2190 # currently it tries 'Math::BigInt' + 1, which will not work.
ee15d750
JH
2191
2192 # some shortcut for the common cases
ee15d750
JH
2193 # $x->unary_op();
2194 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
ee15d750 2195
58cde26e
JH
2196 my $count = abs(shift || 0);
2197
9393ace2 2198 my (@a,$k,$d); # resulting array, temp, and downgrade
58cde26e
JH
2199 if (ref $_[0])
2200 {
2201 # okay, got object as first
2202 $a[0] = ref $_[0];
2203 }
2204 else
2205 {
2206 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2207 $a[0] = $class;
58cde26e
JH
2208 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2209 }
8f675a64 2210
9393ace2
JH
2211 no strict 'refs';
2212 # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
2213 if (defined ${"$a[0]::downgrade"})
2214 {
2215 $d = ${"$a[0]::downgrade"};
2216 ${"$a[0]::downgrade"} = undef;
2217 }
2218
d614cd8b 2219 my $up = ${"$a[0]::upgrade"};
58cde26e 2220 # print "Now in objectify, my class is today $a[0]\n";
58cde26e
JH
2221 if ($count == 0)
2222 {
2223 while (@_)
2224 {
2225 $k = shift;
2226 if (!ref($k))
2227 {
2228 $k = $a[0]->new($k);
2229 }
d614cd8b 2230 elsif (!defined $up && ref($k) ne $a[0])
58cde26e
JH
2231 {
2232 # foreign object, try to convert to integer
2233 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2234 }
58cde26e
JH
2235 push @a,$k;
2236 }
2237 }
2238 else
2239 {
2240 while ($count > 0)
2241 {
58cde26e
JH
2242 $count--;
2243 $k = shift;
2244 if (!ref($k))
2245 {
2246 $k = $a[0]->new($k);
2247 }
d614cd8b 2248 elsif (!defined $up && ref($k) ne $a[0])
58cde26e
JH
2249 {
2250 # foreign object, try to convert to integer
2251 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2252 }
58cde26e
JH
2253 push @a,$k;
2254 }
2255 push @a,@_; # return other params, too
2256 }
58cde26e 2257 die "$class objectify needs list context" unless wantarray;
9393ace2 2258 ${"$a[0]::downgrade"} = $d;
58cde26e
JH
2259 @a;
2260 }
2261
2262sub import
2263 {
2264 my $self = shift;
61f5c3f5
T
2265
2266 $IMPORT++;
8f675a64
JH
2267 my @a; my $l = scalar @_;
2268 for ( my $i = 0; $i < $l ; $i++ )
58cde26e 2269 {
0716bf9b 2270 if ($_[$i] eq ':constant')
58cde26e 2271 {
0716bf9b 2272 # this causes overlord er load to step in
58cde26e 2273 overload::constant integer => sub { $self->new(shift) };
56b9c951 2274 overload::constant binary => sub { $self->new(shift) };
0716bf9b 2275 }
b3abae2a
JH
2276 elsif ($_[$i] eq 'upgrade')
2277 {
2278 # this causes upgrading
2279 $upgrade = $_[$i+1]; # or undef to disable
8f675a64 2280 $i++;
b3abae2a 2281 }
0716bf9b
JH
2282 elsif ($_[$i] =~ /^lib$/i)
2283 {
2284 # this causes a different low lib to take care...
61f5c3f5 2285 $CALC = $_[$i+1] || '';
8f675a64
JH
2286 $i++;
2287 }
2288 else
2289 {
2290 push @a, $_[$i];
58cde26e
JH
2291 }
2292 }
2293 # any non :constant stuff is handled by our parent, Exporter
2294 # even if @_ is empty, to give it a chance
dccbb853
JH
2295 $self->SUPER::import(@a); # need it for subclasses
2296 $self->export_to_level(1,$self,@a); # need it for MBF
58cde26e 2297
574bacfe
JH
2298 # try to load core math lib
2299 my @c = split /\s*,\s*/,$CALC;
2300 push @c,'Calc'; # if all fail, try this
61f5c3f5 2301 $CALC = ''; # signal error
574bacfe
JH
2302 foreach my $lib (@c)
2303 {
07d34614 2304 next if ($lib || '') eq '';
574bacfe
JH
2305 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2306 $lib =~ s/\.pm$//;
61f5c3f5 2307 if ($] < 5.006)
574bacfe
JH
2308 {
2309 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
2310 # used in the same script, or eval inside import().
07d34614
T
2311 my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
2312 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
2313 require File::Spec;
2314 $file = File::Spec->catfile (@parts, $file);
2315 eval { require "$file"; $lib->import( @c ); }
574bacfe
JH
2316 }
2317 else
2318 {
61f5c3f5 2319 eval "use $lib qw/@c/;";
574bacfe 2320 }
bd05a461 2321 $CALC = $lib, last if $@ eq ''; # no error in loading lib?
574bacfe 2322 }
61f5c3f5 2323 die "Couldn't load any math lib, not even the default" if $CALC eq '';
58cde26e
JH
2324 }
2325
574bacfe 2326sub __from_hex
58cde26e
JH
2327 {
2328 # convert a (ref to) big hex string to BigInt, return undef for error
2329 my $hs = shift;
2330
2331 my $x = Math::BigInt->bzero();
394e6ffb
JH
2332
2333 # strip underscores
2334 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2335 $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2336
58cde26e
JH
2337 return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
2338
b22b3e31 2339 my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
58cde26e 2340
b22b3e31 2341 $$hs =~ s/^[+-]//; # strip sign
0716bf9b 2342 if ($CALC->can('_from_hex'))
58cde26e 2343 {
0716bf9b 2344 $x->{value} = $CALC->_from_hex($hs);
58cde26e 2345 }
0716bf9b 2346 else
58cde26e 2347 {
0716bf9b
JH
2348 # fallback to pure perl
2349 my $mul = Math::BigInt->bzero(); $mul++;
2350 my $x65536 = Math::BigInt->new(65536);
2351 my $len = CORE::length($$hs)-2;
2352 $len = int($len/4); # 4-digit parts, w/o '0x'
2353 my $val; my $i = -4;
2354 while ($len >= 0)
2355 {
2356 $val = substr($$hs,$i,4);
b22b3e31 2357 $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
0716bf9b 2358 $val = hex($val); # hex does not like wrong chars
0716bf9b
JH
2359 $i -= 4; $len --;
2360 $x += $mul * $val if $val != 0;
2361 $mul *= $x65536 if $len >= 0; # skip last mul
2362 }
58cde26e 2363 }
13a12e00
JH
2364 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2365 $x;
58cde26e
JH
2366 }
2367
574bacfe 2368sub __from_bin
58cde26e
JH
2369 {
2370 # convert a (ref to) big binary string to BigInt, return undef for error
2371 my $bs = shift;
2372
2373 my $x = Math::BigInt->bzero();
394e6ffb
JH
2374 # strip underscores
2375 $$bs =~ s/([01])_([01])/$1$2/g;
2376 $$bs =~ s/([01])_([01])/$1$2/g;
b22b3e31 2377 return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
58cde26e 2378
0716bf9b 2379 my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
b22b3e31 2380 $$bs =~ s/^[+-]//; # strip sign
0716bf9b 2381 if ($CALC->can('_from_bin'))
58cde26e 2382 {
0716bf9b 2383 $x->{value} = $CALC->_from_bin($bs);
58cde26e 2384 }
0716bf9b 2385 else
58cde26e 2386 {
13a12e00
JH
2387 my $mul = Math::BigInt->bzero(); $mul++;
2388 my $x256 = Math::BigInt->new(256);
0716bf9b
JH
2389 my $len = CORE::length($$bs)-2;
2390 $len = int($len/8); # 8-digit parts, w/o '0b'
2391 my $val; my $i = -8;
2392 while ($len >= 0)
2393 {
2394 $val = substr($$bs,$i,8);
b22b3e31
PN
2395 $val =~ s/^[+-]?0b// if $len == 0; # for last part only
2396 #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
394e6ffb
JH
2397 # slower:
2398 # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
2399 $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
0716bf9b
JH
2400 $i -= 8; $len --;
2401 $x += $mul * $val if $val != 0;
2402 $mul *= $x256 if $len >= 0; # skip last mul
2403 }
58cde26e 2404 }
13a12e00
JH
2405 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2406 $x;
58cde26e
JH
2407 }
2408
2409sub _split
2410 {
2411 # (ref to num_str) return num_str
2412 # internal, take apart a string and return the pieces
dccbb853 2413 # strip leading/trailing whitespace, leading zeros, underscore and reject
574bacfe 2414 # invalid input
58cde26e
JH
2415 my $x = shift;
2416
574bacfe
JH
2417 # strip white space at front, also extranous leading zeros
2418 $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2419 $$x =~ s/^\s+//; # but this will
58cde26e 2420 $$x =~ s/\s+$//g; # strip white space at end
58cde26e 2421
574bacfe
JH
2422 # shortcut, if nothing to split, return early
2423 if ($$x =~ /^[+-]?\d+$/)
2424 {
2425 $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2426 return (\$sign, $x, \'', \'', \0);
2427 }
58cde26e 2428
574bacfe
JH
2429 # invalid starting char?
2430 return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
58cde26e 2431
574bacfe
JH
2432 return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
2433 return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
394e6ffb
JH
2434
2435 # strip underscores between digits
2436 $$x =~ s/(\d)_(\d)/$1$2/g;
2437 $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
574bacfe 2438
58cde26e
JH
2439 # some possible inputs:
2440 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
2441 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
2442
027dc388
JH
2443 return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
2444
58cde26e
JH
2445 my ($m,$e) = split /[Ee]/,$$x;
2446 $e = '0' if !defined $e || $e eq "";
58cde26e
JH
2447 # sign,value for exponent,mantint,mantfrac
2448 my ($es,$ev,$mis,$miv,$mfv);
2449 # valid exponent?
2450 if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2451 {
2452 $es = $1; $ev = $2;
58cde26e
JH
2453 # valid mantissa?
2454 return if $m eq '.' || $m eq '';
07d34614
T
2455 my ($mi,$mf,$last) = split /\./,$m;
2456 return if defined $last; # last defined => 1.2.3 or others
58cde26e
JH
2457 $mi = '0' if !defined $mi;
2458 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2459 $mf = '0' if !defined $mf || $mf eq '';
2460 if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
2461 {
2462 $mis = $1||'+'; $miv = $2;
58cde26e
JH
2463 return unless ($mf =~ /^(\d*?)0*$/); # strip trailing zeros
2464 $mfv = $1;
58cde26e
JH
2465 return (\$mis,\$miv,\$mfv,\$es,\$ev);
2466 }
2467 }
2468 return; # NaN, not a number
2469 }
2470
58cde26e
JH
2471sub as_number
2472 {
2473 # an object might be asked to return itself as bigint on certain overloaded
2474 # operations, this does exactly this, so that sub classes can simple inherit
2475 # it or override with their own integer conversion routine
2476 my $self = shift;
2477
17baacb7 2478 $self->copy();
58cde26e
JH
2479 }
2480
bd05a461
JH
2481sub as_hex
2482 {
2483 # return as hex string, with prefixed 0x
2484 my $x = shift; $x = $class->new($x) if !ref($x);
2485
2486 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2487 return '0x0' if $x->is_zero();
2488
2489 my $es = ''; my $s = '';
2490 $s = $x->{sign} if $x->{sign} eq '-';
bd05a461
JH
2491 if ($CALC->can('_as_hex'))
2492 {
ee15d750 2493 $es = ${$CALC->_as_hex($x->{value})};
bd05a461
JH
2494 }
2495 else
2496 {
1ddff52a
JH
2497 my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
2498 if ($] >= 5.006)
2499 {
2500 $x10000 = Math::BigInt->new (0x10000); $h = 'h4';
2501 }
2502 else
2503 {
2504 $x10000 = Math::BigInt->new (0x1000); $h = 'h3';
2505 }
bd05a461
JH
2506 while (!$x1->is_zero())
2507 {
61f5c3f5 2508 ($x1, $xr) = bdiv($x1,$x10000);
1ddff52a 2509 $es .= unpack($h,pack('v',$xr->numify()));
bd05a461
JH
2510 }
2511 $es = reverse $es;
2512 $es =~ s/^[0]+//; # strip leading zeros
ee15d750 2513 $s .= '0x';
bd05a461
JH
2514 }
2515 $s . $es;
2516 }
2517
2518sub as_bin
2519 {
2520 # return as binary string, with prefixed 0b
2521 my $x = shift; $x = $class->new($x) if !ref($x);
2522
2523 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2524 return '0b0' if $x->is_zero();
2525
2526 my $es = ''; my $s = '';
2527 $s = $x->{sign} if $x->{sign} eq '-';
bd05a461
JH
2528 if ($CALC->can('_as_bin'))
2529 {
ee15d750 2530 $es = ${$CALC->_as_bin($x->{value})};
bd05a461
JH
2531 }
2532 else
2533 {
1ddff52a
JH
2534 my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
2535 if ($] >= 5.006)
2536 {
2537 $x10000 = Math::BigInt->new (0x10000); $b = 'b16';
2538 }
2539 else
2540 {
2541 $x10000 = Math::BigInt->new (0x1000); $b = 'b12';
2542 }
bd05a461
JH
2543 while (!$x1->is_zero())
2544 {
61f5c3f5 2545 ($x1, $xr) = bdiv($x1,$x10000);
1ddff52a 2546 $es .= unpack($b,pack('v',$xr->numify()));
bd05a461
JH
2547 }
2548 $es = reverse $es;
2549 $es =~ s/^[0]+//; # strip leading zeros
ee15d750 2550 $s .= '0b';
bd05a461
JH
2551 }
2552 $s . $es;
2553 }
2554
58cde26e 2555##############################################################################
0716bf9b 2556# internal calculation routines (others are in Math::BigInt::Calc etc)
58cde26e 2557
dccbb853 2558sub __lcm
58cde26e
JH
2559 {
2560 # (BINT or num_str, BINT or num_str) return BINT
2561 # does modify first argument
2562 # LCM
2563
2564 my $x = shift; my $ty = shift;
2565 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
2566 return $x * $ty / bgcd($x,$ty);
2567 }
2568
574bacfe 2569sub __gcd
58cde26e
JH
2570 {
2571 # (BINT or num_str, BINT or num_str) return BINT
dccbb853 2572 # does modify both arguments
58cde26e 2573 # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
dccbb853
JH
2574 my ($x,$ty) = @_;
2575
0716bf9b 2576 return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
58cde26e
JH
2577
2578 while (!$ty->is_zero())
2579 {
2580 ($x, $ty) = ($ty,bmod($x,$ty));
2581 }
2582 $x;
2583 }
2584
58cde26e
JH
2585###############################################################################
2586# this method return 0 if the object can be modified, or 1 for not
2587# We use a fast use constant statement here, to avoid costly calls. Subclasses
2588# may override it with special code (f.i. Math::BigInt::Constant does so)
2589
0716bf9b 2590sub modify () { 0; }
e16b8f49 2591
a0d0e21e 25921;
a5f75d66
AD
2593__END__
2594
2595=head1 NAME
2596
2597Math::BigInt - Arbitrary size integer math package
2598
2599=head1 SYNOPSIS
2600
2601 use Math::BigInt;
58cde26e
JH
2602
2603 # Number creation
574bacfe
JH
2604 $x = Math::BigInt->new($str); # defaults to 0
2605 $nan = Math::BigInt->bnan(); # create a NotANumber
2606 $zero = Math::BigInt->bzero(); # create a +0
2607 $inf = Math::BigInt->binf(); # create a +inf
2608 $inf = Math::BigInt->binf('-'); # create a -inf
2609 $one = Math::BigInt->bone(); # create a +1
2610 $one = Math::BigInt->bone('-'); # create a -1
58cde26e
JH
2611
2612 # Testing
574bacfe
JH
2613 $x->is_zero(); # true if arg is +0
2614 $x->is_nan(); # true if arg is NaN
0716bf9b
JH
2615 $x->is_one(); # true if arg is +1
2616 $x->is_one('-'); # true if arg is -1
2617 $x->is_odd(); # true if odd, false for even
2618 $x->is_even(); # true if even, false for odd
2619 $x->is_positive(); # true if >= 0
2620 $x->is_negative(); # true if < 0
2621 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
b3abae2a 2622 $x->is_int(); # true if $x is an integer (not a float)
0716bf9b 2623
58cde26e
JH
2624 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
2625 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
2626 $x->sign(); # return the sign, either +,- or NaN
2627 $x->digit($n); # return the nth digit, counting from right
2628 $x->digit(-$n); # return the nth digit, counting from left
2629
2630 # The following all modify their first argument:
2631
2632 # set
2633 $x->bzero(); # set $x to 0
2634 $x->bnan(); # set $x to NaN
574bacfe
JH
2635 $x->bone(); # set $x to +1
2636 $x->bone('-'); # set $x to -1
b3abae2a
JH
2637 $x->binf(); # set $x to inf
2638 $x->binf('-'); # set $x to -inf
58cde26e
JH
2639
2640 $x->bneg(); # negation
2641 $x->babs(); # absolute value
2642 $x->bnorm(); # normalize (no-op)
2643 $x->bnot(); # two's complement (bit wise not)
2644 $x->binc(); # increment x by 1
2645 $x->bdec(); # decrement x by 1
2646
2647 $x->badd($y); # addition (add $y to $x)
2648 $x->bsub($y); # subtraction (subtract $y from $x)
2649 $x->bmul($y); # multiplication (multiply $x by $y)
2650 $x->bdiv($y); # divide, set $x to quotient
2651 # return (quo,rem) or quo if scalar
2652
2653 $x->bmod($y); # modulus (x % y)
07d34614
T
2654 $x->bmodpow($exp,$mod); # modular exponentation (($num**$exp) % $mod))
2655 $x->bmodinv($mod); # the inverse of $x in the given modulus $mod
d614cd8b 2656
58cde26e
JH
2657 $x->bpow($y); # power of arguments (x ** y)
2658 $x->blsft($y); # left shift
2659 $x->brsft($y); # right shift
2660 $x->blsft($y,$n); # left shift, by base $n (like 10)
2661 $x->brsft($y,$n); # right shift, by base $n (like 10)
2662
2663 $x->band($y); # bitwise and
2664 $x->bior($y); # bitwise inclusive or
2665 $x->bxor($y); # bitwise exclusive or
2666 $x->bnot(); # bitwise not (two's complement)
2667
2668 $x->bsqrt(); # calculate square-root
b3abae2a 2669 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
58cde26e
JH
2670
2671 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
2672 $x->bround($N); # accuracy: preserve $N digits
2673 $x->bfround($N); # round to $Nth digit, no-op for BigInts
2674
2675 # The following do not modify their arguments in BigInt, but do in BigFloat:
2676 $x->bfloor(); # return integer less or equal than $x
2677 $x->bceil(); # return integer greater or equal than $x
2678
2679 # The following do not modify their arguments:
2680
dccbb853
JH
2681 bgcd(@values); # greatest common divisor (no OO style)
2682 blcm(@values); # lowest common multiplicator (no OO style)
bd05a461 2683
58cde26e 2684 $x->length(); # return number of digits in number
bd05a461
JH
2685 ($x,$f) = $x->length(); # length of number and length of fraction part,
2686 # latter is always 0 digits long for BigInt's
58cde26e
JH
2687
2688 $x->exponent(); # return exponent as BigInt
ee15d750 2689 $x->mantissa(); # return (signed) mantissa as BigInt
58cde26e 2690 $x->parts(); # return (mantissa,exponent) as BigInt
0716bf9b
JH
2691 $x->copy(); # make a true copy of $x (unlike $y = $x;)
2692 $x->as_number(); # return as BigInt (in BigInt: same as copy())
bd05a461
JH
2693
2694 # conversation to string
2695 $x->bstr(); # normalized string
2696 $x->bsstr(); # normalized string in scientific notation
2697 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
2698 $x->as_bin(); # as signed binary string with prefixed 0b
8f675a64
JH
2699
2700 Math::BigInt->config(); # return hash containing configuration/version
bd05a461 2701
a5f75d66
AD
2702=head1 DESCRIPTION
2703
58cde26e
JH
2704All operators (inlcuding basic math operations) are overloaded if you
2705declare your big integers as
a5f75d66 2706
58cde26e 2707 $i = new Math::BigInt '123_456_789_123_456_789';
a5f75d66 2708
58cde26e
JH
2709Operations with overloaded operators preserve the arguments which is
2710exactly what you expect.
a5f75d66
AD
2711
2712=over 2
2713
2714=item Canonical notation
2715
58cde26e 2716Big integer values are strings of the form C</^[+-]\d+$/> with leading
a5f75d66
AD
2717zeros suppressed.
2718
58cde26e
JH
2719 '-0' canonical value '-0', normalized '0'
2720 ' -123_123_123' canonical value '-123123123'
2721 '1_23_456_7890' canonical value '1234567890'
2722
a5f75d66
AD
2723=item Input
2724
58cde26e
JH
2725Input values to these routines may be either Math::BigInt objects or
2726strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
2727
2728You can include one underscore between any two digits.
2729
2730This means integer values like 1.01E2 or even 1000E-2 are also accepted.
2731Non integer values result in NaN.
2732
2733Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
2734in 'NaN'.
2735
2736bnorm() on a BigInt object is now effectively a no-op, since the numbers
2737are always stored in normalized form. On a string, it creates a BigInt
2738object.
a5f75d66
AD
2739
2740=item Output
2741
58cde26e
JH
2742Output values are BigInt objects (normalized), except for bstr(), which
2743returns a string in normalized form.
2744Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2745C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2746return either undef, <0, 0 or >0 and are suited for sort.
a5f75d66
AD
2747
2748=back
2749
b3abae2a
JH
2750=head1 METHODS
2751
2752Each of the methods below accepts three additional parameters. These arguments
2753$A, $P and $R are accuracy, precision and round_mode. Please see more in the
2754section about ACCURACY and ROUNDIND.
2755
8f675a64
JH
2756=head2 config
2757
2758 use Data::Dumper;
2759
2760 print Dumper ( Math::BigInt->config() );
2761
2762Returns a hash containing the configuration, e.g. the version number, lib
2763loaded etc.
2764
13a12e00
JH
2765=head2 accuracy
2766
2767 $x->accuracy(5); # local for $x
2768 $class->accuracy(5); # global for all members of $class
2769
2770Set or get the global or local accuracy, aka how many significant digits the
2771results have. Please see the section about L<ACCURACY AND PRECISION> for
2772further details.
2773
2774Value must be greater than zero. Pass an undef value to disable it:
2775
2776 $x->accuracy(undef);
2777 Math::BigInt->accuracy(undef);
2778
2779Returns the current accuracy. For C<$x->accuracy()> it will return either the
2780local accuracy, or if not defined, the global. This means the return value
2781represents the accuracy that will be in effect for $x:
2782
2783 $y = Math::BigInt->new(1234567); # unrounded
2784 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
2785 $x = Math::BigInt->new(123456); # will be automatically rounded
2786 print "$x $y\n"; # '123500 1234567'
2787 print $x->accuracy(),"\n"; # will be 4
2788 print $y->accuracy(),"\n"; # also 4, since global is 4
2789 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
2790 print $x->accuracy(),"\n"; # still 4
2791 print $y->accuracy(),"\n"; # 5, since global is 5
2792
b3abae2a
JH
2793=head2 brsft
2794
2795 $x->brsft($y,$n);
2796
2797Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
27982, but others work, too.
2799
2800Right shifting usually amounts to dividing $x by $n ** $y and truncating the
2801result:
2802
2803
2804 $x = Math::BigInt->new(10);
2805 $x->brsft(1); # same as $x >> 1: 5
2806 $x = Math::BigInt->new(1234);
2807 $x->brsft(2,10); # result 12
2808
2809There is one exception, and that is base 2 with negative $x:
2810
2811
2812 $x = Math::BigInt->new(-5);
2813 print $x->brsft(1);
2814
2815This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
2816result).
2817
2818=head2 new
2819
2820 $x = Math::BigInt->new($str,$A,$P,$R);
2821
2822Creates a new BigInt object from a string or another BigInt object. The
2823input is accepted as decimal, hex (with leading '0x') or binary (with leading
2824'0b').
2825
2826=head2 bnan
2827
2828 $x = Math::BigInt->bnan();
2829
2830Creates a new BigInt object representing NaN (Not A Number).
2831If used on an object, it will set it to NaN:
2832
2833 $x->bnan();
2834
2835=head2 bzero
2836
2837 $x = Math::BigInt->bzero();
2838
2839Creates a new BigInt object representing zero.
2840If used on an object, it will set it to zero:
2841
2842 $x->bzero();
2843
2844=head2 binf
2845
2846 $x = Math::BigInt->binf($sign);
2847
2848Creates a new BigInt object representing infinity. The optional argument is
2849either '-' or '+', indicating whether you want infinity or minus infinity.
2850If used on an object, it will set it to infinity:
2851
2852 $x->binf();
2853 $x->binf('-');
2854
2855=head2 bone
2856
2857 $x = Math::BigInt->binf($sign);
2858
2859Creates a new BigInt object representing one. The optional argument is
2860either '-' or '+', indicating whether you want one or minus one.
2861If used on an object, it will set it to one:
2862
2863 $x->bone(); # +1
2864 $x->bone('-'); # -1
2865
56b9c951
JH
2866=head2 is_one()/is_zero()/is_nan()/is_inf()
2867
b3abae2a
JH
2868
2869 $x->is_zero(); # true if arg is +0
2870 $x->is_nan(); # true if arg is NaN
2871 $x->is_one(); # true if arg is +1
2872 $x->is_one('-'); # true if arg is -1
b3abae2a
JH
2873 $x->is_inf(); # true if +inf
2874 $x->is_inf('-'); # true if -inf (sign is default '+')
56b9c951
JH
2875
2876These methods all test the BigInt for beeing one specific value and return
2877true or false depending on the input. These are faster than doing something
2878like:
2879
2880 if ($x == 0)
2881
2882=head2 is_positive()/is_negative()
2883
2884 $x->is_positive(); # true if >= 0
2885 $x->is_negative(); # true if < 0
2886
2887The methods return true if the argument is positive or negative, respectively.
2888C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
2889C<-inf> is negative. A C<zero> is positive.
2890
2891These methods are only testing the sign, and not the value.
2892
2893=head2 is_odd()/is_even()/is_int()
2894
2895 $x->is_odd(); # true if odd, false for even
2896 $x->is_even(); # true if even, false for odd
b3abae2a
JH
2897 $x->is_int(); # true if $x is an integer
2898
56b9c951
JH
2899The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
2900C<-inf> are not integers and are neither odd nor even.
b3abae2a
JH
2901
2902=head2 bcmp
2903
56b9c951
JH
2904 $x->bcmp($y);
2905
2906Compares $x with $y and takes the sign into account.
2907Returns -1, 0, 1 or undef.
b3abae2a
JH
2908
2909=head2 bacmp
2910
56b9c951
JH
2911 $x->bacmp($y);
2912
2913Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
b3abae2a
JH
2914
2915=head2 sign
2916
56b9c951
JH
2917 $x->sign();
2918
2919Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
b3abae2a
JH
2920
2921=head2 bcmp
2922
2923 $x->digit($n); # return the nth digit, counting from right
2924
2925=head2 bneg
2926
2927 $x->bneg();
2928
2929Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
2930and '-inf', respectively. Does nothing for NaN or zero.
2931
2932=head2 babs
2933
2934 $x->babs();
2935
2936Set the number to it's absolute value, e.g. change the sign from '-' to '+'
2937and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
2938numbers.
2939
2940=head2 bnorm
2941
2942 $x->bnorm(); # normalize (no-op)
2943
2944=head2 bnot
2945
2946 $x->bnot(); # two's complement (bit wise not)
2947
2948=head2 binc
2949
2950 $x->binc(); # increment x by 1
2951
2952=head2 bdec
2953
2954 $x->bdec(); # decrement x by 1
2955
2956=head2 badd
2957
2958 $x->badd($y); # addition (add $y to $x)
2959
2960=head2 bsub
2961
2962 $x->bsub($y); # subtraction (subtract $y from $x)
2963
2964=head2 bmul
2965
2966 $x->bmul($y); # multiplication (multiply $x by $y)
2967
2968=head2 bdiv
2969
2970 $x->bdiv($y); # divide, set $x to quotient
2971 # return (quo,rem) or quo if scalar
2972
2973=head2 bmod
2974
2975 $x->bmod($y); # modulus (x % y)
2976
d614cd8b
JH
2977=head2 bmodinv
2978
1ddff52a 2979 $num->bmodinv($mod); # modular inverse
d614cd8b
JH
2980
2981Returns the inverse of C<$num> in the given modulus C<$mod>. 'C<NaN>' is
2982returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
2983C<bgcd($num, $mod)==1>.
2984
2985=head2 bmodpow
2986
1ddff52a 2987 $num->bmodpow($exp,$mod); # modular exponentation ($num**$exp % $mod)
d614cd8b
JH
2988
2989Returns the value of C<$num> taken to the power C<$exp> in the modulus
2990C<$mod> using binary exponentation. C<bmodpow> is far superior to
2991writing
2992
2993 $num ** $exp % $mod
2994
2995because C<bmodpow> is much faster--it reduces internal variables into
2996the modulus whenever possible, so it operates on smaller numbers.
2997
2998C<bmodpow> also supports negative exponents.
2999
3000 bmodpow($num, -1, $mod)
3001
3002is exactly equivalent to
3003
3004 bmodinv($num, $mod)
3005
b3abae2a
JH
3006=head2 bpow
3007
3008 $x->bpow($y); # power of arguments (x ** y)
3009
3010=head2 blsft
3011
3012 $x->blsft($y); # left shift
3013 $x->blsft($y,$n); # left shift, by base $n (like 10)
3014
3015=head2 brsft
3016
3017 $x->brsft($y); # right shift
3018 $x->brsft($y,$n); # right shift, by base $n (like 10)
3019
3020=head2 band
3021
3022 $x->band($y); # bitwise and
3023
3024=head2 bior
3025
3026 $x->bior($y); # bitwise inclusive or
3027
3028=head2 bxor
3029
3030 $x->bxor($y); # bitwise exclusive or
3031
3032=head2 bnot
3033
3034 $x->bnot(); # bitwise not (two's complement)
3035
3036=head2 bsqrt
3037
3038 $x->bsqrt(); # calculate square-root
3039
3040=head2 bfac
3041
3042 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
3043
3044=head2 round
3045
3046 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
3047
3048=head2 bround
3049
3050 $x->bround($N); # accuracy: preserve $N digits
3051
3052=head2 bfround
3053
3054 $x->bfround($N); # round to $Nth digit, no-op for BigInts
3055
3056=head2 bfloor
3057
3058 $x->bfloor();
3059
3060Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
3061does change $x in BigFloat.
3062
3063=head2 bceil
3064
3065 $x->bceil();
3066
3067Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
3068does change $x in BigFloat.
3069
3070=head2 bgcd
3071
3072 bgcd(@values); # greatest common divisor (no OO style)
3073
3074=head2 blcm
3075
3076 blcm(@values); # lowest common multiplicator (no OO style)
3077
3078head2 length
3079
3080 $x->length();
3081 ($xl,$fl) = $x->length();
3082
3083Returns the number of digits in the decimal representation of the number.
3084In list context, returns the length of the integer and fraction part. For
3085BigInt's, the length of the fraction part will always be 0.
3086
3087=head2 exponent
3088
3089 $x->exponent();
3090
3091Return the exponent of $x as BigInt.
3092
3093=head2 mantissa
3094
3095 $x->mantissa();
3096
3097Return the signed mantissa of $x as BigInt.
3098
3099=head2 parts
3100
3101 $x->parts(); # return (mantissa,exponent) as BigInt
3102
3103=head2 copy
3104
3105 $x->copy(); # make a true copy of $x (unlike $y = $x;)
3106
3107=head2 as_number
3108
3109 $x->as_number(); # return as BigInt (in BigInt: same as copy())
3110
3111=head2 bsrt
3112
3113 $x->bstr(); # normalized string
3114
3115=head2 bsstr
3116
3117 $x->bsstr(); # normalized string in scientific notation
3118
3119=head2 as_hex
3120
3121 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
3122
3123=head2 as_bin
3124
3125 $x->as_bin(); # as signed binary string with prefixed 0b
3126
0716bf9b
JH
3127=head1 ACCURACY and PRECISION
3128
b22b3e31 3129Since version v1.33, Math::BigInt and Math::BigFloat have full support for
0716bf9b 3130accuracy and precision based rounding, both automatically after every
b22b3e31 3131operation as well as manually.
0716bf9b
JH
3132
3133This section describes the accuracy/precision handling in Math::Big* as it
b22b3e31 3134used to be and as it is now, complete with an explanation of all terms and
0716bf9b
JH
3135abbreviations.
3136
3137Not yet implemented things (but with correct description) are marked with '!',
3138things that need to be answered are marked with '?'.
3139
3140In the next paragraph follows a short description of terms used here (because
574bacfe 3141these may differ from terms used by others people or documentation).
0716bf9b 3142
b22b3e31 3143During the rest of this document, the shortcuts A (for accuracy), P (for
0716bf9b
JH
3144precision), F (fallback) and R (rounding mode) will be used.
3145
3146=head2 Precision P
3147
3148A fixed number of digits before (positive) or after (negative)
b22b3e31
PN
3149the decimal point. For example, 123.45 has a precision of -2. 0 means an
3150integer like 123 (or 120). A precision of 2 means two digits to the left
3151of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
3152numbers with zeros before the decimal point may have different precisions,
3153because 1200 can have p = 0, 1 or 2 (depending on what the inital value
3154was). It could also have p < 0, when the digits after the decimal point
3155are zero.
0716bf9b 3156
574bacfe
JH
3157The string output (of floating point numbers) will be padded with zeros:
3158
3159 Initial value P A Result String
3160 ------------------------------------------------------------
3161 1234.01 -3 1000 1000
3162 1234 -2 1200 1200
3163 1234.5 -1 1230 1230
3164 1234.001 1 1234 1234.0
3165 1234.01 0 1234 1234
3166 1234.01 2 1234.01 1234.01
3167 1234.01 5 1234.01 1234.01000
3168
3169For BigInts, no padding occurs.
0716bf9b
JH
3170
3171=head2 Accuracy A
3172
3173Number of significant digits. Leading zeros are not counted. A
3174number may have an accuracy greater than the non-zero digits
b22b3e31
PN
3175when there are zeros in it or trailing zeros. For example, 123.456 has
3176A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
0716bf9b 3177
574bacfe
JH
3178The string output (of floating point numbers) will be padded with zeros:
3179
3180 Initial value P A Result String
3181 ------------------------------------------------------------
3182 1234.01 3 1230 1230
3183 1234.01 6 1234.01 1234.01
3184 1234.1 8 1234.1 1234.1000
3185
3186For BigInts, no padding occurs.
3187
0716bf9b 3188=head2 Fallback F
a5f75d66 3189
574bacfe
JH
3190When both A and P are undefined, this is used as a fallback accuracy when
3191dividing numbers.
0716bf9b
JH
3192
3193=head2 Rounding mode R
3194
3195When rounding a number, different 'styles' or 'kinds'
3196of rounding are possible. (Note that random rounding, as in
3197Math::Round, is not implemented.)
58cde26e
JH
3198
3199=over 2
a5f75d66 3200
0716bf9b
JH
3201=item 'trunc'
3202
3203truncation invariably removes all digits following the
3204rounding place, replacing them with zeros. Thus, 987.65 rounded
b22b3e31 3205to tens (P=1) becomes 980, and rounded to the fourth sigdig
0716bf9b 3206becomes 987.6 (A=4). 123.456 rounded to the second place after the
b22b3e31 3207decimal point (P=-2) becomes 123.46.
0716bf9b
JH
3208
3209All other implemented styles of rounding attempt to round to the
3210"nearest digit." If the digit D immediately to the right of the
3211rounding place (skipping the decimal point) is greater than 5, the
3212number is incremented at the rounding place (possibly causing a
3213cascade of incrementation): e.g. when rounding to units, 0.9 rounds
3214to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
3215truncated at the rounding place: e.g. when rounding to units, 0.4
3216rounds to 0, and -19.4 rounds to -19.
3217
3218However the results of other styles of rounding differ if the
3219digit immediately to the right of the rounding place (skipping the
3220decimal point) is 5 and if there are no digits, or no digits other
3221than 0, after that 5. In such cases:
3222
3223=item 'even'
3224
3225rounds the digit at the rounding place to 0, 2, 4, 6, or 8
3226if it is not already. E.g., when rounding to the first sigdig, 0.45
3227becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
3228
3229=item 'odd'
3230
3231rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
3232it is not already. E.g., when rounding to the first sigdig, 0.45
3233becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
3234
3235=item '+inf'
3236
3237round to plus infinity, i.e. always round up. E.g., when
3238rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
b22b3e31 3239and 0.4501 also becomes 0.5.
0716bf9b
JH
3240
3241=item '-inf'
3242
3243round to minus infinity, i.e. always round down. E.g., when
3244rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
3245but 0.4501 becomes 0.5.
3246
3247=item 'zero'
3248
3249round to zero, i.e. positive numbers down, negative ones up.
3250E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
3251becomes -0.5, but 0.4501 becomes 0.5.
3252
3253=back
3254
3255The handling of A & P in MBI/MBF (the old core code shipped with Perl
3256versions <= 5.7.2) is like this:
3257
3258=over 2
a5f75d66 3259
0716bf9b
JH
3260=item Precision
3261
b22b3e31
PN
3262 * ffround($p) is able to round to $p number of digits after the decimal
3263 point
0716bf9b
JH
3264 * otherwise P is unused
3265
3266=item Accuracy (significant digits)
3267
3268 * fround($a) rounds to $a significant digits
3269 * only fdiv() and fsqrt() take A as (optional) paramater
b22b3e31 3270 + other operations simply create the same number (fneg etc), or more (fmul)
0716bf9b
JH
3271 of digits
3272 + rounding/truncating is only done when explicitly calling one of fround
3273 or ffround, and never for BigInt (not implemented)
b22b3e31 3274 * fsqrt() simply hands its accuracy argument over to fdiv.
0716bf9b
JH
3275 * the documentation and the comment in the code indicate two different ways
3276 on how fdiv() determines the maximum number of digits it should calculate,
3277 and the actual code does yet another thing
3278 POD:
3279 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
3280 Comment:
3281 result has at most max(scale, length(dividend), length(divisor)) digits
3282 Actual code:
3283 scale = max(scale, length(dividend)-1,length(divisor)-1);
3284 scale += length(divisior) - length(dividend);
b22b3e31 3285 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
0716bf9b
JH
3286 Actually, the 'difference' added to the scale is calculated from the
3287 number of "significant digits" in dividend and divisor, which is derived
3288 by looking at the length of the mantissa. Which is wrong, since it includes
3289 the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
3290 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
3291 assumption that 124 has 3 significant digits, while 120/7 will get you
3292 '17', not '17.1' since 120 is thought to have 2 significant digits.
dccbb853 3293 The rounding after the division then uses the remainder and $y to determine
0716bf9b 3294 wether it must round up or down.
b22b3e31
PN
3295 ? I have no idea which is the right way. That's why I used a slightly more
3296 ? simple scheme and tweaked the few failing testcases to match it.
58cde26e 3297
0716bf9b 3298=back
5dc6f178 3299
0716bf9b 3300This is how it works now:
5dc6f178 3301
0716bf9b 3302=over 2
5dc6f178 3303
0716bf9b
JH
3304=item Setting/Accessing
3305
b3abae2a
JH
3306 * You can set the A global via Math::BigInt->accuracy() or
3307 Math::BigFloat->accuracy() or whatever class you are using.
3308 * You can also set P globally by using Math::SomeClass->precision() likewise.
0716bf9b 3309 * Globals are classwide, and not inherited by subclasses.
b3abae2a
JH
3310 * to undefine A, use Math::SomeCLass->accuracy(undef);
3311 * to undefine P, use Math::SomeClass->precision(undef);
3312 * Setting Math::SomeClass->accuracy() clears automatically
3313 Math::SomeClass->precision(), and vice versa.
0716bf9b 3314 * To be valid, A must be > 0, P can have any value.
b22b3e31
PN
3315 * If P is negative, this means round to the P'th place to the right of the
3316 decimal point; positive values mean to the left of the decimal point.
3317 P of 0 means round to integer.
b3abae2a
JH
3318 * to find out the current global A, take Math::SomeClass->accuracy()
3319 * to find out the current global P, take Math::SomeClass->precision()
3320 * use $x->accuracy() respective $x->precision() for the local setting of $x.
3321 * Please note that $x->accuracy() respecive $x->precision() fall back to the
3322 defined globals, when $x's A or P is not set.
0716bf9b
JH
3323
3324=item Creating numbers
3325
b3abae2a
JH
3326 * When you create a number, you can give it's desired A or P via:
3327 $x = Math::BigInt->new($number,$A,$P);
3328 * Only one of A or P can be defined, otherwise the result is NaN
3329 * If no A or P is give ($x = Math::BigInt->new($number) form), then the
3330 globals (if set) will be used. Thus changing the global defaults later on
b22b3e31 3331 will not change the A or P of previously created numbers (i.e., A and P of
b3abae2a
JH
3332 $x will be what was in effect when $x was created)
3333 * If given undef for A and P, B<no> rounding will occur, and the globals will
3334 B<not> be used. This is used by subclasses to create numbers without
3335 suffering rounding in the parent. Thus a subclass is able to have it's own
3336 globals enforced upon creation of a number by using
3337 $x = Math::BigInt->new($number,undef,undef):
3338
3339 use Math::Bigint::SomeSubclass;
3340 use Math::BigInt;
3341
3342 Math::BigInt->accuracy(2);
3343 Math::BigInt::SomeSubClass->accuracy(3);
3344 $x = Math::BigInt::SomeSubClass->new(1234);
3345
3346 $x is now 1230, and not 1200. A subclass might choose to implement
3347 this otherwise, e.g. falling back to the parent's A and P.
0716bf9b
JH
3348
3349=item Usage
3350
b22b3e31 3351 * If A or P are enabled/defined, they are used to round the result of each
0716bf9b 3352 operation according to the rules below
b22b3e31
PN
3353 * Negative P is ignored in Math::BigInt, since BigInts never have digits
3354 after the decimal point
574bacfe
JH
3355 * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
3356 Math::BigInt as globals should not tamper with the parts of a BigFloat.
3357 Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
0716bf9b
JH
3358
3359=item Precedence
3360
b22b3e31
PN
3361 * It only makes sense that a number has only one of A or P at a time.
3362 Since you can set/get both A and P, there is a rule that will practically
3363 enforce only A or P to be in effect at a time, even if both are set.
3364 This is called precedence.
b3abae2a
JH
3365 * If two objects are involved in an operation, and one of them has A in
3366 effect, and the other P, this results in an error (NaN).
0716bf9b 3367 * A takes precendence over P (Hint: A comes before P). If A is defined, it
b22b3e31
PN
3368 is used, otherwise P is used. If neither of them is defined, nothing is
3369 used, i.e. the result will have as many digits as it can (with an
3370 exception for fdiv/fsqrt) and will not be rounded.
3371 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
3372 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
3373 If either the dividend's or the divisor's mantissa has more digits than
3374 the value of F, the higher value will be used instead of F.
3375 This is to limit the digits (A) of the result (just consider what would
3376 happen with unlimited A and P in the case of 1/3 :-)
b3abae2a 3377 * fdiv will calculate (at least) 4 more digits than required (determined by
0716bf9b 3378 A, P or F), and, if F is not used, round the result
b22b3e31 3379 (this will still fail in the case of a result like 0.12345000000001 with A
574bacfe 3380 or P of 5, but this can not be helped - or can it?)
b22b3e31 3381 * Thus you can have the math done by on Math::Big* class in three modes:
0716bf9b
JH
3382 + never round (this is the default):
3383 This is done by setting A and P to undef. No math operation
b22b3e31 3384 will round the result, with fdiv() and fsqrt() as exceptions to guard
0716bf9b 3385 against overflows. You must explicitely call bround(), bfround() or
b22b3e31
PN
3386 round() (the latter with parameters).
3387 Note: Once you have rounded a number, the settings will 'stick' on it
3388 and 'infect' all other numbers engaged in math operations with it, since
0716bf9b
JH
3389 local settings have the highest precedence. So, to get SaferRound[tm],
3390 use a copy() before rounding like this:
3391
3392 $x = Math::BigFloat->new(12.34);
3393 $y = Math::BigFloat->new(98.76);
3394 $z = $x * $y; # 1218.6984
3395 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
3396 $z = $x * $y; # still 1218.6984, without
3397 # copy would have been 1210!
3398
3399 + round after each op:
b22b3e31
PN
3400 After each single operation (except for testing like is_zero()), the
3401 method round() is called and the result is rounded appropriately. By
0716bf9b 3402 setting proper values for A and P, you can have all-the-same-A or
b22b3e31
PN
3403 all-the-same-P modes. For example, Math::Currency might set A to undef,
3404 and P to -2, globally.
0716bf9b 3405
b22b3e31
PN
3406 ?Maybe an extra option that forbids local A & P settings would be in order,
3407 ?so that intermediate rounding does not 'poison' further math?
0716bf9b
JH
3408
3409=item Overriding globals
3410
3411 * you will be able to give A, P and R as an argument to all the calculation
b22b3e31 3412 routines; the second parameter is A, the third one is P, and the fourth is
b3abae2a 3413 R (shift right by one for binary operations like badd). P is used only if
b22b3e31
PN
3414 the first parameter (A) is undefined. These three parameters override the
3415 globals in the order detailed as follows, i.e. the first defined value
0716bf9b 3416 wins:
b22b3e31 3417 (local: per object, global: global default, parameter: argument to sub)
0716bf9b
JH
3418 + parameter A
3419 + parameter P
3420 + local A (if defined on both of the operands: smaller one is taken)
b3abae2a 3421 + local P (if defined on both of the operands: bigger one is taken)
0716bf9b
JH
3422 + global A
3423 + global P
3424 + global F
b22b3e31 3425 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
0716bf9b
JH
3426 arguments (A and P) instead of one
3427
3428=item Local settings
3429
3430 * You can set A and P locally by using $x->accuracy() and $x->precision()
3431 and thus force different A and P for different objects/numbers.
b22b3e31 3432 * Setting A or P this way immediately rounds $x to the new value.
b3abae2a 3433 * $x->accuracy() clears $x->precision(), and vice versa.
0716bf9b
JH
3434
3435=item Rounding
3436
b22b3e31 3437 * the rounding routines will use the respective global or local settings.
0716bf9b
JH
3438 fround()/bround() is for accuracy rounding, while ffround()/bfround()
3439 is for precision
3440 * the two rounding functions take as the second parameter one of the
3441 following rounding modes (R):
3442 'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
3443 * you can set and get the global R by using Math::SomeClass->round_mode()
ee15d750 3444 or by setting $Math::SomeClass::round_mode
0716bf9b 3445 * after each operation, $result->round() is called, and the result may
b22b3e31
PN
3446 eventually be rounded (that is, if A or P were set either locally,
3447 globally or as parameter to the operation)
ee15d750 3448 * to manually round a number, call $x->round($A,$P,$round_mode);
b22b3e31 3449 this will round the number by using the appropriate rounding function
0716bf9b 3450 and then normalize it.
b22b3e31 3451 * rounding modifies the local settings of the number:
0716bf9b
JH
3452
3453 $x = Math::BigFloat->new(123.456);
3454 $x->accuracy(5);
3455 $x->bround(4);
3456
3457 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
3458 will be 4 from now on.
3459
3460=item Default values
3461
3462 * R: 'even'
3463 * F: 40
3464 * A: undef
3465 * P: undef
3466
3467=item Remarks
3468
3469 * The defaults are set up so that the new code gives the same results as
3470 the old code (except in a few cases on fdiv):
3471 + Both A and P are undefined and thus will not be used for rounding
3472 after each operation.
3473 + round() is thus a no-op, unless given extra parameters A and P
58cde26e
JH
3474
3475=back
3476
0716bf9b
JH
3477=head1 INTERNALS
3478
574bacfe
JH
3479The actual numbers are stored as unsigned big integers (with seperate sign).
3480You should neither care about nor depend on the internal representation; it
3481might change without notice. Use only method calls like C<< $x->sign(); >>
3482instead relying on the internal hash keys like in C<< $x->{sign}; >>.
3483
3484=head2 MATH LIBRARY
58cde26e 3485
574bacfe
JH
3486Math with the numbers is done (by default) by a module called
3487Math::BigInt::Calc. This is equivalent to saying:
3488
3489 use Math::BigInt lib => 'Calc';
58cde26e 3490
0716bf9b 3491You can change this by using:
58cde26e 3492
0716bf9b 3493 use Math::BigInt lib => 'BitVect';
58cde26e 3494
574bacfe
JH
3495The following would first try to find Math::BigInt::Foo, then
3496Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
0716bf9b 3497
574bacfe 3498 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
58cde26e 3499
574bacfe 3500Calc.pm uses as internal format an array of elements of some decimal base
b3abae2a
JH
3501(usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm
3502uses a bit vector of base 2, most significant bit first. Other modules might
3503use even different means of representing the numbers. See the respective
3504module documentation for further details.
58cde26e 3505
574bacfe
JH
3506=head2 SIGN
3507
3508The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
3509
3510A sign of 'NaN' is used to represent the result when input arguments are not
3511numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
3512minus infinity. You will get '+inf' when dividing a positive number by 0, and
3513'-inf' when dividing any negative number by 0.
58cde26e
JH
3514
3515=head2 mantissa(), exponent() and parts()
3516
3517C<mantissa()> and C<exponent()> return the said parts of the BigInt such
3518that:
3519
3520 $m = $x->mantissa();
3521 $e = $x->exponent();
3522 $y = $m * ( 10 ** $e );
3523 print "ok\n" if $x == $y;
3524
b22b3e31
PN
3525C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
3526in one go. Both the returned mantissa and exponent have a sign.
58cde26e 3527
574bacfe
JH
3528Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
3529where it will be NaN; and for $x == 0, where it will be 1
3530(to be compatible with Math::BigFloat's internal representation of a zero as
3531C<0E1>).
58cde26e
JH
3532
3533C<$m> will always be a copy of the original number. The relation between $e
b22b3e31 3534and $m might change in the future, but will always be equivalent in a
0716bf9b
JH
3535numerical sense, e.g. $m might get minimized.
3536
58cde26e
JH
3537=head1 EXAMPLES
3538
394e6ffb 3539 use Math::BigInt;
574bacfe
JH
3540
3541 sub bint { Math::BigInt->new(shift); }
3542
394e6ffb 3543 $x = Math::BigInt->bstr("1234") # string "1234"
58cde26e 3544 $x = "$x"; # same as bstr()
58cde26e
JH
3545 $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
3546 $x = Math::BigInt->babs("-12345"); # Bigint "12345"
3547 $x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
3548 $x = bint(1) + bint(2); # BigInt "3"
3549 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
3550 $x = bint(1); # BigInt "1"
3551 $x = $x + 5 / 2; # BigInt "3"
3552 $x = $x ** 3; # BigInt "27"
3553 $x *= 2; # BigInt "54"
394e6ffb 3554 $x = Math::BigInt->new(0); # BigInt "0"
58cde26e
JH
3555 $x--; # BigInt "-1"
3556 $x = Math::BigInt->badd(4,5) # BigInt "9"
58cde26e 3557 print $x->bsstr(); # 9e+0
a5f75d66 3558
0716bf9b
JH
3559Examples for rounding:
3560
3561 use Math::BigFloat;
3562 use Test;
3563
3564 $x = Math::BigFloat->new(123.4567);
3565 $y = Math::BigFloat->new(123.456789);
394e6ffb 3566 Math::BigFloat->accuracy(4); # no more A than 4
0716bf9b
JH
3567
3568 ok ($x->copy()->fround(),123.4); # even rounding
3569 print $x->copy()->fround(),"\n"; # 123.4
3570 Math::BigFloat->round_mode('odd'); # round to odd
3571 print $x->copy()->fround(),"\n"; # 123.5
394e6ffb 3572 Math::BigFloat->accuracy(5); # no more A than 5
0716bf9b
JH
3573 Math::BigFloat->round_mode('odd'); # round to odd
3574 print $x->copy()->fround(),"\n"; # 123.46
3575 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
3576 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
3577
394e6ffb
JH
3578 Math::BigFloat->accuracy(undef); # A not important now
3579 Math::BigFloat->precision(2); # P important
3580 print $x->copy()->bnorm(),"\n"; # 123.46
3581 print $x->copy()->fround(),"\n"; # 123.46
0716bf9b 3582
bd05a461
JH
3583Examples for converting:
3584
3585 my $x = Math::BigInt->new('0b1'.'01' x 123);
3586 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
3587
b3ac6de7
IZ
3588=head1 Autocreating constants
3589
56b9c951
JH
3590After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
3591and binary constants in the given scope are converted to C<Math::BigInt>.
3592This conversion happens at compile time.
b3ac6de7 3593
b22b3e31 3594In particular,
b3ac6de7 3595
58cde26e
JH
3596 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
3597
56b9c951 3598prints the integer value of C<2**100>. Note that without conversion of
0716bf9b 3599constants the expression 2**100 will be calculated as perl scalar.
58cde26e
JH
3600
3601Please note that strings and floating point constants are not affected,
3602so that
3603
3604 use Math::BigInt qw/:constant/;
3605
3606 $x = 1234567890123456789012345678901234567890
3607 + 123456789123456789;
b22b3e31 3608 $y = '1234567890123456789012345678901234567890'
58cde26e 3609 + '123456789123456789';
b3ac6de7 3610
b22b3e31 3611do not work. You need an explicit Math::BigInt->new() around one of the
394e6ffb
JH
3612operands. You should also quote large constants to protect loss of precision:
3613
3614 use Math::Bigint;
3615
3616 $x = Math::BigInt->new('1234567889123456789123456789123456789');
3617
3618Without the quotes Perl would convert the large number to a floating point
3619constant at compile time and then hand the result to BigInt, which results in
3620an truncated result or a NaN.
58cde26e 3621
56b9c951
JH
3622This also applies to integers that look like floating point constants:
3623
3624 use Math::BigInt ':constant';
3625
3626 print ref(123e2),"\n";
3627 print ref(123.2e2),"\n";
3628
3629will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
3630to get this to work.
3631
58cde26e
JH