projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to Math::BigInt 1.40.
[p5sagit/p5-mst-13.2.git] / lib / Math / BigInt.pm
CommitLineData
58cde26e 1#!/usr/bin/perl -w
2
58cde26e 3# Qs: what exactly happens on numify of HUGE numbers? overflow?
4# $a = -$a is much slower (making copy of $a) than $a->bneg(), hm!?
5# (copy_on_write will help there, but that is not yet implemented)
6
7# The following hash values are used:
0716bf9b 8# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
58cde26e 9# sign : +,-,NaN,+inf,-inf
10# _a : accuracy
11# _p : precision
0716bf9b 12# _f : flags, used by MBF to flag parts of a float as untouchable
58cde26e 13# _cow : copy on write: number of objects that share the data (NRY)
b4f14daa 14
574bacfe 15# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
16# underlying lib might change the reference!
17
58cde26e 18package Math::BigInt;
19my $class = "Math::BigInt";
0716bf9b 20require 5.005;
58cde26e 21
574bacfe 22$VERSION = '1.40';
58cde26e 23use Exporter;
24@ISA = qw( Exporter );
25@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
26 bgcd blcm
27 bround
28 blsft brsft band bior bxor bnot bpow bnan bzero
574bacfe 29 bacmp bstr bsstr binc bdec binf bfloor bceil
58cde26e 30 is_odd is_even is_zero is_one is_nan is_inf sign
0716bf9b 31 is_positive is_negative
58cde26e 32 length as_number
0716bf9b 33 objectify _swap
58cde26e 34 );
35
36#@EXPORT = qw( );
37use vars qw/$rnd_mode $accuracy $precision $div_scale/;
38use strict;
39
40# Inside overload, the first arg is always an object. If the original code had
41# it reversed (like $x = 2 * $y), then the third paramater indicates this
42# swapping. To make it work, we use a helper routine which not only reswaps the
43# params, but also makes a new object in this case. See _swap() for details,
44# especially the cases of operators with different classes.
45
46# For overloaded ops with only one argument we simple use $_[0]->copy() to
47# preserve the argument.
48
49# Thus inheritance of overload operators becomes possible and transparent for
50# our subclasses without the need to repeat the entire overload section there.
a0d0e21e 51
a5f75d66 52use overload
58cde26e 53'=' => sub { $_[0]->copy(); },
54
55# '+' and '-' do not use _swap, since it is a triffle slower. If you want to
56# override _swap (if ever), then override overload of '+' and '-', too!
57# for sub it is a bit tricky to keep b: b-a => -a+b
58'-' => sub { my $c = $_[0]->copy; $_[2] ?
59 $c->bneg()->badd($_[1]) :
60 $c->bsub( $_[1]) },
61'+' => sub { $_[0]->copy()->badd($_[1]); },
62
63# some shortcuts for speed (assumes that reversed order of arguments is routed
64# to normal '+' and we thus can always modify first arg. If this is changed,
65# this breaks and must be adjusted.)
66'+=' => sub { $_[0]->badd($_[1]); },
67'-=' => sub { $_[0]->bsub($_[1]); },
68'*=' => sub { $_[0]->bmul($_[1]); },
69'/=' => sub { scalar $_[0]->bdiv($_[1]); },
70'**=' => sub { $_[0]->bpow($_[1]); },
71
72'<=>' => sub { $_[2] ?
73 $class->bcmp($_[1],$_[0]) :
74 $class->bcmp($_[0],$_[1])},
75'cmp' => sub {
76 $_[2] ?
77 $_[1] cmp $_[0]->bstr() :
78 $_[0]->bstr() cmp $_[1] },
79
80'int' => sub { $_[0]->copy(); },
81'neg' => sub { $_[0]->copy()->bneg(); },
82'abs' => sub { $_[0]->copy()->babs(); },
83'~' => sub { $_[0]->copy()->bnot(); },
84
85'*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); },
86'/' => sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);},
87'%' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); },
88'**' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); },
89'<<' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); },
90'>>' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); },
91
92'&' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); },
93'|' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); },
94'^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
95
96# can modify arg of ++ and --, so avoid a new-copy for speed, but don't
574bacfe 97# use $_[0]->__one(), it modifies $_[0] to be 1!
58cde26e 98'++' => sub { $_[0]->binc() },
99'--' => sub { $_[0]->bdec() },
100
101# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
102'bool' => sub {
103 # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
104 # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-(
105 my $t = !$_[0]->is_zero();
106 undef $t if $t == 0;
107 return $t;
108 },
a0d0e21e 109
110qw(
58cde26e 111"" bstr
1120+ numify), # Order of arguments unsignificant
a5f75d66 113;
a0d0e21e 114
58cde26e 115##############################################################################
116# global constants, flags and accessory
117
0716bf9b 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
124sub _core_lib () { return $CALC; } # for test suite
125
126# Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
58cde26e 127$rnd_mode = 'even';
128$accuracy = undef;
129$precision = undef;
130$div_scale = 40;
131
132sub round_mode
133 {
134 # make Class->round_mode() work
135 my $self = shift || $class;
136 # shift @_ if defined $_[0] && $_[0] eq $class;
137 if (defined $_[0])
138 {
139 my $m = shift;
140 die "Unknown round mode $m"
141 if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
142 $rnd_mode = $m; return;
143 }
144 return $rnd_mode;
145 }
146
147sub accuracy
148 {
149 # $x->accuracy($a); ref($x) a
150 # $x->accuracy(); ref($x);
151 # Class::accuracy(); # not supported
152 #print "MBI @_ ($class)\n";
153 my $x = shift;
154
155 die ("accuracy() needs reference to object as first parameter.")
156 if !ref $x;
157
158 if (@_ > 0)
159 {
160 $x->{_a} = shift;
161 $x->round() if defined $x->{_a};
162 }
163 return $x->{_a};
164 }
165
166sub precision
167 {
168 my $x = shift;
169
170 die ("precision() needs reference to object as first parameter.")
171 unless ref $x;
172
173 if (@_ > 0)
174 {
175 $x->{_p} = shift;
176 $x->round() if defined $x->{_p};
177 }
178 return $x->{_p};
179 }
180
181sub _scale_a
182 {
183 # select accuracy parameter based on precedence,
184 # used by bround() and bfround(), may return undef for scale (means no op)
185 my ($x,$s,$m,$scale,$mode) = @_;
186 $scale = $x->{_a} if !defined $scale;
187 $scale = $s if (!defined $scale);
188 $mode = $m if !defined $mode;
189 return ($scale,$mode);
190 }
191
192sub _scale_p
193 {
194 # select precision parameter based on precedence,
195 # used by bround() and bfround(), may return undef for scale (means no op)
196 my ($x,$s,$m,$scale,$mode) = @_;
197 $scale = $x->{_p} if !defined $scale;
198 $scale = $s if (!defined $scale);
199 $mode = $m if !defined $mode;
200 return ($scale,$mode);
201 }
202
203##############################################################################
204# constructors
205
206sub copy
207 {
208 my ($c,$x);
209 if (@_ > 1)
210 {
211 # if two arguments, the first one is the class to "swallow" subclasses
212 ($c,$x) = @_;
213 }
214 else
215 {
216 $x = shift;
217 $c = ref($x);
218 }
219 return unless ref($x); # only for objects
220
221 my $self = {}; bless $self,$c;
222 foreach my $k (keys %$x)
223 {
0716bf9b 224 if ($k eq 'value')
225 {
226 $self->{$k} = $CALC->_copy($x->{$k});
227 }
228 elsif (ref($x->{$k}) eq 'SCALAR')
229 {
230 $self->{$k} = \${$x->{$k}};
231 }
232 elsif (ref($x->{$k}) eq 'ARRAY')
58cde26e 233 {
234 $self->{$k} = [ @{$x->{$k}} ];
235 }
236 elsif (ref($x->{$k}) eq 'HASH')
237 {
238 # only one level deep!
239 foreach my $h (keys %{$x->{$k}})
240 {
241 $self->{$k}->{$h} = $x->{$k}->{$h};
242 }
243 }
244 elsif (ref($x->{$k}))
245 {
246 my $c = ref($x->{$k});
247 $self->{$k} = $c->new($x->{$k}); # no copy() due to deep rec
248 }
249 else
250 {
251 $self->{$k} = $x->{$k};
252 }
253 }
254 $self;
255 }
256
257sub new
258 {
b22b3e31 259 # create a new BigInt object from a string or another BigInt object.
0716bf9b 260 # see hash keys documented at top
58cde26e 261
262 # the argument could be an object, so avoid ||, && etc on it, this would
b22b3e31 263 # cause costly overloaded code to be called. The only allowed ops are
264 # ref() and defined.
58cde26e 265
58cde26e 266 my $class = shift;
267
268 my $wanted = shift; # avoid numify call by not using || here
269 return $class->bzero() if !defined $wanted; # default to 0
270 return $class->copy($wanted) if ref($wanted);
271
272 my $self = {}; bless $self, $class;
273 # handle '+inf', '-inf' first
274 if ($wanted =~ /^[+-]inf$/)
275 {
0716bf9b 276 $self->{value} = $CALC->_zero();
58cde26e 277 $self->{sign} = $wanted;
278 return $self;
279 }
280 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
281 my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
58cde26e 282 if (!ref $mis)
283 {
284 die "$wanted is not a number initialized to $class" if !$NaNOK;
285 #print "NaN 1\n";
0716bf9b 286 $self->{value} = $CALC->_zero();
58cde26e 287 $self->{sign} = $nan;
288 return $self;
289 }
574bacfe 290 if (!ref $miv)
291 {
292 # _from_hex or _from_bin
293 $self->{value} = $mis->{value};
294 $self->{sign} = $mis->{sign};
295 return $self; # throw away $mis
296 }
58cde26e 297 # make integer from mantissa by adjusting exp, then convert to bigint
298 $self->{sign} = $$mis; # store sign
0716bf9b 299 $self->{value} = $CALC->_zero(); # for all the NaN cases
58cde26e 300 my $e = int("$$es$$ev"); # exponent (avoid recursion)
301 if ($e > 0)
302 {
303 my $diff = $e - CORE::length($$mfv);
304 if ($diff < 0) # Not integer
305 {
306 #print "NOI 1\n";
307 $self->{sign} = $nan;
308 }
309 else # diff >= 0
310 {
311 # adjust fraction and add it to value
312 # print "diff > 0 $$miv\n";
313 $$miv = $$miv . ($$mfv . '0' x $diff);
314 }
315 }
316 else
317 {
318 if ($$mfv ne '') # e <= 0
319 {
320 # fraction and negative/zero E => NOI
321 #print "NOI 2 \$\$mfv '$$mfv'\n";
322 $self->{sign} = $nan;
323 }
324 elsif ($e < 0)
325 {
326 # xE-y, and empty mfv
327 #print "xE-y\n";
328 $e = abs($e);
329 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
330 {
331 #print "NOI 3\n";
332 $self->{sign} = $nan;
333 }
334 }
335 }
336 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
0716bf9b 337 $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
338 #print "$wanted => $self->{sign}\n";
339 # if any of the globals is set, use them to round and store them inside $self
58cde26e 340 $self->round($accuracy,$precision,$rnd_mode)
341 if defined $accuracy || defined $precision;
342 return $self;
343 }
344
58cde26e 345sub bnan
346 {
347 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
b4f14daa 348 my $self = shift;
58cde26e 349 $self = $class if !defined $self;
350 if (!ref($self))
351 {
352 my $c = $self; $self = {}; bless $self, $c;
353 }
354 return if $self->modify('bnan');
0716bf9b 355 $self->{value} = $CALC->_zero();
58cde26e 356 $self->{sign} = $nan;
58cde26e 357 return $self;
b4f14daa 358 }
58cde26e 359
360sub binf
361 {
362 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
363 # the sign is either '+', or if given, used from there
364 my $self = shift;
365 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
366 $self = $class if !defined $self;
367 if (!ref($self))
368 {
369 my $c = $self; $self = {}; bless $self, $c;
370 }
371 return if $self->modify('binf');
0716bf9b 372 $self->{value} = $CALC->_zero();
58cde26e 373 $self->{sign} = $sign.'inf';
58cde26e 374 return $self;
375 }
376
377sub bzero
378 {
379 # create a bigint '+0', if given a BigInt, set it to 0
380 my $self = shift;
381 $self = $class if !defined $self;
0716bf9b 382
58cde26e 383 if (!ref($self))
384 {
385 my $c = $self; $self = {}; bless $self, $c;
386 }
387 return if $self->modify('bzero');
0716bf9b 388 $self->{value} = $CALC->_zero();
58cde26e 389 $self->{sign} = '+';
0716bf9b 390 #print "result: $self\n";
58cde26e 391 return $self;
392 }
393
574bacfe 394sub bone
395 {
396 # create a bigint '+1' (or -1 if given sign '-'),
397 # if given a BigInt, set it to +1 or -1, respecively
398 my $self = shift;
399 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
400 $self = $class if !defined $self;
401 #print "bone $self\n";
402
403 if (!ref($self))
404 {
405 my $c = $self; $self = {}; bless $self, $c;
406 }
407 return if $self->modify('bone');
408 $self->{value} = $CALC->_one();
409 $self->{sign} = $sign;
410 #print "result: $self\n";
411 return $self;
412 }
413
58cde26e 414##############################################################################
415# string conversation
416
417sub bsstr
418 {
419 # (ref to BFLOAT or num_str ) return num_str
420 # Convert number from internal format to scientific string format.
421 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
58cde26e 422 my ($self,$x) = objectify(1,@_);
423
574bacfe 424 if ($x->{sign} !~ /^[+-]$/)
425 {
426 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
427 return 'inf'; # +inf
428 }
58cde26e 429 my ($m,$e) = $x->parts();
574bacfe 430 # e can only be positive
58cde26e 431 my $sign = 'e+';
432 # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
433 return $m->bstr().$sign.$e->bstr();
434 }
435
436sub bstr
437 {
0716bf9b 438 # make a string from bigint object
58cde26e 439 my $x = shift; $x = $class->new($x) unless ref $x;
574bacfe 440 if ($x->{sign} !~ /^[+-]$/)
441 {
442 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
443 return 'inf'; # +inf
444 }
0716bf9b 445 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
446 return $es.${$CALC->_str($x->{value})};
58cde26e 447 }
448
449sub numify
450 {
451 # Make a number from a BigInt object
58cde26e 452 my $x = shift; $x = $class->new($x) unless ref $x;
0716bf9b 453 return $x->{sign} if $x->{sign} !~ /^[+-]$/;
454 my $num = $CALC->_num($x->{value});
455 return -$num if $x->{sign} eq '-';
58cde26e 456 return $num;
457 }
458
459##############################################################################
460# public stuff (usually prefixed with "b")
461
462sub sign
463 {
464 # return the sign of the number: +/-/NaN
465 my ($self,$x) = objectify(1,@_);
466 return $x->{sign};
467 }
468
469sub round
470 {
471 # After any operation or when calling round(), the result is rounded by
472 # regarding the A & P from arguments, local parameters, or globals.
473 # The result's A or P are set by the rounding, but not inspected beforehand
474 # (aka only the arguments enter into it). This works because the given
475 # 'first' argument is both the result and true first argument with unchanged
476 # A and P settings.
477 # This does not yet handle $x with A, and $y with P (which should be an
478 # error).
479 my $self = shift;
480 my $a = shift; # accuracy, if given by caller
481 my $p = shift; # precision, if given by caller
482 my $r = shift; # round_mode, if given by caller
483 my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops)
484
574bacfe 485 $self = new($self) unless ref($self); # if not object, make one
486 my $c = ref($args[0]); # find out class of argument
487 unshift @args,$self; # add 'first' argument
488
489 no strict 'refs';
490 my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
491 if (!defined $aa)
492 {
493 $z = "$c\::precision"; $ap = $$z;
494 }
495
0716bf9b 496 # leave bigfloat parts alone
497 return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
498
58cde26e 499 # now pick $a or $p, but only if we have got "arguments"
500 if ((!defined $a) && (!defined $p) && (@args > 0))
501 {
502 foreach (@args)
503 {
504 # take the defined one, or if both defined, the one that is smaller
505 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
506 }
507 if (!defined $a) # if it still is not defined, take p
508 {
509 foreach (@args)
510 {
511 # take the defined one, or if both defined, the one that is smaller
512 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p);
1f45ae4a 513 }
58cde26e 514 # if none defined, use globals (#2)
515 if (!defined $p)
516 {
574bacfe 517 $a = $aa; $p = $ap; # save the check: if !defined $a;
1f45ae4a 518 }
58cde26e 519 } # endif !$a
520 } # endif !$a || !$P && args > 0
521 # for clearity, this is not merged at place (#2)
522 # now round, by calling fround or ffround:
523 if (defined $a)
524 {
525 $self->{_a} = $a; $self->bround($a,$r);
526 }
527 elsif (defined $p)
528 {
529 $self->{_p} = $p; $self->bfround($p,$r);
530 }
531 return $self->bnorm();
532 }
533
534sub bnorm
535 {
536 # (num_str or BINT) return BINT
537 # Normalize number -- no-op here
574bacfe 538 return $_[0];
58cde26e 539 }
540
541sub babs
542 {
543 # (BINT or num_str) return BINT
544 # make number absolute, or return absolute BINT from string
58cde26e 545 my $x = shift; $x = $class->new($x) unless ref $x;
546 return $x if $x->modify('babs');
547 # post-normalized abs for internal use (does nothing for NaN)
548 $x->{sign} =~ s/^-/+/;
549 $x;
550 }
551
552sub bneg
553 {
554 # (BINT or num_str) return BINT
555 # negate number or make a negated number from string
574bacfe 556 my $x = shift; $x = $class->new($x) unless ref $x;
58cde26e 557 return $x if $x->modify('bneg');
558 # for +0 dont negate (to have always normalized)
559 return $x if $x->is_zero();
560 $x->{sign} =~ tr/+\-/-+/; # does nothing for NaN
58cde26e 561 $x;
562 }
563
564sub bcmp
565 {
566 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
567 # (BINT or num_str, BINT or num_str) return cond_code
568 my ($self,$x,$y) = objectify(2,@_);
0716bf9b 569
570 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
571 {
572 # handle +-inf and NaN
573 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
574bacfe 574 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
0716bf9b 575 return +1 if $x->{sign} eq '+inf';
576 return -1 if $x->{sign} eq '-inf';
577 return -1 if $y->{sign} eq '+inf';
578 return +1 if $y->{sign} eq '-inf';
579 }
574bacfe 580 # check sign for speed first
581 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
582 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
583
584 # shortcut
585 my $xz = $x->is_zero();
586 my $yz = $y->is_zero();
587 return 0 if $xz && $yz; # 0 <=> 0
588 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
589 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
0716bf9b 590 # normal compare now
58cde26e 591 &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
592 }
593
594sub bacmp
595 {
596 # Compares 2 values, ignoring their signs.
597 # Returns one of undef, <0, =0, >0. (suitable for sort)
598 # (BINT, BINT) return cond_code
599 my ($self,$x,$y) = objectify(2,@_);
574bacfe 600
601 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
602 {
603 # handle +-inf and NaN
604 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
605 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
606 return +1; # inf is always bigger
607 }
0716bf9b 608 $CALC->_acmp($x->{value},$y->{value}) <=> 0;
58cde26e 609 }
610
611sub badd
612 {
613 # add second arg (BINT or string) to first (BINT) (modifies first)
614 # return result as BINT
58cde26e 615 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
616
617 return $x if $x->modify('badd');
58cde26e 618
574bacfe 619 # inf and NaN handling
620 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
621 {
622 # NaN first
623 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
624 # inf handline
625 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
626 {
627 # + and + => +, - and - => -, + and - => 0, - and + => 0
628 return $x->bzero() if $x->{sign} ne $y->{sign};
629 return $x;
630 }
631 # +-inf + something => +inf
632 # something +-inf => +-inf
633 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
634 return $x;
635 }
636
0716bf9b 637 my @bn = ($a,$p,$r,$y); # make array for round calls
58cde26e 638 # speed: no add for 0+y or x+0
0716bf9b 639 return $x->round(@bn) if $y->is_zero(); # x+0
58cde26e 640 if ($x->is_zero()) # 0+y
641 {
642 # make copy, clobbering up x
0716bf9b 643 $x->{value} = $CALC->_copy($y->{value});
58cde26e 644 $x->{sign} = $y->{sign} || $nan;
645 return $x->round(@bn);
646 }
647
58cde26e 648 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
649
650 if ($sx eq $sy)
651 {
574bacfe 652 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
58cde26e 653 $x->{sign} = $sx;
654 }
655 else
656 {
574bacfe 657 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
58cde26e 658 if ($a > 0)
659 {
660 #print "swapped sub (a=$a)\n";
574bacfe 661 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
58cde26e 662 $x->{sign} = $sy;
663 }
664 elsif ($a == 0)
665 {
666 # speedup, if equal, set result to 0
0716bf9b 667 #print "equal sub, result = 0\n";
668 $x->{value} = $CALC->_zero();
58cde26e 669 $x->{sign} = '+';
670 }
671 else # a < 0
672 {
673 #print "unswapped sub (a=$a)\n";
574bacfe 674 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
58cde26e 675 $x->{sign} = $sx;
a0d0e21e 676 }
a0d0e21e 677 }
58cde26e 678 return $x->round(@bn);
679 }
680
681sub bsub
682 {
683 # (BINT or num_str, BINT or num_str) return num_str
684 # subtract second arg from first, modify first
685 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
686
58cde26e 687 return $x if $x->modify('bsub');
688 $x->badd($y->bneg()); # badd does not leave internal zeros
689 $y->bneg(); # refix y, assumes no one reads $y in between
690 return $x->round($a,$p,$r,$y);
691 }
692
693sub binc
694 {
695 # increment arg by one
696 my ($self,$x,$a,$p,$r) = objectify(1,@_);
697 # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
58cde26e 698 return $x if $x->modify('binc');
574bacfe 699 $x->badd($self->__one())->round($a,$p,$r);
58cde26e 700 }
701
702sub bdec
703 {
704 # decrement arg by one
705 my ($self,$x,$a,$p,$r) = objectify(1,@_);
58cde26e 706 return $x if $x->modify('bdec');
574bacfe 707 $x->badd($self->__one('-'))->round($a,$p,$r);
58cde26e 708 }
709
710sub blcm
711 {
712 # (BINT or num_str, BINT or num_str) return BINT
713 # does not modify arguments, but returns new object
714 # Lowest Common Multiplicator
58cde26e 715
0716bf9b 716 my $y = shift; my ($x);
717 if (ref($y))
718 {
719 $x = $y->copy();
720 }
721 else
722 {
723 $x = $class->new($y);
724 }
725 while (@_) { $x = _lcm($x,shift); }
58cde26e 726 $x;
727 }
728
729sub bgcd
730 {
731 # (BINT or num_str, BINT or num_str) return BINT
732 # does not modify arguments, but returns new object
733 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
0716bf9b 734
735 my $y = shift; my ($x);
736 if (ref($y))
58cde26e 737 {
0716bf9b 738 $x = $y->copy();
739 }
740 else
741 {
742 $x = $class->new($y);
743 }
744
745 if ($CALC->can('_gcd'))
746 {
747 while (@_)
748 {
749 $y = shift; $y = $class->new($y) if !ref($y);
750 next if $y->is_zero();
751 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
752 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
753 }
754 }
755 else
756 {
757 while (@_)
758 {
574bacfe 759 $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
0716bf9b 760 }
761 }
762 $x->babs();
58cde26e 763 }
764
765sub bmod
766 {
767 # modulus
768 # (BINT or num_str, BINT or num_str) return BINT
769 my ($self,$x,$y) = objectify(2,@_);
770
771 return $x if $x->modify('bmod');
772 (&bdiv($self,$x,$y))[1];
773 }
774
775sub bnot
776 {
777 # (num_str or BINT) return BINT
778 # represent ~x as twos-complement number
779 my ($self,$x) = objectify(1,@_);
780 return $x if $x->modify('bnot');
781 $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday
782 $x;
783 }
784
785sub is_zero
786 {
787 # return true if arg (BINT or num_str) is zero (array '+', '0')
788 #my ($self,$x) = objectify(1,@_);
58cde26e 789 my $x = shift; $x = $class->new($x) unless ref $x;
0716bf9b 790
574bacfe 791 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
0716bf9b 792 return $CALC->_is_zero($x->{value});
58cde26e 793 }
794
795sub is_nan
796 {
797 # return true if arg (BINT or num_str) is NaN
798 #my ($self,$x) = objectify(1,@_);
58cde26e 799 my $x = shift; $x = $class->new($x) unless ref $x;
800 return ($x->{sign} eq $nan);
801 }
802
803sub is_inf
804 {
805 # return true if arg (BINT or num_str) is +-inf
806 #my ($self,$x) = objectify(1,@_);
58cde26e 807 my $x = shift; $x = $class->new($x) unless ref $x;
808 my $sign = shift || '';
809
0716bf9b 810 return $x->{sign} =~ /^[+-]inf$/ if $sign eq '';
811 return $x->{sign} =~ /^[$sign]inf$/;
58cde26e 812 }
813
814sub is_one
815 {
b22b3e31 816 # return true if arg (BINT or num_str) is +1
817 # or -1 if sign is given
58cde26e 818 #my ($self,$x) = objectify(1,@_);
819 my $x = shift; $x = $class->new($x) unless ref $x;
574bacfe 820 my $sign = shift || ''; $sign = '+' if $sign ne '-';
0716bf9b 821
574bacfe 822 return 0 if $x->{sign} ne $sign;
0716bf9b 823 return $CALC->_is_one($x->{value});
58cde26e 824 }
825
826sub is_odd
827 {
828 # return true when arg (BINT or num_str) is odd, false for even
829 my $x = shift; $x = $class->new($x) unless ref $x;
830 #my ($self,$x) = objectify(1,@_);
0716bf9b 831
b22b3e31 832 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
0716bf9b 833 return $CALC->_is_odd($x->{value});
58cde26e 834 }
835
836sub is_even
837 {
838 # return true when arg (BINT or num_str) is even, false for odd
839 my $x = shift; $x = $class->new($x) unless ref $x;
840 #my ($self,$x) = objectify(1,@_);
0716bf9b 841
b22b3e31 842 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
0716bf9b 843 return $CALC->_is_even($x->{value});
0716bf9b 844 }
845
846sub is_positive
847 {
848 # return true when arg (BINT or num_str) is positive (>= 0)
849 my $x = shift; $x = $class->new($x) unless ref $x;
b22b3e31 850 return ($x->{sign} =~ /^\+/);
0716bf9b 851 }
852
853sub is_negative
854 {
855 # return true when arg (BINT or num_str) is negative (< 0)
856 my $x = shift; $x = $class->new($x) unless ref $x;
b22b3e31 857 return ($x->{sign} =~ /^-/);
58cde26e 858 }
859
0716bf9b 860###############################################################################
861
58cde26e 862sub bmul
863 {
864 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
865 # (BINT or num_str, BINT or num_str) return BINT
866 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
0716bf9b 867
58cde26e 868 return $x if $x->modify('bmul');
574bacfe 869 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
870 # handle result = 0
871 return $x if $x->is_zero();
872 return $x->bzero() if $y->is_zero();
873 # inf handling
874 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
875 {
876 # result will always be +-inf:
877 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
878 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
879 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
880 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
881 return $x->binf('-');
882 }
58cde26e 883
0716bf9b 884 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
574bacfe 885 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
58cde26e 886 return $x->round($a,$p,$r,$y);
887 }
888
889sub bdiv
890 {
891 # (dividend: BINT or num_str, divisor: BINT or num_str) return
892 # (BINT,BINT) (quo,rem) or BINT (only rem)
58cde26e 893 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
894
895 return $x if $x->modify('bdiv');
896
574bacfe 897 # x / +-inf => 0, reminder x
898 return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
899 if $y->{sign} =~ /^[+-]inf$/;
0716bf9b 900
574bacfe 901 # NaN if x == NaN or y == NaN or x==y==0
58cde26e 902 return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
574bacfe 903 if (($x->is_nan() || $y->is_nan()) ||
904 ($x->is_zero() && $y->is_zero()));
905
906 # 5 / 0 => +inf, -6 / 0 => -inf
907 return wantarray
908 ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
909 if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
910
911 # old code: always NaN if /0
912 #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
913 # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
58cde26e 914
915 # 0 / something
916 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
917
918 # Is $x in the interval [0, $y) ?
0716bf9b 919 my $cmp = $CALC->_acmp($x->{value},$y->{value});
58cde26e 920 if (($cmp < 0) and ($x->{sign} eq $y->{sign}))
921 {
922 return $x->bzero() unless wantarray;
923 my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
924 return ($x->bzero(),$t);
925 }
926 elsif ($cmp == 0)
927 {
928 # shortcut, both are the same, so set to +/- 1
574bacfe 929 $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
58cde26e 930 return $x unless wantarray;
931 return ($x,$self->bzero());
932 }
933
934 # calc new sign and in case $y == +/- 1, return $x
935 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
936 # check for / +-1 (cant use $y->is_one due to '-'
0716bf9b 937 if (($y == 1) || ($y == -1)) # slow!
938 #if ((@{$y->{value}} == 1) && ($y->{value}->[0] == 1))
58cde26e 939 {
940 return wantarray ? ($x,$self->bzero()) : $x;
941 }
942
943 # call div here
944 my $rem = $self->bzero();
945 $rem->{sign} = $y->{sign};
0716bf9b 946 #($x->{value},$rem->{value}) = div($x->{value},$y->{value});
947 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
58cde26e 948 # do not leave rest "-0";
0716bf9b 949 # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0);
950 $rem->{sign} = '+' if $CALC->_is_zero($rem->{value});
58cde26e 951 if (($x->{sign} eq '-') and (!$rem->is_zero()))
952 {
953 $x->bdec();
954 }
955 $x->round($a,$p,$r,$y);
956 if (wantarray)
957 {
958 $rem->round($a,$p,$r,$x,$y);
959 return ($x,$y-$rem) if $x->{sign} eq '-'; # was $x,$rem
960 return ($x,$rem);
961 }
962 return $x;
963 }
964
965sub bpow
966 {
967 # (BINT or num_str, BINT or num_str) return BINT
968 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
969 # modifies first argument
58cde26e 970 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
971
972 return $x if $x->modify('bpow');
973
0716bf9b 974 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
58cde26e 975 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
574bacfe 976 return $x->__one() if $y->is_zero();
58cde26e 977 return $x if $x->is_one() || $y->is_one();
0716bf9b 978 #if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1)
979 if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
58cde26e 980 {
981 # if $x == -1 and odd/even y => +1/-1
0716bf9b 982 return $y->is_odd() ? $x : $x->babs();
574bacfe 983 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
58cde26e 984 }
574bacfe 985 # 1 ** -y => 1 / (1 ** |y|)
986 # so do test for negative $y after above's clause
58cde26e 987 return $x->bnan() if $y->{sign} eq '-';
988 return $x if $x->is_zero(); # 0**y => 0 (if not y <= 0)
989
0716bf9b 990 if ($CALC->can('_pow'))
58cde26e 991 {
574bacfe 992 $x->{value} = $CALC->_pow($x->{value},$y->{value});
0716bf9b 993 return $x->round($a,$p,$r);
58cde26e 994 }
0716bf9b 995 # based on the assumption that shifting in base 10 is fast, and that mul
996 # works faster if numbers are small: we count trailing zeros (this step is
997 # O(1)..O(N), but in case of O(N) we save much more time due to this),
998 # stripping them out of the multiplication, and add $count * $y zeros
999 # afterwards like this:
1000 # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
1001 # creates deep recursion?
574bacfe 1002# my $zeros = $x->_trailing_zeros();
1003# if ($zeros > 0)
1004# {
1005# $x->brsft($zeros,10); # remove zeros
1006# $x->bpow($y); # recursion (will not branch into here again)
1007# $zeros = $y * $zeros; # real number of zeros to add
1008# $x->blsft($zeros,10);
1009# return $x->round($a,$p,$r);
1010# }
1011
1012 my $pow2 = $self->__one();
58cde26e 1013 my $y1 = $class->new($y);
1014 my ($res);
1015 while (!$y1->is_one())
1016 {
1017 #print "bpow: p2: $pow2 x: $x y: $y1 r: $res\n";
1018 #print "len ",$x->length(),"\n";
1019 ($y1,$res)=&bdiv($y1,2);
1020 if (!$res->is_zero()) { &bmul($pow2,$x); }
1021 if (!$y1->is_zero()) { &bmul($x,$x); }
0716bf9b 1022 #print "$x $y\n";
58cde26e 1023 }
1024 #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
1025 &bmul($x,$pow2) if (!$pow2->is_one());
1026 #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
1027 return $x->round($a,$p,$r);
1028 }
1029
1030sub blsft
1031 {
1032 # (BINT or num_str, BINT or num_str) return BINT
1033 # compute x << y, base n, y >= 0
1034 my ($self,$x,$y,$n) = objectify(2,@_);
1035
1036 return $x if $x->modify('blsft');
1037 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1038
574bacfe 1039 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1040
1041 my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
1042 if (defined $t)
1043 {
1044 $x->{value} = $t; return $x;
1045 }
1046 # fallback
1047 return $x->bmul( $self->bpow($n, $y) );
58cde26e 1048 }
1049
1050sub brsft
1051 {
1052 # (BINT or num_str, BINT or num_str) return BINT
1053 # compute x >> y, base n, y >= 0
1054 my ($self,$x,$y,$n) = objectify(2,@_);
1055
1056 return $x if $x->modify('brsft');
1057 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1058
1059 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
574bacfe 1060
1061 my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
1062 if (defined $t)
1063 {
1064 $x->{value} = $t; return $x;
1065 }
1066 # fallback
1067 return scalar bdiv($x, $self->bpow($n, $y));
58cde26e 1068 }
1069
1070sub band
1071 {
1072 #(BINT or num_str, BINT or num_str) return BINT
1073 # compute x & y
0716bf9b 1074 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e 1075
1076 return $x if $x->modify('band');
1077
1078 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1079 return $x->bzero() if $y->is_zero();
0716bf9b 1080
574bacfe 1081 my $sign = 0; # sign of result
1082 $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
1083 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1084 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1085
1086 if ($CALC->can('_and') && $sx == 1 && $sy == 1)
0716bf9b 1087 {
574bacfe 1088 $x->{value} = $CALC->_and($x->{value},$y->{value});
0716bf9b 1089 return $x->round($a,$p,$r);
1090 }
574bacfe 1091
0716bf9b 1092 my $m = new Math::BigInt 1; my ($xr,$yr);
574bacfe 1093 my $x10000 = new Math::BigInt (0x1000);
1094 my $y1 = copy(ref($x),$y); # make copy
1095 $y1->babs(); # and positive
1096 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1097 use integer; # need this for negative bools
0716bf9b 1098 while (!$x1->is_zero() && !$y1->is_zero())
58cde26e 1099 {
0716bf9b 1100 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1101 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe 1102 # make both op's numbers!
1103 $x->badd( bmul( $class->new(
1104 abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
1105 $m));
58cde26e 1106 $m->bmul($x10000);
1107 }
574bacfe 1108 $x->bneg() if $sign;
0716bf9b 1109 return $x->round($a,$p,$r);
58cde26e 1110 }
1111
1112sub bior
1113 {
1114 #(BINT or num_str, BINT or num_str) return BINT
1115 # compute x | y
0716bf9b 1116 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e 1117
1118 return $x if $x->modify('bior');
1119
1120 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
1121 return $x if $y->is_zero();
574bacfe 1122
1123 my $sign = 0; # sign of result
1124 $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
1125 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1126 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1127
1128 # don't use lib for negative values
1129 if ($CALC->can('_or') && $sx == 1 && $sy == 1)
0716bf9b 1130 {
574bacfe 1131 $x->{value} = $CALC->_or($x->{value},$y->{value});
0716bf9b 1132 return $x->round($a,$p,$r);
1133 }
1134
1135 my $m = new Math::BigInt 1; my ($xr,$yr);
58cde26e 1136 my $x10000 = new Math::BigInt (0x10000);
574bacfe 1137 my $y1 = copy(ref($x),$y); # make copy
1138 $y1->babs(); # and positive
1139 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1140 use integer; # need this for negative bools
0716bf9b 1141 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1142 {
0716bf9b 1143 ($x1, $xr) = bdiv($x1,$x10000);
58cde26e 1144 ($y1, $yr) = bdiv($y1,$x10000);
574bacfe 1145 # make both op's numbers!
1146 $x->badd( bmul( $class->new(
1147 abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
1148 $m));
1149# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m));
58cde26e 1150 $m->bmul($x10000);
1151 }
574bacfe 1152 $x->bneg() if $sign;
0716bf9b 1153 return $x->round($a,$p,$r);
58cde26e 1154 }
1155
1156sub bxor
1157 {
1158 #(BINT or num_str, BINT or num_str) return BINT
1159 # compute x ^ y
0716bf9b 1160 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e 1161
1162 return $x if $x->modify('bxor');
1163
0716bf9b 1164 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
58cde26e 1165 return $x if $y->is_zero();
1166 return $x->bzero() if $x == $y; # shortcut
0716bf9b 1167
574bacfe 1168 my $sign = 0; # sign of result
1169 $sign = 1 if $x->{sign} ne $y->{sign};
1170 my $sx = 1; $sx = -1 if $x->{sign} eq '-';
1171 my $sy = 1; $sy = -1 if $y->{sign} eq '-';
1172
1173 # don't use lib for negative values
1174 if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
0716bf9b 1175 {
574bacfe 1176 $x->{value} = $CALC->_xor($x->{value},$y->{value});
0716bf9b 1177 return $x->round($a,$p,$r);
1178 }
1179
1180 my $m = new Math::BigInt 1; my ($xr,$yr);
58cde26e 1181 my $x10000 = new Math::BigInt (0x10000);
1182 my $y1 = copy(ref($x),$y); # make copy
574bacfe 1183 $y1->babs(); # and positive
1184 my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
1185 use integer; # need this for negative bools
0716bf9b 1186 while (!$x1->is_zero() || !$y1->is_zero())
58cde26e 1187 {
0716bf9b 1188 ($x1, $xr) = bdiv($x1, $x10000);
58cde26e 1189 ($y1, $yr) = bdiv($y1, $x10000);
574bacfe 1190 # make both op's numbers!
1191 $x->badd( bmul( $class->new(
1192 abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
1193 $m));
1194# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m));
58cde26e 1195 $m->bmul($x10000);
1196 }
574bacfe 1197 $x->bneg() if $sign;
0716bf9b 1198 return $x->round($a,$p,$r);
58cde26e 1199 }
1200
1201sub length
1202 {
1203 my ($self,$x) = objectify(1,@_);
1204
0716bf9b 1205 my $e = $CALC->_len($x->{value});
1206 # # fallback, since we do not know the underlying representation
1207 #my $es = "$x"; my $c = 0; $c = 1 if $es =~ /^[+-]/; # if lib returns '+123'
1208 #my $e = CORE::length($es)-$c;
1209 return wantarray ? ($e,0) : $e;
58cde26e 1210 }
1211
1212sub digit
1213 {
0716bf9b 1214 # return the nth decimal digit, negative values count backward, 0 is right
58cde26e 1215 my $x = shift;
1216 my $n = shift || 0;
1217
0716bf9b 1218 return $CALC->_digit($x->{value},$n);
58cde26e 1219 }
1220
1221sub _trailing_zeros
1222 {
1223 # return the amount of trailing zeros in $x
1224 my $x = shift;
1225 $x = $class->new($x) unless ref $x;
1226
574bacfe 1227 return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
0716bf9b 1228
1229 return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
1230
b22b3e31 1231 # if not: since we do not know underlying internal representation:
0716bf9b 1232 my $es = "$x"; $es =~ /([0]*)$/;
1233
1234 return 0 if !defined $1; # no zeros
1235 return CORE::length("$1"); # as string, not as +0!
58cde26e 1236 }
1237
1238sub bsqrt
1239 {
1240 my ($self,$x) = objectify(1,@_);
1241
1242 return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN
1243 return $x->bzero() if $x->is_zero(); # 0 => 0
1244 return $x if $x == 1; # 1 => 1
1245
1246 my $y = $x->copy(); # give us one more digit accur.
1247 my $l = int($x->length()/2);
1248
1249 $x->bzero();
1250 $x->binc(); # keep ref($x), but modify it
1251 $x *= 10 ** $l;
1252
1253 # print "x: $y guess $x\n";
1254
1255 my $last = $self->bzero();
1256 while ($last != $x)
1257 {
1258 $last = $x;
1259 $x += $y / $x;
1260 $x /= 2;
1261 }
1262 return $x;
1263 }
1264
1265sub exponent
1266 {
1267 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
1268 my ($self,$x) = objectify(1,@_);
1269
1270 return bnan() if $x->is_nan();
1271 my $e = $class->bzero();
1272 return $e->binc() if $x->is_zero();
1273 $e += $x->_trailing_zeros();
1274 return $e;
1275 }
1276
1277sub mantissa
1278 {
1279 # return a copy of the mantissa (here always $self)
1280 my ($self,$x) = objectify(1,@_);
1281
1282 return bnan() if $x->is_nan();
1283 my $m = $x->copy();
1284 # that's inefficient
1285 my $zeros = $m->_trailing_zeros();
1286 $m /= 10 ** $zeros if $zeros != 0;
1287 return $m;
1288 }
1289
1290sub parts
1291 {
1292 # return a copy of both the exponent and the mantissa (here 0 and self)
1293 my $self = shift;
1294 $self = $class->new($self) unless ref $self;
1295
1296 return ($self->mantissa(),$self->exponent());
1297 }
1298
1299##############################################################################
1300# rounding functions
1301
1302sub bfround
1303 {
1304 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1305 # $n == 0 => round to integer
1306 my $x = shift; $x = $class->new($x) unless ref $x;
1307 my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
1308 return $x if !defined $scale; # no-op
1309
1310 # no-op for BigInts if $n <= 0
1311 return $x if $scale <= 0;
1312
1313 $x->bround( $x->length()-$scale, $mode);
1314 }
1315
1316sub _scan_for_nonzero
1317 {
1318 my $x = shift;
1319 my $pad = shift;
0716bf9b 1320 my $xs = shift;
58cde26e 1321
1322 my $len = $x->length();
1323 return 0 if $len == 1; # '5' is trailed by invisible zeros
1324 my $follow = $pad - 1;
1325 return 0 if $follow > $len || $follow < 1;
1326 #print "checking $x $r\n";
0716bf9b 1327
b22b3e31 1328 # since we do not know underlying represention of $x, use decimal string
0716bf9b 1329 #my $r = substr ($$xs,-$follow);
58cde26e 1330 my $r = substr ("$x",-$follow);
1331 return 1 if $r =~ /[^0]/; return 0;
58cde26e 1332 }
1333
1334sub fround
1335 {
1336 # to make life easier for switch between MBF and MBI (autoload fxxx()
1337 # like MBF does for bxxx()?)
1338 my $x = shift;
1339 return $x->bround(@_);
1340 }
1341
1342sub bround
1343 {
1344 # accuracy: +$n preserve $n digits from left,
1345 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
1346 # no-op for $n == 0
1347 # and overwrite the rest with 0's, return normalized number
1348 # do not return $x->bnorm(), but $x
1349 my $x = shift; $x = $class->new($x) unless ref $x;
1350 my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
1351 return $x if !defined $scale; # no-op
1352
1353 # print "MBI round: $x to $scale $mode\n";
1354 # -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
574bacfe 1355 return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
58cde26e 1356
1357 # we have fewer digits than we want to scale to
1358 my $len = $x->length();
1359 # print "$len $scale\n";
1360 return $x if $len < abs($scale);
1361
1362 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
1363 my ($pad,$digit_round,$digit_after);
1364 $pad = $len - $scale;
1365 $pad = abs($scale)+1 if $scale < 0;
0716bf9b 1366 # do not use digit(), it is costly for binary => decimal
1367 #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len;
1368 #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0;
1369 my $xs = $CALC->_str($x->{value});
1370 my $pl = -$pad-1;
1371 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
1372 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
1373 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
1374 $pl++; $pl ++ if $pad >= $len;
1375 $digit_after = '0'; $digit_after = substr($$xs,$pl,1)
1376 if $pad > 0;
1377
1378 #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len;
1379 #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0;
1380 # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n";
58cde26e 1381
1382 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
1383 # closer at the remaining digits of the original $x, remember decision
1384 my $round_up = 1; # default round up
1385 $round_up -- if
1386 ($mode eq 'trunc') || # trunc by round down
1387 ($digit_after =~ /[01234]/) || # round down anyway,
1388 # 6789 => round up
1389 ($digit_after eq '5') && # not 5000...0000
0716bf9b 1390 ($x->_scan_for_nonzero($pad,$xs) == 0) &&
58cde26e 1391 (
1392 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
1393 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
1394 ($mode eq '+inf') && ($x->{sign} eq '-') ||
1395 ($mode eq '-inf') && ($x->{sign} eq '+') ||
1396 ($mode eq 'zero') # round down if zero, sign adjusted below
1397 );
1398 # allow rounding one place left of mantissa
1399 #print "$pad $len $scale\n";
1400 # this is triggering warnings, and buggy for $scale < 0
1401 #if (-$scale != $len)
1402 {
b22b3e31 1403 # old code, depend on internal representation
0716bf9b 1404 # split mantissa at $pad and then pad with zeros
1405 #my $s5 = int($pad / 5);
1406 #my $i = 0;
1407 #while ($i < $s5)
1408 # {
1409 # $x->{value}->[$i++] = 0; # replace with 5 x 0
1410 # }
1411 #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5]; # pad with 0
1412 #my $rem = $pad % 5; # so much left over
1413 #if ($rem > 0)
1414 # {
1415 # #print "remainder $rem\n";
1416 ## #print "elem $x->{value}->[$s5]\n";
1417 # substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem; # stamp w/ '0'
1418 # }
1419 #$x->{value}->[$s5] = int ($x->{value}->[$s5]); # str '05' => int '5'
1420 #print ${$CALC->_str($pad->{value})}," $len\n";
1421 if (($pad > 0) && ($pad <= $len))
58cde26e 1422 {
0716bf9b 1423 substr($$xs,-$pad,$pad) = '0' x $pad;
1424 $x->{value} = $CALC->_new($xs); # put back in
58cde26e 1425 }
0716bf9b 1426 elsif ($pad > $len)
58cde26e 1427 {
574bacfe 1428 $x->bzero(); # round to '0'
58cde26e 1429 }
574bacfe 1430 # print "res $pad $len $x $$xs\n";
58cde26e 1431 }
0716bf9b 1432 # move this later on after the inc of the string
1433 #$x->{value} = $CALC->_new($xs); # put back in
58cde26e 1434 if ($round_up) # what gave test above?
1435 {
1436 $pad = $len if $scale < 0; # tlr: whack 0.51=>1.0
1437 # modify $x in place, undef, undef to avoid rounding
58cde26e 1438 # str creation much faster than 10 ** something
0716bf9b 1439 $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) );
1440 # increment string in place, to avoid dec=>hex for the '1000...000'
1441 # $xs ...blah foo
58cde26e 1442 }
0716bf9b 1443 # to here:
1444 #$x->{value} = $CALC->_new($xs); # put back in
58cde26e 1445 $x;
1446 }
1447
1448sub bfloor
1449 {
1450 # return integer less or equal then number, since it is already integer,
1451 # always returns $self
1452 my ($self,$x,$a,$p,$r) = objectify(1,@_);
1453
1454 # not needed: return $x if $x->modify('bfloor');
1455
1456 return $x->round($a,$p,$r);
1457 }
1458
1459sub bceil
1460 {
1461 # return integer greater or equal then number, since it is already integer,
1462 # always returns $self
1463 my ($self,$x,$a,$p,$r) = objectify(1,@_);
1464
1465 # not needed: return $x if $x->modify('bceil');
1466
1467 return $x->round($a,$p,$r);
1468 }
1469
1470##############################################################################
1471# private stuff (internal use only)
1472
574bacfe 1473sub __one
58cde26e 1474 {
1475 # internal speedup, set argument to 1, or create a +/- 1
1476 my $self = shift;
0716bf9b 1477 my $x = $self->bzero(); $x->{value} = $CALC->_one();
1478 $x->{sign} = shift || '+';
1479 return $x;
58cde26e 1480 }
1481
1482sub _swap
1483 {
1484 # Overload will swap params if first one is no object ref so that the first
1485 # one is always an object ref. In this case, third param is true.
1486 # This routine is to overcome the effect of scalar,$object creating an object
1487 # of the class of this package, instead of the second param $object. This
1488 # happens inside overload, when the overload section of this package is
1489 # inherited by sub classes.
1490 # For overload cases (and this is used only there), we need to preserve the
1491 # args, hence the copy().
1492 # You can override this method in a subclass, the overload section will call
1493 # $object->_swap() to make sure it arrives at the proper subclass, with some
1494 # exceptions like '+' and '-'.
1495
1496 # object, (object|scalar) => preserve first and make copy
1497 # scalar, object => swapped, re-swap and create new from first
1498 # (using class of second object, not $class!!)
1499 my $self = shift; # for override in subclass
1500 #print "swap $self 0:$_[0] 1:$_[1] 2:$_[2]\n";
1501 if ($_[2])
1502 {
1503 my $c = ref ($_[0]) || $class; # fallback $class should not happen
1504 return ( $c->new($_[1]), $_[0] );
1505 }
1506 else
1507 {
1508 return ( $_[0]->copy(), $_[1] );
1509 }
1510 }
1511
1512sub objectify
1513 {
1514 # check for strings, if yes, return objects instead
1515
1516 # the first argument is number of args objectify() should look at it will
1517 # return $count+1 elements, the first will be a classname. This is because
1518 # overloaded '""' calls bstr($object,undef,undef) and this would result in
1519 # useless objects beeing created and thrown away. So we cannot simple loop
1520 # over @_. If the given count is 0, all arguments will be used.
1521
1522 # If the second arg is a ref, use it as class.
1523 # If not, try to use it as classname, unless undef, then use $class
1524 # (aka Math::BigInt). The latter shouldn't happen,though.
1525
1526 # caller: gives us:
1527 # $x->badd(1); => ref x, scalar y
1528 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
1529 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
1530 # Math::BigInt::badd(1,2); => scalar x, scalar y
1531 # In the last case we check number of arguments to turn it silently into
574bacfe 1532 # $class,1,2. (We can not take '1' as class ;o)
58cde26e 1533 # badd($class,1) is not supported (it should, eventually, try to add undef)
1534 # currently it tries 'Math::BigInt' + 1, which will not work.
1535
58cde26e 1536 my $count = abs(shift || 0);
1537
1538 #print caller(),"\n";
1539
1540 my @a; # resulting array
1541 if (ref $_[0])
1542 {
1543 # okay, got object as first
1544 $a[0] = ref $_[0];
1545 }
1546 else
1547 {
1548 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
1549 $a[0] = $class;
1550 #print "@_\n"; sleep(1);
1551 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
1552 }
1553 #print caller(),"\n";
1554 # print "Now in objectify, my class is today $a[0]\n";
1555 my $k;
1556 if ($count == 0)
1557 {
1558 while (@_)
1559 {
1560 $k = shift;
1561 if (!ref($k))
1562 {
1563 $k = $a[0]->new($k);
1564 }
1565 elsif (ref($k) ne $a[0])
1566 {
1567 # foreign object, try to convert to integer
1568 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 1569 }
58cde26e 1570 push @a,$k;
1571 }
1572 }
1573 else
1574 {
1575 while ($count > 0)
1576 {
1577 #print "$count\n";
1578 $count--;
1579 $k = shift;
1580 if (!ref($k))
1581 {
1582 $k = $a[0]->new($k);
1583 }
1584 elsif (ref($k) ne $a[0])
1585 {
1586 # foreign object, try to convert to integer
1587 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 1588 }
58cde26e 1589 push @a,$k;
1590 }
1591 push @a,@_; # return other params, too
1592 }
1593 #my $i = 0;
1594 #foreach (@a)
1595 # {
1596 # print "o $i $a[0]\n" if $i == 0;
1597 # print "o $i ",ref($_),"\n" if $i != 0; $i++;
1598 # }
1599 #print "objectify done: would return ",scalar @a," values\n";
1600 #print caller(1),"\n" unless wantarray;
1601 die "$class objectify needs list context" unless wantarray;
1602 @a;
1603 }
1604
1605sub import
1606 {
1607 my $self = shift;
1608 #print "import $self @_\n";
0716bf9b 1609 my @a = @_; my $l = scalar @_; my $j = 0;
1610 for ( my $i = 0; $i < $l ; $i++,$j++ )
58cde26e 1611 {
0716bf9b 1612 if ($_[$i] eq ':constant')
58cde26e 1613 {
0716bf9b 1614 # this causes overlord er load to step in
58cde26e 1615 overload::constant integer => sub { $self->new(shift) };
0716bf9b 1616 splice @a, $j, 1; $j --;
1617 }
1618 elsif ($_[$i] =~ /^lib$/i)
1619 {
1620 # this causes a different low lib to take care...
1621 $CALC = $_[$i+1] || $CALC;
574bacfe 1622 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
0716bf9b 1623 splice @a, $j, $s; $j -= $s;
58cde26e 1624 }
1625 }
1626 # any non :constant stuff is handled by our parent, Exporter
1627 # even if @_ is empty, to give it a chance
0716bf9b 1628 #$self->SUPER::import(@a); # does not work
1629 $self->export_to_level(1,$self,@a); # need this instead
58cde26e 1630
574bacfe 1631 # try to load core math lib
1632 my @c = split /\s*,\s*/,$CALC;
1633 push @c,'Calc'; # if all fail, try this
1634 foreach my $lib (@c)
1635 {
1636 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
1637 $lib =~ s/\.pm$//;
1638 if ($] < 5.6)
1639 {
1640 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1641 # used in the same script, or eval inside import().
1642 (my $mod = $lib . '.pm') =~ s!::!/!g;
1643 # require does not automatically :: => /, so portability problems arise
1644 eval { require $mod; $lib->import(); }
1645 }
1646 else
1647 {
1648 eval "use $lib;";
1649 }
1650 $CALC = $lib, last if $@ eq '';
1651 }
58cde26e 1652 }
1653
574bacfe 1654sub __from_hex
58cde26e 1655 {
1656 # convert a (ref to) big hex string to BigInt, return undef for error
1657 my $hs = shift;
1658
1659 my $x = Math::BigInt->bzero();
1660 return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
1661
b22b3e31 1662 my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
58cde26e 1663
b22b3e31 1664 $$hs =~ s/^[+-]//; # strip sign
0716bf9b 1665 if ($CALC->can('_from_hex'))
58cde26e 1666 {
0716bf9b 1667 $x->{value} = $CALC->_from_hex($hs);
58cde26e 1668 }
0716bf9b 1669 else
58cde26e 1670 {
0716bf9b 1671 # fallback to pure perl
1672 my $mul = Math::BigInt->bzero(); $mul++;
1673 my $x65536 = Math::BigInt->new(65536);
1674 my $len = CORE::length($$hs)-2;
1675 $len = int($len/4); # 4-digit parts, w/o '0x'
1676 my $val; my $i = -4;
1677 while ($len >= 0)
1678 {
1679 $val = substr($$hs,$i,4);
b22b3e31 1680 $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
0716bf9b 1681 $val = hex($val); # hex does not like wrong chars
1682 # print "$val ",substr($$hs,$i,4),"\n";
1683 $i -= 4; $len --;
1684 $x += $mul * $val if $val != 0;
1685 $mul *= $x65536 if $len >= 0; # skip last mul
1686 }
58cde26e 1687 }
0716bf9b 1688 $x->{sign} = $sign if !$x->is_zero(); # no '-0'
58cde26e 1689 return $x;
1690 }
1691
574bacfe 1692sub __from_bin
58cde26e 1693 {
1694 # convert a (ref to) big binary string to BigInt, return undef for error
1695 my $bs = shift;
1696
1697 my $x = Math::BigInt->bzero();
b22b3e31 1698 return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
58cde26e 1699
1700 my $mul = Math::BigInt->bzero(); $mul++;
1701 my $x256 = Math::BigInt->new(256);
1702
0716bf9b 1703 my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
b22b3e31 1704 $$bs =~ s/^[+-]//; # strip sign
0716bf9b 1705 if ($CALC->can('_from_bin'))
58cde26e 1706 {
0716bf9b 1707 $x->{value} = $CALC->_from_bin($bs);
58cde26e 1708 }
0716bf9b 1709 else
58cde26e 1710 {
0716bf9b 1711 my $len = CORE::length($$bs)-2;
1712 $len = int($len/8); # 8-digit parts, w/o '0b'
1713 my $val; my $i = -8;
1714 while ($len >= 0)
1715 {
1716 $val = substr($$bs,$i,8);
b22b3e31 1717 $val =~ s/^[+-]?0b// if $len == 0; # for last part only
1718 #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
0716bf9b 1719 $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
1720 $val = ord(pack('B8',$val));
1721 # print "$val ",substr($$bs,$i,16),"\n";
1722 $i -= 8; $len --;
1723 $x += $mul * $val if $val != 0;
1724 $mul *= $x256 if $len >= 0; # skip last mul
1725 }
58cde26e 1726 }
1727 $x->{sign} = $sign if !$x->is_zero();
1728 return $x;
1729 }
1730
1731sub _split
1732 {
1733 # (ref to num_str) return num_str
1734 # internal, take apart a string and return the pieces
574bacfe 1735 # strip leading/trailing whitespace, leading zeros, underscore, reject
1736 # invalid input
58cde26e 1737 my $x = shift;
1738
574bacfe 1739 # strip white space at front, also extranous leading zeros
1740 $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
1741 $$x =~ s/^\s+//; # but this will
58cde26e 1742 $$x =~ s/\s+$//g; # strip white space at end
58cde26e 1743
574bacfe 1744 # shortcut, if nothing to split, return early
1745 if ($$x =~ /^[+-]?\d+$/)
1746 {
1747 $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
1748 return (\$sign, $x, \'', \'', \0);
1749 }
58cde26e 1750
574bacfe 1751 # invalid starting char?
1752 return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
58cde26e 1753
1754 $$x =~ s/(\d)_(\d)/$1$2/g; # strip underscores between digits
1755 $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
1756
574bacfe 1757 return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
1758 return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
1759
58cde26e 1760 # some possible inputs:
1761 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
1762 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2
1763
1764 #print "input: '$$x' ";
1765 my ($m,$e) = split /[Ee]/,$$x;
1766 $e = '0' if !defined $e || $e eq "";
1767 # print "m '$m' e '$e'\n";
1768 # sign,value for exponent,mantint,mantfrac
1769 my ($es,$ev,$mis,$miv,$mfv);
1770 # valid exponent?
1771 if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1772 {
1773 $es = $1; $ev = $2;
1774 #print "'$m' '$e' e: $es $ev ";
1775 # valid mantissa?
1776 return if $m eq '.' || $m eq '';
1777 my ($mi,$mf) = split /\./,$m;
1778 $mi = '0' if !defined $mi;
1779 $mi .= '0' if $mi =~ /^[\-\+]?$/;
1780 $mf = '0' if !defined $mf || $mf eq '';
1781 if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
1782 {
1783 $mis = $1||'+'; $miv = $2;
0716bf9b 1784 # print "$mis $miv";
58cde26e 1785 # valid, existing fraction part of mantissa?
1786 return unless ($mf =~ /^(\d*?)0*$/); # strip trailing zeros
1787 $mfv = $1;
1788 #print " split: $mis $miv . $mfv E $es $ev\n";
1789 return (\$mis,\$miv,\$mfv,\$es,\$ev);
1790 }
1791 }
1792 return; # NaN, not a number
1793 }
1794
58cde26e 1795sub as_number
1796 {
1797 # an object might be asked to return itself as bigint on certain overloaded
1798 # operations, this does exactly this, so that sub classes can simple inherit
1799 # it or override with their own integer conversion routine
1800 my $self = shift;
1801
1802 return $self->copy();
1803 }
1804
1805##############################################################################
0716bf9b 1806# internal calculation routines (others are in Math::BigInt::Calc etc)
58cde26e 1807
1808sub cmp
1809 {
1810 # post-normalized compare for internal use (honors signs)
0716bf9b 1811 # input: ref to value, ref to value, sign, sign
1812 # output: <0, 0, >0
58cde26e 1813 my ($cx,$cy,$sx,$sy) = @_;
1814
58cde26e 1815 if ($sx eq '+')
1816 {
1817 return 1 if $sy eq '-'; # 0 check handled above
0716bf9b 1818 #return acmp($cx,$cy);
1819 return $CALC->_acmp($cx,$cy);
58cde26e 1820 }
1821 else
1822 {
1823 # $sx eq '-'
0716bf9b 1824 return -1 if $sy eq '+';
1825 #return acmp($cy,$cx);
1826 return $CALC->_acmp($cy,$cx);
58cde26e 1827 }
1828 return 0; # equal
1829 }
1830
58cde26e 1831sub _lcm
1832 {
1833 # (BINT or num_str, BINT or num_str) return BINT
1834 # does modify first argument
1835 # LCM
1836
1837 my $x = shift; my $ty = shift;
1838 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
1839 return $x * $ty / bgcd($x,$ty);
1840 }
1841
574bacfe 1842sub __gcd
58cde26e 1843 {
1844 # (BINT or num_str, BINT or num_str) return BINT
1845 # does modify first arg
1846 # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
58cde26e 1847
0716bf9b 1848 my $x = shift; my $ty = $class->new(shift); # preserve y, but make class
1849 return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
58cde26e 1850
1851 while (!$ty->is_zero())
1852 {
1853 ($x, $ty) = ($ty,bmod($x,$ty));
1854 }
1855 $x;
1856 }
1857
58cde26e 1858###############################################################################
1859# this method return 0 if the object can be modified, or 1 for not
1860# We use a fast use constant statement here, to avoid costly calls. Subclasses
1861# may override it with special code (f.i. Math::BigInt::Constant does so)
1862
0716bf9b 1863sub modify () { 0; }
e16b8f49 1864
a0d0e21e 18651;
a5f75d66 1866__END__
1867
1868=head1 NAME
1869
1870Math::BigInt - Arbitrary size integer math package
1871
1872=head1 SYNOPSIS
1873
1874 use Math::BigInt;
58cde26e 1875
1876 # Number creation
574bacfe 1877 $x = Math::BigInt->new($str); # defaults to 0
1878 $nan = Math::BigInt->bnan(); # create a NotANumber
1879 $zero = Math::BigInt->bzero(); # create a +0
1880 $inf = Math::BigInt->binf(); # create a +inf
1881 $inf = Math::BigInt->binf('-'); # create a -inf
1882 $one = Math::BigInt->bone(); # create a +1
1883 $one = Math::BigInt->bone('-'); # create a -1
58cde26e 1884
1885 # Testing
574bacfe 1886 $x->is_zero(); # true if arg is +0
1887 $x->is_nan(); # true if arg is NaN
0716bf9b 1888 $x->is_one(); # true if arg is +1
1889 $x->is_one('-'); # true if arg is -1
1890 $x->is_odd(); # true if odd, false for even
1891 $x->is_even(); # true if even, false for odd
1892 $x->is_positive(); # true if >= 0
1893 $x->is_negative(); # true if < 0
1894 $x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
1895
58cde26e 1896 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
1897 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
1898 $x->sign(); # return the sign, either +,- or NaN
1899 $x->digit($n); # return the nth digit, counting from right
1900 $x->digit(-$n); # return the nth digit, counting from left
1901
1902 # The following all modify their first argument:
1903
1904 # set
1905 $x->bzero(); # set $x to 0
1906 $x->bnan(); # set $x to NaN
574bacfe 1907 $x->bone(); # set $x to +1
1908 $x->bone('-'); # set $x to -1
58cde26e 1909
1910 $x->bneg(); # negation
1911 $x->babs(); # absolute value
1912 $x->bnorm(); # normalize (no-op)
1913 $x->bnot(); # two's complement (bit wise not)
1914 $x->binc(); # increment x by 1
1915 $x->bdec(); # decrement x by 1
1916
1917 $x->badd($y); # addition (add $y to $x)
1918 $x->bsub($y); # subtraction (subtract $y from $x)
1919 $x->bmul($y); # multiplication (multiply $x by $y)
1920 $x->bdiv($y); # divide, set $x to quotient
1921 # return (quo,rem) or quo if scalar
1922
1923 $x->bmod($y); # modulus (x % y)
1924 $x->bpow($y); # power of arguments (x ** y)
1925 $x->blsft($y); # left shift
1926 $x->brsft($y); # right shift
1927 $x->blsft($y,$n); # left shift, by base $n (like 10)
1928 $x->brsft($y,$n); # right shift, by base $n (like 10)
1929
1930 $x->band($y); # bitwise and
1931 $x->bior($y); # bitwise inclusive or
1932 $x->bxor($y); # bitwise exclusive or
1933 $x->bnot(); # bitwise not (two's complement)
1934
1935 $x->bsqrt(); # calculate square-root
1936
1937 $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
1938 $x->bround($N); # accuracy: preserve $N digits
1939 $x->bfround($N); # round to $Nth digit, no-op for BigInts
1940
1941 # The following do not modify their arguments in BigInt, but do in BigFloat:
1942 $x->bfloor(); # return integer less or equal than $x
1943 $x->bceil(); # return integer greater or equal than $x
1944
1945 # The following do not modify their arguments:
1946
1947 bgcd(@values); # greatest common divisor
1948 blcm(@values); # lowest common multiplicator
1949
1950 $x->bstr(); # normalized string
1951 $x->bsstr(); # normalized string in scientific notation
1952 $x->length(); # return number of digits in number
1953 ($x,$f) = $x->length(); # length of number and length of fraction part
1954
1955 $x->exponent(); # return exponent as BigInt
1956 $x->mantissa(); # return mantissa as BigInt
1957 $x->parts(); # return (mantissa,exponent) as BigInt
0716bf9b 1958 $x->copy(); # make a true copy of $x (unlike $y = $x;)
1959 $x->as_number(); # return as BigInt (in BigInt: same as copy())
a5f75d66 1960
1961=head1 DESCRIPTION
1962
58cde26e 1963All operators (inlcuding basic math operations) are overloaded if you
1964declare your big integers as
a5f75d66 1965
58cde26e 1966 $i = new Math::BigInt '123_456_789_123_456_789';
a5f75d66 1967
58cde26e 1968Operations with overloaded operators preserve the arguments which is
1969exactly what you expect.
a5f75d66 1970
1971=over 2
1972
1973=item Canonical notation
1974
58cde26e 1975Big integer values are strings of the form C</^[+-]\d+$/> with leading
a5f75d66 1976zeros suppressed.
1977
58cde26e 1978 '-0' canonical value '-0', normalized '0'
1979 ' -123_123_123' canonical value '-123123123'
1980 '1_23_456_7890' canonical value '1234567890'
1981
a5f75d66 1982=item Input
1983
58cde26e 1984Input values to these routines may be either Math::BigInt objects or
1985strings of the form C</^\s*[+-]?[\d]+\.?[\d]*E?[+-]?[\d]*$/>.
1986
1987You can include one underscore between any two digits.
1988
1989This means integer values like 1.01E2 or even 1000E-2 are also accepted.
1990Non integer values result in NaN.
1991
1992Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results
1993in 'NaN'.
1994
1995bnorm() on a BigInt object is now effectively a no-op, since the numbers
1996are always stored in normalized form. On a string, it creates a BigInt
1997object.
a5f75d66 1998
1999=item Output
2000
58cde26e 2001Output values are BigInt objects (normalized), except for bstr(), which
2002returns a string in normalized form.
2003Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
2004C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
2005return either undef, <0, 0 or >0 and are suited for sort.
a5f75d66 2006
2007=back
2008
0716bf9b 2009=head1 ACCURACY and PRECISION
2010
b22b3e31 2011Since version v1.33, Math::BigInt and Math::BigFloat have full support for
0716bf9b 2012accuracy and precision based rounding, both automatically after every
b22b3e31 2013operation as well as manually.
0716bf9b 2014
2015This section describes the accuracy/precision handling in Math::Big* as it
b22b3e31 2016used to be and as it is now, complete with an explanation of all terms and
0716bf9b 2017abbreviations.
2018
2019Not yet implemented things (but with correct description) are marked with '!',
2020things that need to be answered are marked with '?'.
2021
2022In the next paragraph follows a short description of terms used here (because
574bacfe 2023these may differ from terms used by others people or documentation).
0716bf9b 2024
b22b3e31 2025During the rest of this document, the shortcuts A (for accuracy), P (for
0716bf9b 2026precision), F (fallback) and R (rounding mode) will be used.
2027
2028=head2 Precision P
2029
2030A fixed number of digits before (positive) or after (negative)
b22b3e31 2031the decimal point. For example, 123.45 has a precision of -2. 0 means an
2032integer like 123 (or 120). A precision of 2 means two digits to the left
2033of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
2034numbers with zeros before the decimal point may have different precisions,
2035because 1200 can have p = 0, 1 or 2 (depending on what the inital value
2036was). It could also have p < 0, when the digits after the decimal point
2037are zero.
0716bf9b 2038
574bacfe 2039The string output (of floating point numbers) will be padded with zeros:
2040
2041 Initial value P A Result String
2042 ------------------------------------------------------------
2043 1234.01 -3 1000 1000
2044 1234 -2 1200 1200
2045 1234.5 -1 1230 1230
2046 1234.001 1 1234 1234.0
2047 1234.01 0 1234 1234
2048 1234.01 2 1234.01 1234.01
2049 1234.01 5 1234.01 1234.01000
2050
2051For BigInts, no padding occurs.
0716bf9b 2052
2053=head2 Accuracy A
2054
2055Number of significant digits. Leading zeros are not counted. A
2056number may have an accuracy greater than the non-zero digits
b22b3e31 2057when there are zeros in it or trailing zeros. For example, 123.456 has
2058A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
0716bf9b 2059
574bacfe 2060The string output (of floating point numbers) will be padded with zeros:
2061
2062 Initial value P A Result String
2063 ------------------------------------------------------------
2064 1234.01 3 1230 1230
2065 1234.01 6 1234.01 1234.01
2066 1234.1 8 1234.1 1234.1000
2067
2068For BigInts, no padding occurs.
2069
0716bf9b 2070=head2 Fallback F
a5f75d66 2071
574bacfe 2072When both A and P are undefined, this is used as a fallback accuracy when
2073dividing numbers.
0716bf9b 2074
2075=head2 Rounding mode R
2076
2077When rounding a number, different 'styles' or 'kinds'
2078of rounding are possible. (Note that random rounding, as in
2079Math::Round, is not implemented.)
58cde26e 2080
2081=over 2
a5f75d66 2082
0716bf9b 2083=item 'trunc'
2084
2085truncation invariably removes all digits following the
2086rounding place, replacing them with zeros. Thus, 987.65 rounded
b22b3e31 2087to tens (P=1) becomes 980, and rounded to the fourth sigdig
0716bf9b 2088becomes 987.6 (A=4). 123.456 rounded to the second place after the
b22b3e31 2089decimal point (P=-2) becomes 123.46.
0716bf9b 2090
2091All other implemented styles of rounding attempt to round to the
2092"nearest digit." If the digit D immediately to the right of the
2093rounding place (skipping the decimal point) is greater than 5, the
2094number is incremented at the rounding place (possibly causing a
2095cascade of incrementation): e.g. when rounding to units, 0.9 rounds
2096to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
2097truncated at the rounding place: e.g. when rounding to units, 0.4
2098rounds to 0, and -19.4 rounds to -19.
2099
2100However the results of other styles of rounding differ if the
2101digit immediately to the right of the rounding place (skipping the
2102decimal point) is 5 and if there are no digits, or no digits other
2103than 0, after that 5. In such cases:
2104
2105=item 'even'
2106
2107rounds the digit at the rounding place to 0, 2, 4, 6, or 8
2108if it is not already. E.g., when rounding to the first sigdig, 0.45
2109becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
2110
2111=item 'odd'
2112
2113rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
2114it is not already. E.g., when rounding to the first sigdig, 0.45
2115becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
2116
2117=item '+inf'
2118
2119round to plus infinity, i.e. always round up. E.g., when
2120rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
b22b3e31 2121and 0.4501 also becomes 0.5.
0716bf9b 2122
2123=item '-inf'
2124
2125round to minus infinity, i.e. always round down. E.g., when
2126rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
2127but 0.4501 becomes 0.5.
2128
2129=item 'zero'
2130
2131round to zero, i.e. positive numbers down, negative ones up.
2132E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
2133becomes -0.5, but 0.4501 becomes 0.5.
2134
2135=back
2136
2137The handling of A & P in MBI/MBF (the old core code shipped with Perl
2138versions <= 5.7.2) is like this:
2139
2140=over 2
a5f75d66 2141
0716bf9b 2142=item Precision
2143
b22b3e31 2144 * ffround($p) is able to round to $p number of digits after the decimal
2145 point
0716bf9b 2146 * otherwise P is unused
2147
2148=item Accuracy (significant digits)
2149
2150 * fround($a) rounds to $a significant digits
2151 * only fdiv() and fsqrt() take A as (optional) paramater
b22b3e31 2152 + other operations simply create the same number (fneg etc), or more (fmul)
0716bf9b 2153 of digits
2154 + rounding/truncating is only done when explicitly calling one of fround
2155 or ffround, and never for BigInt (not implemented)
b22b3e31 2156 * fsqrt() simply hands its accuracy argument over to fdiv.
0716bf9b 2157 * the documentation and the comment in the code indicate two different ways
2158 on how fdiv() determines the maximum number of digits it should calculate,
2159 and the actual code does yet another thing
2160 POD:
2161 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
2162 Comment:
2163 result has at most max(scale, length(dividend), length(divisor)) digits
2164 Actual code:
2165 scale = max(scale, length(dividend)-1,length(divisor)-1);
2166 scale += length(divisior) - length(dividend);
b22b3e31 2167 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
0716bf9b 2168 Actually, the 'difference' added to the scale is calculated from the
2169 number of "significant digits" in dividend and divisor, which is derived
2170 by looking at the length of the mantissa. Which is wrong, since it includes
2171 the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups
2172 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
2173 assumption that 124 has 3 significant digits, while 120/7 will get you
2174 '17', not '17.1' since 120 is thought to have 2 significant digits.
2175 The rounding after the division then uses the reminder and $y to determine
2176 wether it must round up or down.
b22b3e31 2177 ? I have no idea which is the right way. That's why I used a slightly more
2178 ? simple scheme and tweaked the few failing testcases to match it.
58cde26e 2179
0716bf9b 2180=back
5dc6f178 2181
0716bf9b 2182This is how it works now:
5dc6f178 2183
0716bf9b 2184=over 2
5dc6f178 2185
0716bf9b 2186=item Setting/Accessing
2187
2188 * You can set the A global via $Math::BigInt::accuracy or
2189 $Math::BigFloat::accuracy or whatever class you are using.
2190 * You can also set P globally by using $Math::SomeClass::precision likewise.
2191 * Globals are classwide, and not inherited by subclasses.
2192 * to undefine A, use $Math::SomeCLass::accuracy = undef
2193 * to undefine P, use $Math::SomeClass::precision = undef
2194 * To be valid, A must be > 0, P can have any value.
b22b3e31 2195 * If P is negative, this means round to the P'th place to the right of the
2196 decimal point; positive values mean to the left of the decimal point.
2197 P of 0 means round to integer.
0716bf9b 2198 * to find out the current global A, take $Math::SomeClass::accuracy
2199 * use $x->accuracy() for the local setting of $x.
2200 * to find out the current global P, take $Math::SomeClass::precision
2201 * use $x->precision() for the local setting
2202
2203=item Creating numbers
2204
b22b3e31 2205 !* When you create a number, there should be a way to define its A & P
0716bf9b 2206 * When a number without specific A or P is created, but the globals are
b22b3e31 2207 defined, these should be used to round the number immediately and also
2208 stored locally with the number. Thus changing the global defaults later on
2209 will not change the A or P of previously created numbers (i.e., A and P of
0716bf9b 2210 $x will be what was in effect when $x was created)
2211
2212=item Usage
2213
b22b3e31 2214 * If A or P are enabled/defined, they are used to round the result of each
0716bf9b 2215 operation according to the rules below
b22b3e31 2216 * Negative P is ignored in Math::BigInt, since BigInts never have digits
2217 after the decimal point
574bacfe 2218 * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
2219 Math::BigInt as globals should not tamper with the parts of a BigFloat.
2220 Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
0716bf9b 2221
2222=item Precedence
2223
b22b3e31 2224 * It only makes sense that a number has only one of A or P at a time.
2225 Since you can set/get both A and P, there is a rule that will practically
2226 enforce only A or P to be in effect at a time, even if both are set.
2227 This is called precedence.
2228 !* If two objects are involved in an operation, and one of them has A in
0716bf9b 2229 ! effect, and the other P, this should result in a warning or an error,
2230 ! probably in NaN.
2231 * A takes precendence over P (Hint: A comes before P). If A is defined, it
b22b3e31 2232 is used, otherwise P is used. If neither of them is defined, nothing is
2233 used, i.e. the result will have as many digits as it can (with an
2234 exception for fdiv/fsqrt) and will not be rounded.
2235 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
2236 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
2237 If either the dividend's or the divisor's mantissa has more digits than
2238 the value of F, the higher value will be used instead of F.
2239 This is to limit the digits (A) of the result (just consider what would
2240 happen with unlimited A and P in the case of 1/3 :-)
2241 * fdiv will calculate 1 more digit than required (determined by
0716bf9b 2242 A, P or F), and, if F is not used, round the result
b22b3e31 2243 (this will still fail in the case of a result like 0.12345000000001 with A
574bacfe 2244 or P of 5, but this can not be helped - or can it?)
b22b3e31 2245 * Thus you can have the math done by on Math::Big* class in three modes:
0716bf9b 2246 + never round (this is the default):
2247 This is done by setting A and P to undef. No math operation
b22b3e31 2248 will round the result, with fdiv() and fsqrt() as exceptions to guard
0716bf9b 2249 against overflows. You must explicitely call bround(), bfround() or
b22b3e31 2250 round() (the latter with parameters).
2251 Note: Once you have rounded a number, the settings will 'stick' on it
2252 and 'infect' all other numbers engaged in math operations with it, since
0716bf9b 2253 local settings have the highest precedence. So, to get SaferRound[tm],
2254 use a copy() before rounding like this:
2255
2256 $x = Math::BigFloat->new(12.34);
2257 $y = Math::BigFloat->new(98.76);
2258 $z = $x * $y; # 1218.6984
2259 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
2260 $z = $x * $y; # still 1218.6984, without
2261 # copy would have been 1210!
2262
2263 + round after each op:
b22b3e31 2264 After each single operation (except for testing like is_zero()), the
2265 method round() is called and the result is rounded appropriately. By
0716bf9b 2266 setting proper values for A and P, you can have all-the-same-A or
b22b3e31 2267 all-the-same-P modes. For example, Math::Currency might set A to undef,
2268 and P to -2, globally.
0716bf9b 2269
b22b3e31 2270 ?Maybe an extra option that forbids local A & P settings would be in order,
2271 ?so that intermediate rounding does not 'poison' further math?
0716bf9b 2272
2273=item Overriding globals
2274
2275 * you will be able to give A, P and R as an argument to all the calculation
b22b3e31 2276 routines; the second parameter is A, the third one is P, and the fourth is
0716bf9b 2277 R (shift place by one for binary operations like add). P is used only if
b22b3e31 2278 the first parameter (A) is undefined. These three parameters override the
2279 globals in the order detailed as follows, i.e. the first defined value
0716bf9b 2280 wins:
b22b3e31 2281 (local: per object, global: global default, parameter: argument to sub)
0716bf9b 2282 + parameter A
2283 + parameter P
2284 + local A (if defined on both of the operands: smaller one is taken)
2285 + local P (if defined on both of the operands: smaller one is taken)
2286 + global A
2287 + global P
2288 + global F
b22b3e31 2289 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
0716bf9b 2290 arguments (A and P) instead of one
2291
2292=item Local settings
2293
2294 * You can set A and P locally by using $x->accuracy() and $x->precision()
2295 and thus force different A and P for different objects/numbers.
b22b3e31 2296 * Setting A or P this way immediately rounds $x to the new value.
0716bf9b 2297
2298=item Rounding
2299
b22b3e31 2300 * the rounding routines will use the respective global or local settings.
0716bf9b 2301 fround()/bround() is for accuracy rounding, while ffround()/bfround()
2302 is for precision
2303 * the two rounding functions take as the second parameter one of the
2304 following rounding modes (R):
2305 'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
2306 * you can set and get the global R by using Math::SomeClass->round_mode()
2307 or by setting $Math::SomeClass::rnd_mode
2308 * after each operation, $result->round() is called, and the result may
b22b3e31 2309 eventually be rounded (that is, if A or P were set either locally,
2310 globally or as parameter to the operation)
0716bf9b 2311 * to manually round a number, call $x->round($A,$P,$rnd_mode);
b22b3e31 2312 this will round the number by using the appropriate rounding function
0716bf9b 2313 and then normalize it.
b22b3e31 2314 * rounding modifies the local settings of the number:
0716bf9b 2315
2316 $x = Math::BigFloat->new(123.456);
2317 $x->accuracy(5);
2318 $x->bround(4);
2319
2320 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
2321 will be 4 from now on.
2322
2323=item Default values
2324
2325 * R: 'even'
2326 * F: 40
2327 * A: undef
2328 * P: undef
2329
2330=item Remarks
2331
2332 * The defaults are set up so that the new code gives the same results as
2333 the old code (except in a few cases on fdiv):
2334 + Both A and P are undefined and thus will not be used for rounding
2335 after each operation.
2336 + round() is thus a no-op, unless given extra parameters A and P
58cde26e 2337
2338=back
2339
0716bf9b 2340=head1 INTERNALS
2341
574bacfe 2342The actual numbers are stored as unsigned big integers (with seperate sign).
2343You should neither care about nor depend on the internal representation; it
2344might change without notice. Use only method calls like C<< $x->sign(); >>
2345instead relying on the internal hash keys like in C<< $x->{sign}; >>.
2346
2347=head2 MATH LIBRARY
58cde26e 2348
574bacfe 2349Math with the numbers is done (by default) by a module called
2350Math::BigInt::Calc. This is equivalent to saying:
2351
2352 use Math::BigInt lib => 'Calc';
58cde26e 2353
0716bf9b 2354You can change this by using:
58cde26e 2355
0716bf9b 2356 use Math::BigInt lib => 'BitVect';
58cde26e 2357
574bacfe 2358The following would first try to find Math::BigInt::Foo, then
2359Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
0716bf9b 2360
574bacfe 2361 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
58cde26e 2362
574bacfe 2363Calc.pm uses as internal format an array of elements of some decimal base
2364(usually 1e5, but this might change to 1e7) with the least significant digit
2365first, while BitVect.pm uses a bit vector of base 2, most significant bit
2366first. Other modules might use even different means of representing the
2367numbers. See the respective module documentation for further details.
58cde26e 2368
574bacfe 2369=head2 SIGN
2370
2371The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
2372
2373A sign of 'NaN' is used to represent the result when input arguments are not
2374numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
2375minus infinity. You will get '+inf' when dividing a positive number by 0, and
2376'-inf' when dividing any negative number by 0.
58cde26e 2377
2378=head2 mantissa(), exponent() and parts()
2379
2380C<mantissa()> and C<exponent()> return the said parts of the BigInt such
2381that:
2382
2383 $m = $x->mantissa();
2384 $e = $x->exponent();
2385 $y = $m * ( 10 ** $e );
2386 print "ok\n" if $x == $y;
2387
b22b3e31 2388C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
2389in one go. Both the returned mantissa and exponent have a sign.
58cde26e 2390
574bacfe 2391Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
2392where it will be NaN; and for $x == 0, where it will be 1
2393(to be compatible with Math::BigFloat's internal representation of a zero as
2394C<0E1>).
58cde26e 2395
2396C<$m> will always be a copy of the original number. The relation between $e
b22b3e31 2397and $m might change in the future, but will always be equivalent in a
0716bf9b 2398numerical sense, e.g. $m might get minimized.
2399
58cde26e 2400=head1 EXAMPLES
2401
574bacfe 2402 use Math::BigInt qw(bstr);
2403
2404 sub bint { Math::BigInt->new(shift); }
2405
58cde26e 2406 $x = bstr("1234") # string "1234"
2407 $x = "$x"; # same as bstr()
2408 $x = bneg("1234") # Bigint "-1234"
2409 $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
2410 $x = Math::BigInt->babs("-12345"); # Bigint "12345"
2411 $x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
2412 $x = bint(1) + bint(2); # BigInt "3"
2413 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
2414 $x = bint(1); # BigInt "1"
2415 $x = $x + 5 / 2; # BigInt "3"
2416 $x = $x ** 3; # BigInt "27"
2417 $x *= 2; # BigInt "54"
2418 $x = new Math::BigInt; # BigInt "0"
2419 $x--; # BigInt "-1"
2420 $x = Math::BigInt->badd(4,5) # BigInt "9"
2421 $x = Math::BigInt::badd(4,5) # BigInt "9"
2422 print $x->bsstr(); # 9e+0
a5f75d66 2423
0716bf9b 2424Examples for rounding:
2425
2426 use Math::BigFloat;
2427 use Test;
2428
2429 $x = Math::BigFloat->new(123.4567);
2430 $y = Math::BigFloat->new(123.456789);
2431 $Math::BigFloat::accuracy = 4; # no more A than 4
2432
2433 ok ($x->copy()->fround(),123.4); # even rounding
2434 print $x->copy()->fround(),"\n"; # 123.4
2435 Math::BigFloat->round_mode('odd'); # round to odd
2436 print $x->copy()->fround(),"\n"; # 123.5
2437 $Math::BigFloat::accuracy = 5; # no more A than 5
2438 Math::BigFloat->round_mode('odd'); # round to odd
2439 print $x->copy()->fround(),"\n"; # 123.46
2440 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
2441 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
2442
2443 $Math::BigFloat::accuracy = undef; # A not important
2444 $Math::BigFloat::precision = 2; # P important
2445 print $x->copy()->bnorm(),"\n"; # 123.46
2446 print $x->copy()->fround(),"\n"; # 123.46
2447
b3ac6de7 2448=head1 Autocreating constants
2449
58cde26e 2450After C<use Math::BigInt ':constant'> all the B<integer> decimal constants
2451in the given scope are converted to C<Math::BigInt>. This conversion
b3ac6de7 2452happens at compile time.
2453
b22b3e31 2454In particular,
b3ac6de7 2455
58cde26e 2456 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
2457
2458prints the integer value of C<2**100>. Note that without conversion of
0716bf9b 2459constants the expression 2**100 will be calculated as perl scalar.
58cde26e 2460
2461Please note that strings and floating point constants are not affected,
2462so that
2463
2464 use Math::BigInt qw/:constant/;
2465
2466 $x = 1234567890123456789012345678901234567890
2467 + 123456789123456789;
b22b3e31 2468 $y = '1234567890123456789012345678901234567890'
58cde26e 2469 + '123456789123456789';
b3ac6de7 2470
b22b3e31 2471do not work. You need an explicit Math::BigInt->new() around one of the
2472operands.
58cde26e 2473
2474=head1 PERFORMANCE
2475
2476Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
2477must be made in the second case. For long numbers, the copy can eat up to 20%
b22b3e31 2478of the work (in the case of addition/subtraction, less for
58cde26e 2479multiplication/division). If $y is very small compared to $x, the form
2480$x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
2481more time then the actual addition.
2482
b22b3e31 2483With a technique called copy-on-write, the cost of copying with overload could
58cde26e 2484be minimized or even completely avoided. This is currently not implemented.
2485
2486The new version of this module is slower on new(), bstr() and numify(). Some
2487operations may be slower for small numbers, but are significantly faster for
2488big numbers. Other operations are now constant (O(1), like bneg(), babs()
2489etc), instead of O(N) and thus nearly always take much less time.
2490
574bacfe 2491If you find the Calc module to slow, try to install any of the replacement
2492modules and see if they help you.
b3ac6de7 2493
574bacfe 2494=head2 Alternative math libraries
0716bf9b 2495
2496You can use an alternative library to drive Math::BigInt via:
2497
2498 use Math::BigInt lib => 'Module';
2499
574bacfe 2500The default is called Math::BigInt::Calc and is a pure-perl implementation
2501that consists mainly of the standard routine present in earlier versions of
2502Math::BigInt.
0716bf9b 2503
2504There are also Math::BigInt::Scalar (primarily for testing) and
574bacfe 2505Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
2506All these can be found via L<http://search.cpan.org/>:
0716bf9b 2507
2508 use Math::BigInt lib => 'BitVect';
2509
2510 my $x = Math::BigInt->new(2);
2511 print $x ** (1024*1024);
2512
574bacfe 2513For more benchmark results see http://bloodgate.com/perl/benchmarks.html
2514
a5f75d66 2515=head1 BUGS
2516
58cde26e 2517=over 2
2518
574bacfe 2519=item Out of Memory!
58cde26e 2520
2521Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
2522C<eval()> in your code will crash with "Out of memory". This is probably an
2523overload/exporter bug. You can workaround by not having C<eval()>
574bacfe 2524and ':constant' at the same time or upgrade your Perl to a newer version.
2525
2526=item Fails to load Calc on Perl prior 5.6.0
2527
2528Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
2529will fall back to eval { require ... } when loading the math lib on Perls
2530prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
2531filesystems using a different seperator.
58cde26e 2532
2533=back
2534
2535=head1 CAVEATS
2536
2537Some things might not work as you expect them. Below is documented what is
2538known to be troublesome:
2539
2540=over 1
2541
2542=item stringify, bstr(), bsstr() and 'cmp'
2543
2544Both stringify and bstr() now drop the leading '+'. The old code would return
2545'+3', the new returns '3'. This is to be consistent with Perl and to make
2546cmp (especially with overloading) to work as you expect. It also solves
2547problems with Test.pm, it's ok() uses 'eq' internally.
2548
2549Mark said, when asked about to drop the '+' altogether, or make only cmp work:
2550
2551 I agree (with the first alternative), don't add the '+' on positive
2552 numbers. It's not as important anymore with the new internal
2553 form for numbers. It made doing things like abs and neg easier,
2554 but those have to be done differently now anyway.
2555
2556So, the following examples will now work all as expected:
2557
2558 use Test;
2559 BEGIN { plan tests => 1 }
2560 use Math::BigInt;
2561
2562 my $x = new Math::BigInt 3*3;
2563 my $y = new Math::BigInt 3*3;
2564
2565 ok ($x,3*3);
2566 print "$x eq 9" if $x eq $y;
2567 print "$x eq 9" if $x eq '9';
2568 print "$x eq 9" if $x eq 3*3;
2569
2570Additionally, the following still works:
2571
2572 print "$x == 9" if $x == $y;
2573 print "$x == 9" if $x == 9;
2574 print "$x == 9" if $x == 3*3;
2575
2576There is now a C<bsstr()> method to get the string in scientific notation aka
2577C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
2578for comparisation, but Perl will represent some numbers as 100 and others
2579as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq:
2580
2581 use Test;
2582 BEGIN { plan tests => 3 }
2583 use Math::BigInt;
2584
2585 $x = Math::BigInt->new('1e56'); $y = 1e56;
2586 ok ($x,$y); # will fail
2587 ok ($x->bsstr(),$y); # okay
2588 $y = Math::BigInt->new($y);
2589 ok ($x,$y); # okay
2590
574bacfe 2591There is not yet a way to get a number automatically represented in exactly
2592the way Perl represents it.
2593
58cde26e 2594=item int()
2595
2596C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
2597Perl scalar:
2598
2599 $x = Math::BigInt->new(123);
2600 $y = int($x); # BigInt 123
2601 $x = Math::BigFloat->new(123.45);
2602 $y = int($x); # BigInt 123
2603
2604In all Perl versions you can use C<as_number()> for the same effect:
2605
2606 $x = Math::BigFloat->new(123.45);
2607 $y = $x->as_number(); # BigInt 123
2608
2609This also works for other subclasses, like Math::String.
2610
574bacfe 2611It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
2612
58cde26e 2613=item bdiv
2614
2615The following will probably not do what you expect:
2616
2617 print $c->bdiv(10000),"\n";
2618
2619It prints both quotient and reminder since print calls C<bdiv()> in list
2620context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
2621to use
2622
2623 print $c / 10000,"\n";
2624 print scalar $c->bdiv(10000),"\n"; # or if you want to modify $c
2625
2626instead.
2627
2628The quotient is always the greatest integer less than or equal to the
2629real-valued quotient of the two operands, and the remainder (when it is
2630nonzero) always has the same sign as the second operand; so, for
2631example,
2632
574bacfe 2633 1 / 4 => ( 0, 1)
2634 1 / -4 => (-1,-3)
58cde26e 2635 -3 / 4 => (-1, 1)
2636 -3 / -4 => ( 0,-3)
2637
2638As a consequence, the behavior of the operator % agrees with the
2639behavior of Perl's built-in % operator (as documented in the perlop
2640manpage), and the equation
2641
2642 $x == ($x / $y) * $y + ($x % $y)
2643
2644holds true for any $x and $y, which justifies calling the two return
2645values of bdiv() the quotient and remainder.
2646
2647Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
2648not change BigInt's way to do things. This is because under 'use integer' Perl
2649will do what the underlying C thinks is right and this is different for each
2650system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
2651the author to implement it ;)
2652
2653=item Modifying and =
2654
2655Beware of:
2656
2657 $x = Math::BigFloat->new(5);
2658 $y = $x;
2659
2660It will not do what you think, e.g. making a copy of $x. Instead it just makes
2661a second reference to the B<same> object and stores it in $y. Thus anything
2662that modifies $x will modify $y, and vice versa.
2663
2664 $x->bmul(2);
2665 print "$x, $y\n"; # prints '10, 10'
2666
2667If you want a true copy of $x, use:
2668
2669 $y = $x->copy();
2670
b22b3e31 2671See also the documentation for overload.pm regarding C<=>.
58cde26e 2672
2673=item bpow
2674
2675C<bpow()> (and the rounding functions) now modifies the first argument and
574bacfe 2676returns it, unlike the old code which left it alone and only returned the
58cde26e 2677result. This is to be consistent with C<badd()> etc. The first three will
2678modify $x, the last one won't:
2679
2680 print bpow($x,$i),"\n"; # modify $x
2681 print $x->bpow($i),"\n"; # ditto
2682 print $x **= $i,"\n"; # the same
2683 print $x ** $i,"\n"; # leave $x alone
2684
2685The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
2686
2687=item Overloading -$x
2688
2689The following:
2690
2691 $x = -$x;
2692
2693is slower than
2694
2695 $x->bneg();
2696
2697since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
2698needs to preserve $x since it does not know that it later will get overwritten.
0716bf9b 2699This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
58cde26e 2700
2701With Copy-On-Write, this issue will be gone. Stay tuned...
2702
2703=item Mixing different object types
2704
2705In Perl you will get a floating point value if you do one of the following:
2706
2707 $float = 5.0 + 2;
2708 $float = 2 + 5.0;
2709 $float = 5 / 2;
2710
2711With overloaded math, only the first two variants will result in a BigFloat:
2712
2713 use Math::BigInt;
2714 use Math::BigFloat;
2715
2716 $mbf = Math::BigFloat->new(5);
2717 $mbi2 = Math::BigInteger->new(5);
2718 $mbi = Math::BigInteger->new(2);
2719
2720 # what actually gets called:
2721 $float = $mbf + $mbi; # $mbf->badd()
2722 $float = $mbf / $mbi; # $mbf->bdiv()
2723 $integer = $mbi + $mbf; # $mbi->badd()
2724 $integer = $mbi2 / $mbi; # $mbi2->bdiv()
2725 $integer = $mbi2 / $mbf; # $mbi2->bdiv()
2726
2727This is because math with overloaded operators follows the first (dominating)
2728operand, this one's operation is called and returns thus the result. So,
2729Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
2730the result should be a Math::BigFloat or the second operant is one.
2731
2732To get a Math::BigFloat you either need to call the operation manually,
2733make sure the operands are already of the proper type or casted to that type
2734via Math::BigFloat->new():
2735
2736 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
2737
2738Beware of simple "casting" the entire expression, this would only convert
2739the already computed result:
2740
2741 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
2742
0716bf9b 2743Beware also of the order of more complicated expressions like:
58cde26e 2744
2745 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
2746 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
2747
2748If in doubt, break the expression into simpler terms, or cast all operands
2749to the desired resulting type.
2750
2751Scalar values are a bit different, since:
2752
2753 $float = 2 + $mbf;
2754 $float = $mbf + 2;
2755
2756will both result in the proper type due to the way the overloaded math works.
2757
2758This section also applies to other overloaded math packages, like Math::String.
2759
2760=item bsqrt()
2761
2762C<bsqrt()> works only good if the result is an big integer, e.g. the square
2763root of 144 is 12, but from 12 the square root is 3, regardless of rounding
2764mode.
2765
2766If you want a better approximation of the square root, then use:
2767
2768 $x = Math::BigFloat->new(12);
2769 $Math::BigFloat::precision = 0;
2770 Math::BigFloat->round_mode('even');
2771 print $x->copy->bsqrt(),"\n"; # 4
2772
2773 $Math::BigFloat::precision = 2;
2774 print $x->bsqrt(),"\n"; # 3.46
2775 print $x->bsqrt(3),"\n"; # 3.464
2776
2777=back
2778
2779=head1 LICENSE
2780
2781This program is free software; you may redistribute it and/or modify it under
2782the same terms as Perl itself.
a5f75d66 2783
0716bf9b 2784=head1 SEE ALSO
2785
2786L<Math::BigFloat> and L<Math::Big>.
2787
574bacfe 2788L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
2789
58cde26e 2790=head1 AUTHORS
a5f75d66 2791
58cde26e 2792Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
2793Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
a5f75d66 2794
2795=cut
Unnamed repository; edit this file to name it for gitweb.