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