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