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