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