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