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