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