This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Archive::Extract 0.24 (was Re: Archive::Extract test failures on Solaris)
[perl5.git] / lib / Math / BigInt.pm
CommitLineData
13a12e00
JH
1package Math::BigInt;
2
3#
4# "Mike had an infinite amount to do and a negative amount of time in which
5# to do it." - Before and After
6#
7
58cde26e 8# The following hash values are used:
0716bf9b 9# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
58cde26e
JH
10# sign : +,-,NaN,+inf,-inf
11# _a : accuracy
12# _p : precision
0716bf9b 13# _f : flags, used by MBF to flag parts of a float as untouchable
b4f14daa 14
574bacfe
JH
15# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
16# underlying lib might change the reference!
17
58cde26e 18my $class = "Math::BigInt";
08a3f4a9 19use 5.006;
58cde26e 20
7aa7e0ae 21$VERSION = '1.88';
b68b7ab1 22
233f7bc0
T
23@ISA = qw(Exporter);
24@EXPORT_OK = qw(objectify bgcd blcm);
b68b7ab1 25
b282a552
T
26# _trap_inf and _trap_nan are internal and should never be accessed from the
27# outside
28use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
29 $upgrade $downgrade $_trap_nan $_trap_inf/;
58cde26e
JH
30use strict;
31
32# Inside overload, the first arg is always an object. If the original code had
091c87b1
T
33# it reversed (like $x = 2 * $y), then the third paramater is true.
34# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
35# no difference, but in some cases it does.
58cde26e
JH
36
37# For overloaded ops with only one argument we simple use $_[0]->copy() to
38# preserve the argument.
39
40# Thus inheritance of overload operators becomes possible and transparent for
41# our subclasses without the need to repeat the entire overload section there.
a0d0e21e 42
a5f75d66 43use overload
58cde26e
JH
44'=' => sub { $_[0]->copy(); },
45
58cde26e
JH
46# some shortcuts for speed (assumes that reversed order of arguments is routed
47# to normal '+' and we thus can always modify first arg. If this is changed,
48# this breaks and must be adjusted.)
49'+=' => sub { $_[0]->badd($_[1]); },
50'-=' => sub { $_[0]->bsub($_[1]); },
51'*=' => sub { $_[0]->bmul($_[1]); },
52'/=' => sub { scalar $_[0]->bdiv($_[1]); },
027dc388
JH
53'%=' => sub { $_[0]->bmod($_[1]); },
54'^=' => sub { $_[0]->bxor($_[1]); },
55'&=' => sub { $_[0]->band($_[1]); },
56'|=' => sub { $_[0]->bior($_[1]); },
58cde26e 57
b68b7ab1 58'**=' => sub { $_[0]->bpow($_[1]); },
2d2b2744
T
59'<<=' => sub { $_[0]->blsft($_[1]); },
60'>>=' => sub { $_[0]->brsft($_[1]); },
61
b3abae2a 62# not supported by Perl yet
027dc388
JH
63'..' => \&_pointpoint,
64
a0ac753d 65'<=>' => sub { my $rc = $_[2] ?
bd05a461 66 ref($_[0])->bcmp($_[1],$_[0]) :
a0ac753d
T
67 $_[0]->bcmp($_[1]);
68 $rc = 1 unless defined $rc;
69 $rc <=> 0;
70 },
71# we need '>=' to get things like "1 >= NaN" right:
72'>=' => sub { my $rc = $_[2] ?
73 ref($_[0])->bcmp($_[1],$_[0]) :
74 $_[0]->bcmp($_[1]);
75 # if there was a NaN involved, return false
76 return '' unless defined $rc;
77 $rc >= 0;
78 },
027dc388 79'cmp' => sub {
58cde26e 80 $_[2] ?
b3abae2a
JH
81 "$_[1]" cmp $_[0]->bstr() :
82 $_[0]->bstr() cmp "$_[1]" },
58cde26e 83
60a1aa19
T
84'cos' => sub { $_[0]->copy->bcos(); },
85'sin' => sub { $_[0]->copy->bsin(); },
a87115f0 86'atan2' => sub { $_[2] ?
20e2035c
T
87 ref($_[0])->new($_[1])->batan2($_[0]) :
88 $_[0]->copy()->batan2($_[1]) },
091c87b1 89
b68b7ab1
T
90# are not yet overloadable
91#'hex' => sub { print "hex"; $_[0]; },
92#'oct' => sub { print "oct"; $_[0]; },
93
a0ac753d
T
94# log(N) is log(N, e), where e is Euler's number
95'log' => sub { $_[0]->copy()->blog($_[1], undef); },
7d193e39 96'exp' => sub { $_[0]->copy()->bexp($_[1]); },
58cde26e
JH
97'int' => sub { $_[0]->copy(); },
98'neg' => sub { $_[0]->copy()->bneg(); },
99'abs' => sub { $_[0]->copy()->babs(); },
b3abae2a 100'sqrt' => sub { $_[0]->copy()->bsqrt(); },
58cde26e
JH
101'~' => sub { $_[0]->copy()->bnot(); },
102
12fc2493 103# for subtract it's a bit tricky to not modify b: b-a => -a+b
091c87b1 104'-' => sub { my $c = $_[0]->copy; $_[2] ?
a87115f0
RGS
105 $c->bneg()->badd( $_[1]) :
106 $c->bsub( $_[1]) },
091c87b1
T
107'+' => sub { $_[0]->copy()->badd($_[1]); },
108'*' => sub { $_[0]->copy()->bmul($_[1]); },
109
110'/' => sub {
111 $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]);
112 },
113'%' => sub {
114 $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]);
115 },
116'**' => sub {
117 $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]);
118 },
119'<<' => sub {
120 $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]);
121 },
122'>>' => sub {
123 $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]);
124 },
125'&' => sub {
126 $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]);
127 },
128'|' => sub {
129 $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]);
130 },
131'^' => sub {
132 $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]);
133 },
134
135# can modify arg of ++ and --, so avoid a copy() for speed, but don't
136# use $_[0]->bone(), it would modify $_[0] to be 1!
58cde26e
JH
137'++' => sub { $_[0]->binc() },
138'--' => sub { $_[0]->bdec() },
139
140# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
141'bool' => sub {
142 # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
091c87b1 143 # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
3a427a11
RGS
144 my $t = undef;
145 $t = 1 if !$_[0]->is_zero();
b3abae2a 146 $t;
58cde26e 147 },
a0d0e21e 148
027dc388
JH
149# the original qw() does not work with the TIESCALAR below, why?
150# Order of arguments unsignificant
151'""' => sub { $_[0]->bstr(); },
152'0+' => sub { $_[0]->numify(); }
a5f75d66 153;
a0d0e21e 154
58cde26e
JH
155##############################################################################
156# global constants, flags and accessory
157
b68b7ab1
T
158# These vars are public, but their direct usage is not recommended, use the
159# accessor methods instead
0716bf9b 160
7b29e1e6 161$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
ee15d750
JH
162$accuracy = undef;
163$precision = undef;
164$div_scale = 40;
58cde26e 165
b3abae2a
JH
166$upgrade = undef; # default is no upgrade
167$downgrade = undef; # default is no downgrade
168
b68b7ab1 169# These are internally, and not to be used from the outside at all
990fb837
RGS
170
171$_trap_nan = 0; # are NaNs ok? set w/ config()
172$_trap_inf = 0; # are infs ok? set w/ config()
173my $nan = 'NaN'; # constants for easier life
174
233f7bc0
T
175my $CALC = 'Math::BigInt::FastCalc'; # module to do the low level math
176 # default is FastCalc.pm
990fb837
RGS
177my $IMPORT = 0; # was import() called yet?
178 # used to make require work
9b924220
RGS
179my %WARN; # warn only once for low-level libs
180my %CAN; # cache for $CALC->can(...)
b68b7ab1 181my %CALLBACKS; # callbacks to notify on lib loads
b282a552 182my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
b282a552 183
027dc388
JH
184##############################################################################
185# the old code had $rnd_mode, so we need to support it, too
186
187$rnd_mode = 'even';
188sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; }
189sub FETCH { return $round_mode; }
190sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
191
b282a552
T
192BEGIN
193 {
194 # tie to enable $rnd_mode to work transparently
195 tie $rnd_mode, 'Math::BigInt';
196
197 # set up some handy alias names
198 *as_int = \&as_number;
199 *is_pos = \&is_positive;
200 *is_neg = \&is_negative;
201 }
027dc388
JH
202
203##############################################################################
204
58cde26e
JH
205sub round_mode
206 {
ee15d750 207 no strict 'refs';
58cde26e 208 # make Class->round_mode() work
ee15d750
JH
209 my $self = shift;
210 my $class = ref($self) || $self || __PACKAGE__;
58cde26e
JH
211 if (defined $_[0])
212 {
213 my $m = shift;
7b29e1e6 214 if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837
RGS
215 {
216 require Carp; Carp::croak ("Unknown round mode '$m'");
217 }
b3abae2a 218 return ${"${class}::round_mode"} = $m;
58cde26e 219 }
990fb837 220 ${"${class}::round_mode"};
ee15d750
JH
221 }
222
b3abae2a
JH
223sub upgrade
224 {
225 no strict 'refs';
28df3e88 226 # make Class->upgrade() work
b3abae2a
JH
227 my $self = shift;
228 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
229 # need to set new value?
230 if (@_ > 0)
b3abae2a 231 {
b68b7ab1 232 return ${"${class}::upgrade"} = $_[0];
b3abae2a 233 }
990fb837 234 ${"${class}::upgrade"};
b3abae2a
JH
235 }
236
28df3e88
JH
237sub downgrade
238 {
239 no strict 'refs';
240 # make Class->downgrade() work
241 my $self = shift;
242 my $class = ref($self) || $self || __PACKAGE__;
9393ace2
JH
243 # need to set new value?
244 if (@_ > 0)
28df3e88 245 {
b68b7ab1 246 return ${"${class}::downgrade"} = $_[0];
28df3e88 247 }
990fb837 248 ${"${class}::downgrade"};
28df3e88
JH
249 }
250
ee15d750
JH
251sub div_scale
252 {
253 no strict 'refs';
990fb837 254 # make Class->div_scale() work
ee15d750
JH
255 my $self = shift;
256 my $class = ref($self) || $self || __PACKAGE__;
257 if (defined $_[0])
258 {
990fb837
RGS
259 if ($_[0] < 0)
260 {
261 require Carp; Carp::croak ('div_scale must be greater than zero');
262 }
b68b7ab1 263 ${"${class}::div_scale"} = $_[0];
ee15d750 264 }
990fb837 265 ${"${class}::div_scale"};
58cde26e
JH
266 }
267
268sub accuracy
269 {
ee15d750
JH
270 # $x->accuracy($a); ref($x) $a
271 # $x->accuracy(); ref($x)
272 # Class->accuracy(); class
273 # Class->accuracy($a); class $a
58cde26e 274
ee15d750
JH
275 my $x = shift;
276 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 277
ee15d750
JH
278 no strict 'refs';
279 # need to set new value?
58cde26e
JH
280 if (@_ > 0)
281 {
ee15d750 282 my $a = shift;
990fb837
RGS
283 # convert objects to scalars to avoid deep recursion. If object doesn't
284 # have numify(), then hopefully it will have overloading for int() and
285 # boolean test without wandering into a deep recursion path...
286 $a = $a->numify() if ref($a) && $a->can('numify');
287
288 if (defined $a)
289 {
290 # also croak on non-numerical
291 if (!$a || $a <= 0)
292 {
293 require Carp;
294 Carp::croak ('Argument to accuracy must be greater than zero');
295 }
296 if (int($a) != $a)
297 {
298 require Carp; Carp::croak ('Argument to accuracy must be an integer');
299 }
300 }
ee15d750
JH
301 if (ref($x))
302 {
303 # $object->accuracy() or fallback to global
ef9466ea
T
304 $x->bround($a) if $a; # not for undef, 0
305 $x->{_a} = $a; # set/overwrite, even if not rounded
306 delete $x->{_p}; # clear P
990fb837 307 $a = ${"${class}::accuracy"} unless defined $a; # proper return value
ee15d750
JH
308 }
309 else
310 {
ef9466ea
T
311 ${"${class}::accuracy"} = $a; # set global A
312 ${"${class}::precision"} = undef; # clear global P
ee15d750 313 }
ef9466ea 314 return $a; # shortcut
ee15d750
JH
315 }
316
b68b7ab1 317 my $a;
f9a08e12 318 # $object->accuracy() or fallback to global
b68b7ab1 319 $a = $x->{_a} if ref($x);
f9a08e12 320 # but don't return global undef, when $x's accuracy is 0!
b68b7ab1
T
321 $a = ${"${class}::accuracy"} if !defined $a;
322 $a;
990fb837 323 }
58cde26e
JH
324
325sub precision
326 {
ee15d750
JH
327 # $x->precision($p); ref($x) $p
328 # $x->precision(); ref($x)
329 # Class->precision(); class
330 # Class->precision($p); class $p
58cde26e 331
ee15d750
JH
332 my $x = shift;
333 my $class = ref($x) || $x || __PACKAGE__;
58cde26e 334
ee15d750 335 no strict 'refs';
58cde26e
JH
336 if (@_ > 0)
337 {
ee15d750 338 my $p = shift;
990fb837
RGS
339 # convert objects to scalars to avoid deep recursion. If object doesn't
340 # have numify(), then hopefully it will have overloading for int() and
341 # boolean test without wandering into a deep recursion path...
342 $p = $p->numify() if ref($p) && $p->can('numify');
343 if ((defined $p) && (int($p) != $p))
344 {
345 require Carp; Carp::croak ('Argument to precision must be an integer');
346 }
ee15d750
JH
347 if (ref($x))
348 {
349 # $object->precision() or fallback to global
ef9466ea
T
350 $x->bfround($p) if $p; # not for undef, 0
351 $x->{_p} = $p; # set/overwrite, even if not rounded
352 delete $x->{_a}; # clear A
990fb837 353 $p = ${"${class}::precision"} unless defined $p; # proper return value
ee15d750
JH
354 }
355 else
356 {
ef9466ea
T
357 ${"${class}::precision"} = $p; # set global P
358 ${"${class}::accuracy"} = undef; # clear global A
ee15d750 359 }
ef9466ea 360 return $p; # shortcut
58cde26e 361 }
ee15d750 362
b68b7ab1 363 my $p;
f9a08e12 364 # $object->precision() or fallback to global
b68b7ab1 365 $p = $x->{_p} if ref($x);
f9a08e12 366 # but don't return global undef, when $x's precision is 0!
b68b7ab1
T
367 $p = ${"${class}::precision"} if !defined $p;
368 $p;
990fb837 369 }
58cde26e 370
b3abae2a
JH
371sub config
372 {
990fb837 373 # return (or set) configuration data as hash ref
b3abae2a
JH
374 my $class = shift || 'Math::BigInt';
375
376 no strict 'refs';
2ebb273f 377 if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH')))
990fb837
RGS
378 {
379 # try to set given options as arguments from hash
380
381 my $args = $_[0];
382 if (ref($args) ne 'HASH')
383 {
384 $args = { @_ };
385 }
386 # these values can be "set"
387 my $set_args = {};
388 foreach my $key (
389 qw/trap_inf trap_nan
390 upgrade downgrade precision accuracy round_mode div_scale/
391 )
392 {
393 $set_args->{$key} = $args->{$key} if exists $args->{$key};
394 delete $args->{$key};
395 }
396 if (keys %$args > 0)
397 {
398 require Carp;
399 Carp::croak ("Illegal key(s) '",
400 join("','",keys %$args),"' passed to $class\->config()");
401 }
402 foreach my $key (keys %$set_args)
403 {
404 if ($key =~ /^trap_(inf|nan)\z/)
405 {
406 ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
407 next;
408 }
409 # use a call instead of just setting the $variable to check argument
410 $class->$key($set_args->{$key});
411 }
412 }
413
414 # now return actual configuration
415
b3abae2a 416 my $cfg = {
990fb837
RGS
417 lib => $CALC,
418 lib_version => ${"${CALC}::VERSION"},
b3abae2a 419 class => $class,
990fb837
RGS
420 trap_nan => ${"${class}::_trap_nan"},
421 trap_inf => ${"${class}::_trap_inf"},
422 version => ${"${class}::VERSION"},
b3abae2a 423 };
990fb837
RGS
424 foreach my $key (qw/
425 upgrade downgrade precision accuracy round_mode div_scale
426 /)
b3abae2a 427 {
990fb837 428 $cfg->{$key} = ${"${class}::$key"};
b3abae2a 429 };
2ebb273f
T
430 if (@_ == 1 && (ref($_[0]) ne 'HASH'))
431 {
432 # calls of the style config('lib') return just this value
433 return $cfg->{$_[0]};
434 }
b3abae2a
JH
435 $cfg;
436 }
437
58cde26e
JH
438sub _scale_a
439 {
440 # select accuracy parameter based on precedence,
441 # used by bround() and bfround(), may return undef for scale (means no op)
b68b7ab1
T
442 my ($x,$scale,$mode) = @_;
443
444 $scale = $x->{_a} unless defined $scale;
445
446 no strict 'refs';
447 my $class = ref($x);
448
449 $scale = ${ $class . '::accuracy' } unless defined $scale;
450 $mode = ${ $class . '::round_mode' } unless defined $mode;
451
452 ($scale,$mode);
58cde26e
JH
453 }
454
455sub _scale_p
456 {
457 # select precision parameter based on precedence,
458 # used by bround() and bfround(), may return undef for scale (means no op)
b68b7ab1
T
459 my ($x,$scale,$mode) = @_;
460
461 $scale = $x->{_p} unless defined $scale;
462
463 no strict 'refs';
464 my $class = ref($x);
465
466 $scale = ${ $class . '::precision' } unless defined $scale;
467 $mode = ${ $class . '::round_mode' } unless defined $mode;
468
469 ($scale,$mode);
58cde26e
JH
470 }
471
472##############################################################################
473# constructors
474
475sub copy
476 {
86f0d17a 477 # if two arguments, the first one is the class to "swallow" subclasses
58cde26e
JH
478 if (@_ > 1)
479 {
86f0d17a
T
480 my $self = bless {
481 sign => $_[1]->{sign},
482 value => $CALC->_copy($_[1]->{value}),
483 }, $_[0] if @_ > 1;
484
485 $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
486 $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
487 return $self;
58cde26e 488 }
58cde26e 489
86f0d17a
T
490 my $self = bless {
491 sign => $_[0]->{sign},
492 value => $CALC->_copy($_[0]->{value}),
493 }, ref($_[0]);
9b924220 494
86f0d17a
T
495 $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
496 $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
58cde26e
JH
497 $self;
498 }
499
500sub new
501 {
b22b3e31 502 # create a new BigInt object from a string or another BigInt object.
0716bf9b 503 # see hash keys documented at top
58cde26e
JH
504
505 # the argument could be an object, so avoid ||, && etc on it, this would
b22b3e31
PN
506 # cause costly overloaded code to be called. The only allowed ops are
507 # ref() and defined.
58cde26e 508
61f5c3f5 509 my ($class,$wanted,$a,$p,$r) = @_;
58cde26e 510
61f5c3f5
T
511 # avoid numify-calls by not using || on $wanted!
512 return $class->bzero($a,$p) if !defined $wanted; # default to 0
9393ace2
JH
513 return $class->copy($wanted,$a,$p,$r)
514 if ref($wanted) && $wanted->isa($class); # MBI or subclass
58cde26e 515
61f5c3f5
T
516 $class->import() if $IMPORT == 0; # make require work
517
9393ace2
JH
518 my $self = bless {}, $class;
519
520 # shortcut for "normal" numbers
739c8b3a 521 if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
9393ace2
JH
522 {
523 $self->{sign} = $1 || '+';
9b924220 524
9393ace2
JH
525 if ($wanted =~ /^[+-]/)
526 {
56d9de68 527 # remove sign without touching wanted to make it work with constants
9b924220
RGS
528 my $t = $wanted; $t =~ s/^[+-]//;
529 $self->{value} = $CALC->_new($t);
530 }
531 else
532 {
533 $self->{value} = $CALC->_new($wanted);
9393ace2 534 }
9393ace2
JH
535 no strict 'refs';
536 if ( (defined $a) || (defined $p)
537 || (defined ${"${class}::precision"})
538 || (defined ${"${class}::accuracy"})
539 )
540 {
541 $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
542 }
543 return $self;
544 }
545
58cde26e 546 # handle '+inf', '-inf' first
233f7bc0 547 if ($wanted =~ /^[+-]?inf\z/)
58cde26e 548 {
233f7bc0
T
549 $self->{sign} = $wanted; # set a default sign for bstr()
550 return $self->binf($wanted);
58cde26e
JH
551 }
552 # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
9b924220 553 my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
58cde26e
JH
554 if (!ref $mis)
555 {
990fb837
RGS
556 if ($_trap_nan)
557 {
558 require Carp; Carp::croak("$wanted is not a number in $class");
559 }
0716bf9b 560 $self->{value} = $CALC->_zero();
58cde26e
JH
561 $self->{sign} = $nan;
562 return $self;
563 }
574bacfe
JH
564 if (!ref $miv)
565 {
566 # _from_hex or _from_bin
567 $self->{value} = $mis->{value};
568 $self->{sign} = $mis->{sign};
569 return $self; # throw away $mis
570 }
58cde26e
JH
571 # make integer from mantissa by adjusting exp, then convert to bigint
572 $self->{sign} = $$mis; # store sign
0716bf9b 573 $self->{value} = $CALC->_zero(); # for all the NaN cases
58cde26e
JH
574 my $e = int("$$es$$ev"); # exponent (avoid recursion)
575 if ($e > 0)
576 {
577 my $diff = $e - CORE::length($$mfv);
578 if ($diff < 0) # Not integer
579 {
990fb837
RGS
580 if ($_trap_nan)
581 {
582 require Carp; Carp::croak("$wanted not an integer in $class");
583 }
58cde26e 584 #print "NOI 1\n";
b3abae2a 585 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
586 $self->{sign} = $nan;
587 }
588 else # diff >= 0
589 {
590 # adjust fraction and add it to value
990fb837 591 #print "diff > 0 $$miv\n";
58cde26e
JH
592 $$miv = $$miv . ($$mfv . '0' x $diff);
593 }
594 }
595 else
596 {
597 if ($$mfv ne '') # e <= 0
598 {
599 # fraction and negative/zero E => NOI
990fb837
RGS
600 if ($_trap_nan)
601 {
602 require Carp; Carp::croak("$wanted not an integer in $class");
603 }
58cde26e 604 #print "NOI 2 \$\$mfv '$$mfv'\n";
b3abae2a 605 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
606 $self->{sign} = $nan;
607 }
608 elsif ($e < 0)
609 {
610 # xE-y, and empty mfv
611 #print "xE-y\n";
612 $e = abs($e);
613 if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
614 {
990fb837
RGS
615 if ($_trap_nan)
616 {
617 require Carp; Carp::croak("$wanted not an integer in $class");
618 }
58cde26e 619 #print "NOI 3\n";
b3abae2a 620 return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
58cde26e
JH
621 $self->{sign} = $nan;
622 }
623 }
624 }
625 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
9b924220 626 $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
0716bf9b 627 # if any of the globals is set, use them to round and store them inside $self
61f5c3f5
T
628 # do not round for new($x,undef,undef) since that is used by MBF to signal
629 # no rounding
630 $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
9393ace2 631 $self;
58cde26e
JH
632 }
633
58cde26e
JH
634sub bnan
635 {
636 # create a bigint 'NaN', if given a BigInt, set it to 'NaN'
b4f14daa 637 my $self = shift;
58cde26e
JH
638 $self = $class if !defined $self;
639 if (!ref($self))
640 {
641 my $c = $self; $self = {}; bless $self, $c;
642 }
990fb837
RGS
643 no strict 'refs';
644 if (${"${class}::_trap_nan"})
645 {
646 require Carp;
647 Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
648 }
61f5c3f5 649 $self->import() if $IMPORT == 0; # make require work
58cde26e 650 return if $self->modify('bnan');
13a12e00
JH
651 if ($self->can('_bnan'))
652 {
653 # use subclass to initialize
654 $self->_bnan();
655 }
656 else
657 {
658 # otherwise do our own thing
659 $self->{value} = $CALC->_zero();
660 }
58cde26e 661 $self->{sign} = $nan;
394e6ffb 662 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
ef9466ea 663 $self;
b4f14daa 664 }
58cde26e
JH
665
666sub binf
667 {
668 # create a bigint '+-inf', if given a BigInt, set it to '+-inf'
669 # the sign is either '+', or if given, used from there
670 my $self = shift;
56b9c951 671 my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/;
58cde26e
JH
672 $self = $class if !defined $self;
673 if (!ref($self))
674 {
675 my $c = $self; $self = {}; bless $self, $c;
676 }
990fb837
RGS
677 no strict 'refs';
678 if (${"${class}::_trap_inf"})
679 {
680 require Carp;
233f7bc0 681 Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
990fb837 682 }
61f5c3f5 683 $self->import() if $IMPORT == 0; # make require work
58cde26e 684 return if $self->modify('binf');
13a12e00
JH
685 if ($self->can('_binf'))
686 {
687 # use subclass to initialize
688 $self->_binf();
689 }
690 else
691 {
692 # otherwise do our own thing
693 $self->{value} = $CALC->_zero();
694 }
56b9c951
JH
695 $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
696 $self->{sign} = $sign;
394e6ffb 697 ($self->{_a},$self->{_p}) = @_; # take over requested rounding
ef9466ea 698 $self;
58cde26e
JH
699 }
700
701sub bzero
702 {
703 # create a bigint '+0', if given a BigInt, set it to 0
704 my $self = shift;
12fc2493 705 $self = __PACKAGE__ if !defined $self;
0716bf9b 706
58cde26e
JH
707 if (!ref($self))
708 {
709 my $c = $self; $self = {}; bless $self, $c;
710 }
61f5c3f5 711 $self->import() if $IMPORT == 0; # make require work
58cde26e 712 return if $self->modify('bzero');
990fb837 713
13a12e00
JH
714 if ($self->can('_bzero'))
715 {
716 # use subclass to initialize
717 $self->_bzero();
718 }
719 else
720 {
721 # otherwise do our own thing
722 $self->{value} = $CALC->_zero();
723 }
58cde26e 724 $self->{sign} = '+';
61f5c3f5
T
725 if (@_ > 0)
726 {
f9a08e12
JH
727 if (@_ > 3)
728 {
729 # call like: $x->bzero($a,$p,$r,$y);
730 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
731 }
732 else
733 {
734 $self->{_a} = $_[0]
735 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
736 $self->{_p} = $_[1]
737 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
738 }
61f5c3f5 739 }
f9a08e12 740 $self;
58cde26e
JH
741 }
742
574bacfe
JH
743sub bone
744 {
745 # create a bigint '+1' (or -1 if given sign '-'),
3c4b39be 746 # if given a BigInt, set it to +1 or -1, respectively
574bacfe
JH
747 my $self = shift;
748 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
749 $self = $class if !defined $self;
990fb837 750
574bacfe
JH
751 if (!ref($self))
752 {
753 my $c = $self; $self = {}; bless $self, $c;
754 }
61f5c3f5 755 $self->import() if $IMPORT == 0; # make require work
574bacfe 756 return if $self->modify('bone');
13a12e00
JH
757
758 if ($self->can('_bone'))
759 {
760 # use subclass to initialize
761 $self->_bone();
762 }
763 else
764 {
765 # otherwise do our own thing
766 $self->{value} = $CALC->_one();
767 }
574bacfe 768 $self->{sign} = $sign;
61f5c3f5
T
769 if (@_ > 0)
770 {
f9a08e12
JH
771 if (@_ > 3)
772 {
773 # call like: $x->bone($sign,$a,$p,$r,$y);
774 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_);
775 }
776 else
777 {
091c87b1 778 # call like: $x->bone($sign,$a,$p,$r);
f9a08e12
JH
779 $self->{_a} = $_[0]
780 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
781 $self->{_p} = $_[1]
782 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
783 }
61f5c3f5 784 }
f9a08e12 785 $self;
574bacfe
JH
786 }
787
58cde26e
JH
788##############################################################################
789# string conversation
790
791sub bsstr
792 {
793 # (ref to BFLOAT or num_str ) return num_str
794 # Convert number from internal format to scientific string format.
795 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
b68b7ab1 796 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 797
574bacfe
JH
798 if ($x->{sign} !~ /^[+-]$/)
799 {
800 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
801 return 'inf'; # +inf
802 }
58cde26e 803 my ($m,$e) = $x->parts();
b282a552
T
804 #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
805 # 'e+' because E can only be positive in BigInt
9b924220 806 $m->bstr() . 'e+' . $CALC->_str($e->{value});
58cde26e
JH
807 }
808
809sub bstr
810 {
0716bf9b 811 # make a string from bigint object
b68b7ab1 812 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
56b9c951 813
574bacfe
JH
814 if ($x->{sign} !~ /^[+-]$/)
815 {
816 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
817 return 'inf'; # +inf
818 }
0716bf9b 819 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
9b924220 820 $es.$CALC->_str($x->{value});
58cde26e
JH
821 }
822
823sub numify
824 {
394e6ffb 825 # Make a "normal" scalar from a BigInt object
58cde26e 826 my $x = shift; $x = $class->new($x) unless ref $x;
56d9de68
T
827
828 return $x->bstr() if $x->{sign} !~ /^[+-]$/;
0716bf9b
JH
829 my $num = $CALC->_num($x->{value});
830 return -$num if $x->{sign} eq '-';
9393ace2 831 $num;
58cde26e
JH
832 }
833
834##############################################################################
835# public stuff (usually prefixed with "b")
836
837sub sign
838 {
9393ace2 839 # return the sign of the number: +/-/-inf/+inf/NaN
b282a552 840 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 841
9393ace2 842 $x->{sign};
58cde26e
JH
843 }
844
ee15d750 845sub _find_round_parameters
58cde26e
JH
846 {
847 # After any operation or when calling round(), the result is rounded by
848 # regarding the A & P from arguments, local parameters, or globals.
61f5c3f5 849
990fb837
RGS
850 # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
851
61f5c3f5
T
852 # This procedure finds the round parameters, but it is for speed reasons
853 # duplicated in round. Otherwise, it is tested by the testsuite and used
854 # by fdiv().
990fb837
RGS
855
856 # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
857 # were requested/defined (locally or globally or both)
61f5c3f5 858
394e6ffb
JH
859 my ($self,$a,$p,$r,@args) = @_;
860 # $a accuracy, if given by caller
861 # $p precision, if given by caller
862 # $r round_mode, if given by caller
863 # @args all 'other' arguments (0 for unary, 1 for binary ops)
58cde26e 864
394e6ffb 865 my $c = ref($self); # find out class of argument(s)
574bacfe 866 no strict 'refs';
574bacfe 867
86b76201 868 # convert to normal scalar for speed and correctness in inner parts
86f0d17a
T
869 $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
870 $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
86b76201 871
58cde26e 872 # now pick $a or $p, but only if we have got "arguments"
61f5c3f5 873 if (!defined $a)
58cde26e 874 {
61f5c3f5 875 foreach ($self,@args)
58cde26e
JH
876 {
877 # take the defined one, or if both defined, the one that is smaller
878 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
879 }
61f5c3f5
T
880 }
881 if (!defined $p)
ee15d750 882 {
61f5c3f5
T
883 # even if $a is defined, take $p, to signal error for both defined
884 foreach ($self,@args)
885 {
886 # take the defined one, or if both defined, the one that is bigger
887 # -2 > -3, and 3 > 2
888 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
889 }
ee15d750 890 }
61f5c3f5
T
891 # if still none defined, use globals (#2)
892 $a = ${"$c\::accuracy"} unless defined $a;
893 $p = ${"$c\::precision"} unless defined $p;
990fb837
RGS
894
895 # A == 0 is useless, so undef it to signal no rounding
896 $a = undef if defined $a && $a == 0;
61f5c3f5
T
897
898 # no rounding today?
899 return ($self) unless defined $a || defined $p; # early out
900
901 # set A and set P is an fatal error
990fb837 902 return ($self->bnan()) if defined $a && defined $p; # error
61f5c3f5
T
903
904 $r = ${"$c\::round_mode"} unless defined $r;
7b29e1e6 905 if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837
RGS
906 {
907 require Carp; Carp::croak ("Unknown round mode '$r'");
908 }
909
910 ($self,$a,$p,$r);
ee15d750
JH
911 }
912
913sub round
914 {
61f5c3f5 915 # Round $self according to given parameters, or given second argument's
ee15d750 916 # parameters or global defaults
ee15d750 917
61f5c3f5
T
918 # for speed reasons, _find_round_parameters is embeded here:
919
920 my ($self,$a,$p,$r,@args) = @_;
921 # $a accuracy, if given by caller
922 # $p precision, if given by caller
923 # $r round_mode, if given by caller
924 # @args all 'other' arguments (0 for unary, 1 for binary ops)
925
61f5c3f5
T
926 my $c = ref($self); # find out class of argument(s)
927 no strict 'refs';
928
929 # now pick $a or $p, but only if we have got "arguments"
930 if (!defined $a)
58cde26e 931 {
61f5c3f5
T
932 foreach ($self,@args)
933 {
934 # take the defined one, or if both defined, the one that is smaller
935 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
936 }
58cde26e 937 }
61f5c3f5
T
938 if (!defined $p)
939 {
940 # even if $a is defined, take $p, to signal error for both defined
941 foreach ($self,@args)
942 {
943 # take the defined one, or if both defined, the one that is bigger
944 # -2 > -3, and 3 > 2
945 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
946 }
947 }
948 # if still none defined, use globals (#2)
949 $a = ${"$c\::accuracy"} unless defined $a;
950 $p = ${"$c\::precision"} unless defined $p;
951
990fb837
RGS
952 # A == 0 is useless, so undef it to signal no rounding
953 $a = undef if defined $a && $a == 0;
954
61f5c3f5
T
955 # no rounding today?
956 return $self unless defined $a || defined $p; # early out
957
958 # set A and set P is an fatal error
959 return $self->bnan() if defined $a && defined $p;
960
961 $r = ${"$c\::round_mode"} unless defined $r;
7b29e1e6 962 if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
990fb837 963 {
b282a552 964 require Carp; Carp::croak ("Unknown round mode '$r'");
990fb837 965 }
61f5c3f5
T
966
967 # now round, by calling either fround or ffround:
968 if (defined $a)
969 {
970 $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
971 }
972 else # both can't be undefined due to early out
58cde26e 973 {
61f5c3f5 974 $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
58cde26e 975 }
7b29e1e6 976 # bround() or bfround() already callled bnorm() if nec.
12fc2493 977 $self;
58cde26e
JH
978 }
979
17baacb7 980sub bnorm
58cde26e 981 {
027dc388 982 # (numstr or BINT) return BINT
58cde26e 983 # Normalize number -- no-op here
b282a552 984 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
b3abae2a 985 $x;
58cde26e
JH
986 }
987
988sub babs
989 {
990 # (BINT or num_str) return BINT
991 # make number absolute, or return absolute BINT from string
b68b7ab1 992 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 993
58cde26e
JH
994 return $x if $x->modify('babs');
995 # post-normalized abs for internal use (does nothing for NaN)
996 $x->{sign} =~ s/^-/+/;
997 $x;
998 }
999
1000sub bneg
1001 {
1002 # (BINT or num_str) return BINT
1003 # negate number or make a negated number from string
b68b7ab1 1004 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 1005
58cde26e 1006 return $x if $x->modify('bneg');
b3abae2a 1007
b68b7ab1
T
1008 # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
1009 $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
58cde26e
JH
1010 $x;
1011 }
1012
1013sub bcmp
1014 {
1015 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
1016 # (BINT or num_str, BINT or num_str) return cond_code
f9a08e12
JH
1017
1018 # set up parameters
1019 my ($self,$x,$y) = (ref($_[0]),@_);
1020
1021 # objectify is costly, so avoid it
1022 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1023 {
1024 ($self,$x,$y) = objectify(2,@_);
1025 }
0716bf9b 1026
56d9de68
T
1027 return $upgrade->bcmp($x,$y) if defined $upgrade &&
1028 ((!$x->isa($self)) || (!$y->isa($self)));
1029
0716bf9b
JH
1030 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1031 {
1032 # handle +-inf and NaN
1033 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
574bacfe 1034 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
0716bf9b
JH
1035 return +1 if $x->{sign} eq '+inf';
1036 return -1 if $x->{sign} eq '-inf';
1037 return -1 if $y->{sign} eq '+inf';
b3abae2a 1038 return +1;
0716bf9b 1039 }
574bacfe
JH
1040 # check sign for speed first
1041 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1042 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1043
f9a08e12
JH
1044 # have same sign, so compare absolute values. Don't make tests for zero here
1045 # because it's actually slower than testin in Calc (especially w/ Pari et al)
1046
dccbb853
JH
1047 # post-normalized compare for internal use (honors signs)
1048 if ($x->{sign} eq '+')
1049 {
56b9c951 1050 # $x and $y both > 0
dccbb853
JH
1051 return $CALC->_acmp($x->{value},$y->{value});
1052 }
1053
56b9c951 1054 # $x && $y both < 0
b282a552 1055 $CALC->_acmp($y->{value},$x->{value}); # swaped acmp (lib returns 0,1,-1)
58cde26e
JH
1056 }
1057
1058sub bacmp
1059 {
1060 # Compares 2 values, ignoring their signs.
1061 # Returns one of undef, <0, =0, >0. (suitable for sort)
1062 # (BINT, BINT) return cond_code
574bacfe 1063
f9a08e12
JH
1064 # set up parameters
1065 my ($self,$x,$y) = (ref($_[0]),@_);
1066 # objectify is costly, so avoid it
1067 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1068 {
1069 ($self,$x,$y) = objectify(2,@_);
1070 }
1071
56d9de68
T
1072 return $upgrade->bacmp($x,$y) if defined $upgrade &&
1073 ((!$x->isa($self)) || (!$y->isa($self)));
1074
574bacfe
JH
1075 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1076 {
1077 # handle +-inf and NaN
1078 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1079 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
ef9466ea
T
1080 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1081 return -1;
574bacfe 1082 }
b3abae2a 1083 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
58cde26e
JH
1084 }
1085
1086sub badd
1087 {
1088 # add second arg (BINT or string) to first (BINT) (modifies first)
1089 # return result as BINT
f9a08e12
JH
1090
1091 # set up parameters
1092 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1093 # objectify is costly, so avoid it
1094 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1095 {
1096 ($self,$x,$y,@r) = objectify(2,@_);
1097 }
58cde26e
JH
1098
1099 return $x if $x->modify('badd');
091c87b1 1100 return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
8f675a64 1101 ((!$x->isa($self)) || (!$y->isa($self)));
58cde26e 1102
61f5c3f5 1103 $r[3] = $y; # no push!
574bacfe
JH
1104 # inf and NaN handling
1105 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1106 {
1107 # NaN first
1108 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
13a12e00
JH
1109 # inf handling
1110 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
574bacfe 1111 {
b3abae2a
JH
1112 # +inf++inf or -inf+-inf => same, rest is NaN
1113 return $x if $x->{sign} eq $y->{sign};
1114 return $x->bnan();
574bacfe
JH
1115 }
1116 # +-inf + something => +inf
1117 # something +-inf => +-inf
1118 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
1119 return $x;
1120 }
1121
b282a552 1122 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
58cde26e
JH
1123
1124 if ($sx eq $sy)
1125 {
574bacfe 1126 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
58cde26e
JH
1127 }
1128 else
1129 {
574bacfe 1130 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
58cde26e
JH
1131 if ($a > 0)
1132 {
574bacfe 1133 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
58cde26e
JH
1134 $x->{sign} = $sy;
1135 }
1136 elsif ($a == 0)
1137 {
1138 # speedup, if equal, set result to 0
0716bf9b 1139 $x->{value} = $CALC->_zero();
58cde26e
JH
1140 $x->{sign} = '+';
1141 }
1142 else # a < 0
1143 {
574bacfe 1144 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
a0d0e21e 1145 }
a0d0e21e 1146 }
b68b7ab1 1147 $x->round(@r);
58cde26e
JH
1148 }
1149
1150sub bsub
1151 {
091c87b1 1152 # (BINT or num_str, BINT or num_str) return BINT
58cde26e 1153 # subtract second arg from first, modify first
f9a08e12
JH
1154
1155 # set up parameters
1156 my ($self,$x,$y,@r) = (ref($_[0]),@_);
7d193e39 1157
f9a08e12
JH
1158 # objectify is costly, so avoid it
1159 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1160 {
1161 ($self,$x,$y,@r) = objectify(2,@_);
1162 }
58cde26e 1163
58cde26e 1164 return $x if $x->modify('bsub');
8f675a64 1165
9b924220
RGS
1166 return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
1167 ((!$x->isa($self)) || (!$y->isa($self)));
b3abae2a 1168
b68b7ab1 1169 return $x->round(@r) if $y->is_zero();
b3abae2a 1170
a87115f0
RGS
1171 # To correctly handle the lone special case $x->bsub($x), we note the sign
1172 # of $x, then flip the sign from $y, and if the sign of $x did change, too,
1173 # then we caught the special case:
1174 my $xsign = $x->{sign};
1175 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
1176 if ($xsign ne $x->{sign})
03874afe 1177 {
a87115f0
RGS
1178 # special case of $x->bsub($x) results in 0
1179 return $x->bzero(@r) if $xsign =~ /^[+-]$/;
03874afe
T
1180 return $x->bnan(); # NaN, -inf, +inf
1181 }
b3abae2a
JH
1182 $x->badd($y,@r); # badd does not leave internal zeros
1183 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
7b29e1e6 1184 $x; # already rounded by badd() or no round nec.
58cde26e
JH
1185 }
1186
1187sub binc
1188 {
1189 # increment arg by one
ee15d750 1190 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1191 return $x if $x->modify('binc');
e745a66c
JH
1192
1193 if ($x->{sign} eq '+')
1194 {
1195 $x->{value} = $CALC->_inc($x->{value});
b68b7ab1 1196 return $x->round($a,$p,$r);
e745a66c
JH
1197 }
1198 elsif ($x->{sign} eq '-')
1199 {
1200 $x->{value} = $CALC->_dec($x->{value});
1201 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
b68b7ab1 1202 return $x->round($a,$p,$r);
e745a66c
JH
1203 }
1204 # inf, nan handling etc
091c87b1 1205 $x->badd($self->bone(),$a,$p,$r); # badd does round
58cde26e
JH
1206 }
1207
1208sub bdec
1209 {
1210 # decrement arg by one
b282a552 1211 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1212 return $x if $x->modify('bdec');
e745a66c 1213
b282a552 1214 if ($x->{sign} eq '-')
e745a66c 1215 {
b68b7ab1 1216 # x already < 0
e745a66c 1217 $x->{value} = $CALC->_inc($x->{value});
b282a552
T
1218 }
1219 else
e745a66c 1220 {
b68b7ab1 1221 return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf or NaN
b282a552
T
1222 # >= 0
1223 if ($CALC->_is_zero($x->{value}))
1224 {
1225 # == 0
1226 $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
1227 }
1228 else
1229 {
1230 # > 0
1231 $x->{value} = $CALC->_dec($x->{value});
1232 }
e745a66c 1233 }
b68b7ab1 1234 $x->round(@r);
b282a552 1235 }
58cde26e 1236
61f5c3f5
T
1237sub blog
1238 {
091c87b1
T
1239 # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base
1240 # $base of $x)
1241
1242 # set up parameters
b68b7ab1 1243 my ($self,$x,$base,@r) = (undef,@_);
091c87b1
T
1244 # objectify is costly, so avoid it
1245 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1246 {
b68b7ab1 1247 ($self,$x,$base,@r) = objectify(1,ref($x),@_);
091c87b1 1248 }
a0ac753d 1249
ef9466ea
T
1250 return $x if $x->modify('blog');
1251
2ebb273f
T
1252 $base = $self->new($base) if defined $base && !ref $base;
1253
091c87b1
T
1254 # inf, -inf, NaN, <0 => NaN
1255 return $x->bnan()
9b924220 1256 if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
091c87b1 1257
9b924220
RGS
1258 return $upgrade->blog($upgrade->new($x),$base,@r) if
1259 defined $upgrade;
091c87b1 1260
a0ac753d
T
1261 # fix for bug #24969:
1262 # the default base is e (Euler's number) which is not an integer
1263 if (!defined $base)
1264 {
1265 require Math::BigFloat;
1266 my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
1267 # modify $x in place
1268 $x->{value} = $u->{value};
1269 $x->{sign} = $u->{sign};
1270 return $x;
1271 }
1272
9b924220
RGS
1273 my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
1274 return $x->bnan() unless defined $rc; # not possible to take log?
1275 $x->{value} = $rc;
1276 $x->round(@r);
61f5c3f5 1277 }
091c87b1 1278
50109ad0
RGS
1279sub bnok
1280 {
1281 # Calculate n over k (binomial coefficient or "choose" function) as integer.
1282 # set up parameters
1283 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1284
1285 # objectify is costly, so avoid it
1286 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1287 {
1288 ($self,$x,$y,@r) = objectify(2,@_);
1289 }
1290
1291 return $x if $x->modify('bnok');
1292 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
1293 return $x->binf() if $x->{sign} eq '+inf';
1294
1295 # k > n or k < 0 => 0
1296 my $cmp = $x->bacmp($y);
1297 return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/;
1298 # k == n => 1
1299 return $x->bone(@r) if $cmp == 0;
1300
1301 if ($CALC->can('_nok'))
1302 {
1303 $x->{value} = $CALC->_nok($x->{value},$y->{value});
1304 }
1305 else
1306 {
1307 # ( 7 ) 7! 7*6*5 * 4*3*2*1 7 * 6 * 5
1308 # ( - ) = --------- = --------------- = ---------
1309 # ( 3 ) 3! (7-3)! 3*2*1 * 4*3*2*1 3 * 2 * 1
1310
1311 # compute n - k + 2 (so we start with 5 in the example above)
1312 my $z = $x - $y;
1313 if (!$z->is_one())
1314 {
1315 $z->binc();
1316 my $r = $z->copy(); $z->binc();
1317 my $d = $self->new(2);
1318 while ($z->bacmp($x) <= 0) # f < x ?
1319 {
1320 $r->bmul($z); $r->bdiv($d);
1321 $z->binc(); $d->binc();
1322 }
1323 $x->{value} = $r->{value}; $x->{sign} = '+';
1324 }
1325 else { $x->bone(); }
1326 }
1327 $x->round(@r);
1328 }
1329
7d193e39
T
1330sub bexp
1331 {
1332 # Calculate e ** $x (Euler's number to the power of X), truncated to
1333 # an integer value.
1334 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1335 return $x if $x->modify('bexp');
1336
1337 # inf, -inf, NaN, <0 => NaN
1338 return $x->bnan() if $x->{sign} eq 'NaN';
1339 return $x->bone() if $x->is_zero();
1340 return $x if $x->{sign} eq '+inf';
1341 return $x->bzero() if $x->{sign} eq '-inf';
1342
1343 my $u;
1344 {
1345 # run through Math::BigFloat unless told otherwise
50109ad0 1346 require Math::BigFloat unless defined $upgrade;
7d193e39
T
1347 local $upgrade = 'Math::BigFloat' unless defined $upgrade;
1348 # calculate result, truncate it to integer
1349 $u = $upgrade->bexp($upgrade->new($x),@r);
1350 }
1351
1352 if (!defined $upgrade)
1353 {
1354 $u = $u->as_int();
1355 # modify $x in place
1356 $x->{value} = $u->{value};
1357 $x->round(@r);
1358 }
1359 else { $x = $u; }
1360 }
1361
58cde26e
JH
1362sub blcm
1363 {
1364 # (BINT or num_str, BINT or num_str) return BINT
1365 # does not modify arguments, but returns new object
1366 # Lowest Common Multiplicator
58cde26e 1367
0716bf9b
JH
1368 my $y = shift; my ($x);
1369 if (ref($y))
1370 {
1371 $x = $y->copy();
1372 }
1373 else
1374 {
12fc2493 1375 $x = $class->new($y);
0716bf9b 1376 }
9b924220
RGS
1377 my $self = ref($x);
1378 while (@_)
1379 {
1380 my $y = shift; $y = $self->new($y) if !ref ($y);
1381 $x = __lcm($x,$y);
1382 }
58cde26e
JH
1383 $x;
1384 }
1385
1386sub bgcd
1387 {
1388 # (BINT or num_str, BINT or num_str) return BINT
1389 # does not modify arguments, but returns new object
1390 # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
0716bf9b 1391
dccbb853 1392 my $y = shift;
12fc2493 1393 $y = $class->new($y) if !ref($y);
dccbb853 1394 my $self = ref($y);
9b924220
RGS
1395 my $x = $y->copy()->babs(); # keep arguments
1396 return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
1397
1398 while (@_)
0716bf9b 1399 {
9b924220 1400 $y = shift; $y = $self->new($y) if !ref($y);
9b924220 1401 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
b68b7ab1
T
1402 $x->{value} = $CALC->_gcd($x->{value},$y->{value});
1403 last if $CALC->_is_one($x->{value});
0716bf9b 1404 }
9b924220 1405 $x;
58cde26e
JH
1406 }
1407
58cde26e
JH
1408sub bnot
1409 {
1410 # (num_str or BINT) return BINT
1411 # represent ~x as twos-complement number
ee15d750
JH
1412 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
1413 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1414
58cde26e 1415 return $x if $x->modify('bnot');
091c87b1 1416 $x->binc()->bneg(); # binc already does round
58cde26e
JH
1417 }
1418
091c87b1 1419##############################################################################
b3abae2a 1420# is_foo test routines
091c87b1 1421# we don't need $self, so undef instead of ref($_[0]) make it slightly faster
b3abae2a 1422
58cde26e
JH
1423sub is_zero
1424 {
1425 # return true if arg (BINT or num_str) is zero (array '+', '0')
ee15d750 1426 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1427
574bacfe 1428 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
17baacb7 1429 $CALC->_is_zero($x->{value});
58cde26e
JH
1430 }
1431
1432sub is_nan
1433 {
1434 # return true if arg (BINT or num_str) is NaN
091c87b1 1435 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
ee15d750 1436
091c87b1 1437 $x->{sign} eq $nan ? 1 : 0;
58cde26e
JH
1438 }
1439
1440sub is_inf
1441 {
1442 # return true if arg (BINT or num_str) is +-inf
091c87b1 1443 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 1444
091c87b1 1445 if (defined $sign)
ee15d750 1446 {
091c87b1
T
1447 $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
1448 $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
1449 return $x->{sign} =~ /^$sign$/ ? 1 : 0;
ee15d750 1450 }
091c87b1 1451 $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
58cde26e
JH
1452 }
1453
1454sub is_one
1455 {
091c87b1 1456 # return true if arg (BINT or num_str) is +1, or -1 if sign is given
ee15d750
JH
1457 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1458
990fb837 1459 $sign = '+' if !defined $sign || $sign ne '-';
0716bf9b 1460
ee15d750 1461 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
394e6ffb 1462 $CALC->_is_one($x->{value});
58cde26e
JH
1463 }
1464
1465sub is_odd
1466 {
1467 # return true when arg (BINT or num_str) is odd, false for even
ee15d750 1468 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1469
b22b3e31 1470 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1471 $CALC->_is_odd($x->{value});
58cde26e
JH
1472 }
1473
1474sub is_even
1475 {
1476 # return true when arg (BINT or num_str) is even, false for odd
ee15d750 1477 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
0716bf9b 1478
b22b3e31 1479 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
394e6ffb 1480 $CALC->_is_even($x->{value});
0716bf9b
JH
1481 }
1482
1483sub is_positive
1484 {
1485 # return true when arg (BINT or num_str) is positive (>= 0)
ee15d750 1486 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
b68b7ab1
T
1487
1488 return 1 if $x->{sign} eq '+inf'; # +inf is positive
1489
1490 # 0+ is neither positive nor negative
1491 ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
0716bf9b
JH
1492 }
1493
1494sub is_negative
1495 {
1496 # return true when arg (BINT or num_str) is negative (< 0)
ee15d750
JH
1497 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1498
b68b7ab1 1499 $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
58cde26e
JH
1500 }
1501
b3abae2a
JH
1502sub is_int
1503 {
1504 # return true when arg (BINT or num_str) is an integer
091c87b1 1505 # always true for BigInt, but different for BigFloats
b3abae2a
JH
1506 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1507
1508 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
1509 }
1510
0716bf9b
JH
1511###############################################################################
1512
58cde26e
JH
1513sub bmul
1514 {
c97ef841 1515 # multiply the first number by the second number
58cde26e 1516 # (BINT or num_str, BINT or num_str) return BINT
f9a08e12
JH
1517
1518 # set up parameters
1519 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1520 # objectify is costly, so avoid it
1521 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1522 {
1523 ($self,$x,$y,@r) = objectify(2,@_);
1524 }
a0ac753d 1525
58cde26e 1526 return $x if $x->modify('bmul');
61f5c3f5 1527
574bacfe 1528 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
b3abae2a 1529
574bacfe
JH
1530 # inf handling
1531 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1532 {
b3abae2a 1533 return $x->bnan() if $x->is_zero() || $y->is_zero();
574bacfe
JH
1534 # result will always be +-inf:
1535 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1536 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1537 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1538 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1539 return $x->binf('-');
1540 }
9b924220
RGS
1541
1542 return $upgrade->bmul($x,$upgrade->new($y),@r)
1543 if defined $upgrade && !$y->isa($self);
9393ace2
JH
1544
1545 $r[3] = $y; # no push here
58cde26e 1546
0716bf9b 1547 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
dccbb853 1548
b3abae2a
JH
1549 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1550 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
f9a08e12 1551
b68b7ab1 1552 $x->round(@r);
dccbb853
JH
1553 }
1554
80365507
T
1555sub bmuladd
1556 {
1557 # multiply two numbers and then add the third to the result
1558 # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
1559
1560 # set up parameters
1561 my ($self,$x,$y,$z,@r) = (ref($_[0]),@_);
1562 # objectify is costly, so avoid it
1563 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1564 {
1565 ($self,$x,$y,$z,@r) = objectify(3,@_);
1566 }
1567
1568 return $x if $x->modify('bmuladd');
1569
1570 return $x->bnan() if ($x->{sign} eq $nan) ||
1571 ($y->{sign} eq $nan) ||
1572 ($z->{sign} eq $nan);
1573
1574 # inf handling of x and y
1575 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1576 {
1577 return $x->bnan() if $x->is_zero() || $y->is_zero();
1578 # result will always be +-inf:
1579 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1580 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1581 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1582 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1583 return $x->binf('-');
1584 }
1585 # inf handling x*y and z
1586 if (($z->{sign} =~ /^[+-]inf$/))
1587 {
1588 # something +-inf => +-inf
1589 $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
1590 }
1591
1592 return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r)
1593 if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self));
1594
c97ef841 1595 # TODO: what if $y and $z have A or P set?
80365507
T
1596 $r[3] = $z; # no push here
1597
1598 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
1599
1600 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
1601 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
1602
1603 my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
1604
1605 if ($sx eq $sz)
1606 {
1607 $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
1608 }
1609 else
1610 {
1611 my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
1612 if ($a > 0)
1613 {
1614 $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
1615 $x->{sign} = $sz;
1616 }
1617 elsif ($a == 0)
1618 {
1619 # speedup, if equal, set result to 0
1620 $x->{value} = $CALC->_zero();
1621 $x->{sign} = '+';
1622 }
1623 else # a < 0
1624 {
1625 $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub
1626 }
1627 }
1628 $x->round(@r);
1629 }
1630
dccbb853
JH
1631sub _div_inf
1632 {
1633 # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
1634 my ($self,$x,$y) = @_;
1635
1636 # NaN if x == NaN or y == NaN or x==y==0
1637 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
1638 if (($x->is_nan() || $y->is_nan()) ||
1639 ($x->is_zero() && $y->is_zero()));
1640
b3abae2a
JH
1641 # +-inf / +-inf == NaN, reminder also NaN
1642 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
dccbb853 1643 {
b3abae2a 1644 return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
dccbb853
JH
1645 }
1646 # x / +-inf => 0, remainder x (works even if x == 0)
1647 if ($y->{sign} =~ /^[+-]inf$/)
1648 {
f9a08e12 1649 my $t = $x->copy(); # bzero clobbers up $x
dccbb853
JH
1650 return wantarray ? ($x->bzero(),$t) : $x->bzero()
1651 }
1652
1653 # 5 / 0 => +inf, -6 / 0 => -inf
1654 # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
1655 # exception: -8 / 0 has remainder -8, not 8
1656 # exception: -inf / 0 has remainder -inf, not inf
1657 if ($y->is_zero())
1658 {
1659 # +-inf / 0 => special case for -inf
1660 return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
1661 if (!$x->is_zero() && !$x->is_inf())
1662 {
1663 my $t = $x->copy(); # binf clobbers up $x
1664 return wantarray ?
1665 ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
1666 }
1667 }
1668
1669 # last case: +-inf / ordinary number
1670 my $sign = '+inf';
1671 $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
1672 $x->{sign} = $sign;
1673 return wantarray ? ($x,$self->bzero()) : $x;
58cde26e
JH
1674 }
1675
1676sub bdiv
1677 {
1678 # (dividend: BINT or num_str, divisor: BINT or num_str) return
1679 # (BINT,BINT) (quo,rem) or BINT (only rem)
f9a08e12
JH
1680
1681 # set up parameters
1682 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1683 # objectify is costly, so avoid it
1684 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1685 {
1686 ($self,$x,$y,@r) = objectify(2,@_);
1687 }
58cde26e
JH
1688
1689 return $x if $x->modify('bdiv');
1690
dccbb853
JH
1691 return $self->_div_inf($x,$y)
1692 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
58cde26e 1693
9393ace2
JH
1694 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
1695 if defined $upgrade;
58cde26e 1696
990fb837
RGS
1697 $r[3] = $y; # no push!
1698
58cde26e 1699 # calc new sign and in case $y == +/- 1, return $x
dccbb853 1700 my $xsign = $x->{sign}; # keep
58cde26e 1701 $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
58cde26e 1702
58cde26e
JH
1703 if (wantarray)
1704 {
394e6ffb
JH
1705 my $rem = $self->bzero();
1706 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
1707 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
f9a08e12
JH
1708 $rem->{_a} = $x->{_a};
1709 $rem->{_p} = $x->{_p};
b68b7ab1 1710 $x->round(@r);
dccbb853
JH
1711 if (! $CALC->_is_zero($rem->{value}))
1712 {
1713 $rem->{sign} = $y->{sign};
990fb837 1714 $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
dccbb853
JH
1715 }
1716 else
1717 {
1718 $rem->{sign} = '+'; # dont leave -0
1719 }
b68b7ab1 1720 $rem->round(@r);
990fb837 1721 return ($x,$rem);
58cde26e 1722 }
394e6ffb
JH
1723
1724 $x->{value} = $CALC->_div($x->{value},$y->{value});
1725 $x->{sign} = '+' if $CALC->_is_zero($x->{value});
f9a08e12 1726
b68b7ab1 1727 $x->round(@r);
58cde26e
JH
1728 }
1729
d614cd8b
JH
1730###############################################################################
1731# modulus functions
1732
dccbb853
JH
1733sub bmod
1734 {
1735 # modulus (or remainder)
1736 # (BINT or num_str, BINT or num_str) return BINT
f9a08e12
JH
1737
1738 # set up parameters
1739 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1740 # objectify is costly, so avoid it
1741 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1742 {
1743 ($self,$x,$y,@r) = objectify(2,@_);
1744 }
28df3e88 1745
dccbb853 1746 return $x if $x->modify('bmod');
61f5c3f5 1747 $r[3] = $y; # no push!
dccbb853
JH
1748 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
1749 {
1750 my ($d,$r) = $self->_div_inf($x,$y);
f9a08e12
JH
1751 $x->{sign} = $r->{sign};
1752 $x->{value} = $r->{value};
1753 return $x->round(@r);
dccbb853
JH
1754 }
1755
9b924220
RGS
1756 # calc new sign and in case $y == +/- 1, return $x
1757 $x->{value} = $CALC->_mod($x->{value},$y->{value});
1758 if (!$CALC->_is_zero($x->{value}))
dccbb853 1759 {
b68b7ab1
T
1760 $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
1761 if ($x->{sign} ne $y->{sign});
9b924220 1762 $x->{sign} = $y->{sign};
dccbb853 1763 }
9b924220 1764 else
b3abae2a 1765 {
9b924220 1766 $x->{sign} = '+'; # dont leave -0
b3abae2a 1767 }
b68b7ab1 1768 $x->round(@r);
dccbb853
JH
1769 }
1770
07d34614 1771sub bmodinv
d614cd8b 1772 {
56d9de68 1773 # Modular inverse. given a number which is (hopefully) relatively
d614cd8b 1774 # prime to the modulus, calculate its inverse using Euclid's
56d9de68 1775 # alogrithm. If the number is not relatively prime to the modulus
d614cd8b
JH
1776 # (i.e. their gcd is not one) then NaN is returned.
1777
f9a08e12 1778 # set up parameters
b68b7ab1 1779 my ($self,$x,$y,@r) = (undef,@_);
56d9de68 1780 # objectify is costly, so avoid it
f9a08e12
JH
1781 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1782 {
1783 ($self,$x,$y,@r) = objectify(2,@_);
56d9de68 1784 }
d614cd8b 1785
f9a08e12 1786 return $x if $x->modify('bmodinv');
d614cd8b 1787
f9a08e12 1788 return $x->bnan()
56d9de68
T
1789 if ($y->{sign} ne '+' # -, NaN, +inf, -inf
1790 || $x->is_zero() # or num == 0
1791 || $x->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
d614cd8b 1792 );
1ddff52a 1793
f9a08e12
JH
1794 # put least residue into $x if $x was negative, and thus make it positive
1795 $x->bmod($y) if $x->{sign} eq '-';
07d34614 1796
9b924220
RGS
1797 my $sign;
1798 ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
1799 return $x->bnan() if !defined $x->{value}; # in case no GCD found
1800 return $x if !defined $sign; # already real result
1801 $x->{sign} = $sign; # flip/flop see below
1802 $x->bmod($y); # calc real result
1803 $x;
d614cd8b
JH
1804 }
1805
07d34614 1806sub bmodpow
d614cd8b
JH
1807 {
1808 # takes a very large number to a very large exponent in a given very
80365507 1809 # large modulus, quickly, thanks to binary exponentation. Supports
d614cd8b
JH
1810 # negative exponents.
1811 my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
1812
1813 return $num if $num->modify('bmodpow');
1814
1815 # check modulus for valid values
1816 return $num->bnan() if ($mod->{sign} ne '+' # NaN, - , -inf, +inf
1817 || $mod->is_zero());
1818
1819 # check exponent for valid values
1820 if ($exp->{sign} =~ /\w/)
1821 {
1822 # i.e., if it's NaN, +inf, or -inf...
1823 return $num->bnan();
1824 }
07d34614 1825
1ddff52a 1826 $num->bmodinv ($mod) if ($exp->{sign} eq '-');
d614cd8b 1827
1ddff52a 1828 # check num for valid values (also NaN if there was no inverse but $exp < 0)
07d34614 1829 return $num->bnan() if $num->{sign} !~ /^[+-]$/;
d614cd8b 1830
9b924220
RGS
1831 # $mod is positive, sign on $exp is ignored, result also positive
1832 $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
1833 $num;
d614cd8b
JH
1834 }
1835
1836###############################################################################
1837
b3abae2a
JH
1838sub bfac
1839 {
1840 # (BINT or num_str, BINT or num_str) return BINT
091c87b1 1841 # compute factorial number from $x, modify $x in place
b68b7ab1 1842 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
b3abae2a 1843
b68b7ab1
T
1844 return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
1845 return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
b3abae2a 1846
9b924220
RGS
1847 $x->{value} = $CALC->_fac($x->{value});
1848 $x->round(@r);
b3abae2a
JH
1849 }
1850
58cde26e
JH
1851sub bpow
1852 {
1853 # (BINT or num_str, BINT or num_str) return BINT
1854 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
1855 # modifies first argument
aef458a0 1856
f9a08e12
JH
1857 # set up parameters
1858 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1859 # objectify is costly, so avoid it
1860 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1861 {
1862 ($self,$x,$y,@r) = objectify(2,@_);
1863 }
58cde26e
JH
1864
1865 return $x if $x->modify('bpow');
9393ace2 1866
2d2b2744
T
1867 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1868
1869 # inf handling
1870 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1871 {
1872 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
1873 {
1874 # +-inf ** +-inf
1875 return $x->bnan();
1876 }
1877 # +-inf ** Y
1878 if ($x->{sign} =~ /^[+-]inf/)
1879 {
1880 # +inf ** 0 => NaN
1881 return $x->bnan() if $y->is_zero();
1882 # -inf ** -1 => 1/inf => 0
1883 return $x->bzero() if $y->is_one('-') && $x->is_negative();
1884
1885 # +inf ** Y => inf
1886 return $x if $x->{sign} eq '+inf';
1887
1888 # -inf ** Y => -inf if Y is odd
1889 return $x if $y->is_odd();
1890 return $x->babs();
1891 }
1892 # X ** +-inf
1893
1894 # 1 ** +inf => 1
1895 return $x if $x->is_one();
1896
1897 # 0 ** inf => 0
1898 return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;
1899
1900 # 0 ** -inf => inf
1901 return $x->binf() if $x->is_zero();
1902
1903 # -1 ** -inf => NaN
1904 return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;
1905
1906 # -X ** -inf => 0
1907 return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;
1908
1909 # -1 ** inf => NaN
1910 return $x->bnan() if $x->{sign} eq '-';
1911
1912 # X ** inf => inf
1913 return $x->binf() if $y->{sign} =~ /^[+]/;
1914 # X ** -inf => 0
1915 return $x->bzero();
1916 }
1917
9393ace2 1918 return $upgrade->bpow($upgrade->new($x),$y,@r)
7b29e1e6 1919 if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-');
9393ace2 1920
61f5c3f5 1921 $r[3] = $y; # no push!
b282a552
T
1922
1923 # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
1924
9b924220
RGS
1925 my $new_sign = '+';
1926 $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
1927
1928 # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
1929 return $x->binf()
1930 if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
574bacfe
JH
1931 # 1 ** -y => 1 / (1 ** |y|)
1932 # so do test for negative $y after above's clause
9b924220 1933 return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
027dc388 1934
9b924220
RGS
1935 $x->{value} = $CALC->_pow($x->{value},$y->{value});
1936 $x->{sign} = $new_sign;
1937 $x->{sign} = '+' if $CALC->_is_zero($y->{value});
b68b7ab1 1938 $x->round(@r);
58cde26e
JH
1939 }
1940
1941sub blsft
1942 {
1943 # (BINT or num_str, BINT or num_str) return BINT
1944 # compute x << y, base n, y >= 0
f9a08e12
JH
1945
1946 # set up parameters
1947 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
1948 # objectify is costly, so avoid it
1949 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1950 {
1951 ($self,$x,$y,$n,@r) = objectify(2,@_);
1952 }
1953
58cde26e
JH
1954 return $x if $x->modify('blsft');
1955 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
f9a08e12 1956 return $x->round(@r) if $y->is_zero();
58cde26e 1957
574bacfe
JH
1958 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
1959
9b924220
RGS
1960 $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n);
1961 $x->round(@r);
58cde26e
JH
1962 }
1963
1964sub brsft
1965 {
1966 # (BINT or num_str, BINT or num_str) return BINT
1967 # compute x >> y, base n, y >= 0
f9a08e12
JH
1968
1969 # set up parameters
1970 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_);
1971 # objectify is costly, so avoid it
1972 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1973 {
1974 ($self,$x,$y,$n,@r) = objectify(2,@_);
1975 }
58cde26e
JH
1976
1977 return $x if $x->modify('brsft');
1978 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
f9a08e12
JH
1979 return $x->round(@r) if $y->is_zero();
1980 return $x->bzero(@r) if $x->is_zero(); # 0 => 0
58cde26e
JH
1981
1982 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
574bacfe 1983
b3abae2a
JH
1984 # this only works for negative numbers when shifting in base 2
1985 if (($x->{sign} eq '-') && ($n == 2))
1986 {
f9a08e12 1987 return $x->round(@r) if $x->is_one('-'); # -1 => -1
b3abae2a
JH
1988 if (!$y->is_one())
1989 {
1990 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
1991 # but perhaps there is a better emulation for two's complement shift...
1992 # if $y != 1, we must simulate it by doing:
1993 # convert to bin, flip all bits, shift, and be done
1994 $x->binc(); # -3 => -2
1995 my $bin = $x->as_bin();
1996 $bin =~ s/^-0b//; # strip '-0b' prefix
1997 $bin =~ tr/10/01/; # flip bits
1998 # now shift
a0ac753d 1999 if ($y >= CORE::length($bin))
b3abae2a
JH
2000 {
2001 $bin = '0'; # shifting to far right creates -1
2002 # 0, because later increment makes
2003 # that 1, attached '-' makes it '-1'
2004 # because -1 >> x == -1 !
2005 }
2006 else
2007 {
2008 $bin =~ s/.{$y}$//; # cut off at the right side
2009 $bin = '1' . $bin; # extend left side by one dummy '1'
2010 $bin =~ tr/10/01/; # flip bits back
2011 }
2012 my $res = $self->new('0b'.$bin); # add prefix and convert back
2013 $res->binc(); # remember to increment
2014 $x->{value} = $res->{value}; # take over value
f9a08e12 2015 return $x->round(@r); # we are done now, magic, isn't?
b3abae2a 2016 }
b282a552 2017 # x < 0, n == 2, y == 1
b3abae2a
JH
2018 $x->bdec(); # n == 2, but $y == 1: this fixes it
2019 }
2020
9b924220
RGS
2021 $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
2022 $x->round(@r);
58cde26e
JH
2023 }
2024
2025sub band
2026 {
2027 #(BINT or num_str, BINT or num_str) return BINT
2028 # compute x & y
f9a08e12
JH
2029
2030 # set up parameters
2031 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2032 # objectify is costly, so avoid it
2033 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2034 {
2035 ($self,$x,$y,@r) = objectify(2,@_);
2036 }
58cde26e
JH
2037
2038 return $x if $x->modify('band');
2039
f9a08e12 2040 $r[3] = $y; # no push!
b3abae2a 2041
58cde26e 2042 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
0716bf9b 2043
b282a552
T
2044 my $sx = $x->{sign} eq '+' ? 1 : -1;
2045 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe 2046
9b924220 2047 if ($sx == 1 && $sy == 1)
0716bf9b 2048 {
574bacfe 2049 $x->{value} = $CALC->_and($x->{value},$y->{value});
f9a08e12 2050 return $x->round(@r);
0716bf9b 2051 }
091c87b1
T
2052
2053 if ($CAN{signed_and})
2054 {
2055 $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy);
2056 return $x->round(@r);
2057 }
b282a552
T
2058
2059 require $EMU_LIB;
2060 __emu_band($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2061 }
2062
2063sub bior
2064 {
2065 #(BINT or num_str, BINT or num_str) return BINT
2066 # compute x | y
f9a08e12
JH
2067
2068 # set up parameters
2069 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2070 # objectify is costly, so avoid it
2071 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2072 {
2073 ($self,$x,$y,@r) = objectify(2,@_);
2074 }
58cde26e
JH
2075
2076 return $x if $x->modify('bior');
f9a08e12 2077 $r[3] = $y; # no push!
58cde26e
JH
2078
2079 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
574bacfe 2080
b282a552
T
2081 my $sx = $x->{sign} eq '+' ? 1 : -1;
2082 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe 2083
091c87b1
T
2084 # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
2085
574bacfe 2086 # don't use lib for negative values
9b924220 2087 if ($sx == 1 && $sy == 1)
0716bf9b 2088 {
574bacfe 2089 $x->{value} = $CALC->_or($x->{value},$y->{value});
f9a08e12 2090 return $x->round(@r);
0716bf9b
JH
2091 }
2092
b282a552 2093 # if lib can do negative values, let it handle this
091c87b1
T
2094 if ($CAN{signed_or})
2095 {
2096 $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy);
2097 return $x->round(@r);
2098 }
2099
b282a552
T
2100 require $EMU_LIB;
2101 __emu_bior($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2102 }
2103
2104sub bxor
2105 {
2106 #(BINT or num_str, BINT or num_str) return BINT
2107 # compute x ^ y
f9a08e12
JH
2108
2109 # set up parameters
2110 my ($self,$x,$y,@r) = (ref($_[0]),@_);
2111 # objectify is costly, so avoid it
2112 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2113 {
2114 ($self,$x,$y,@r) = objectify(2,@_);
2115 }
58cde26e
JH
2116
2117 return $x if $x->modify('bxor');
f9a08e12 2118 $r[3] = $y; # no push!
58cde26e 2119
0716bf9b 2120 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
0716bf9b 2121
b282a552
T
2122 my $sx = $x->{sign} eq '+' ? 1 : -1;
2123 my $sy = $y->{sign} eq '+' ? 1 : -1;
574bacfe
JH
2124
2125 # don't use lib for negative values
9b924220 2126 if ($sx == 1 && $sy == 1)
0716bf9b 2127 {
574bacfe 2128 $x->{value} = $CALC->_xor($x->{value},$y->{value});
f9a08e12 2129 return $x->round(@r);
0716bf9b 2130 }
091c87b1 2131
b282a552 2132 # if lib can do negative values, let it handle this
091c87b1
T
2133 if ($CAN{signed_xor})
2134 {
2135 $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy);
2136 return $x->round(@r);
2137 }
0716bf9b 2138
b282a552
T
2139 require $EMU_LIB;
2140 __emu_bxor($self,$x,$y,$sx,$sy,@r);
58cde26e
JH
2141 }
2142
2143sub length
2144 {
b282a552 2145 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 2146
0716bf9b 2147 my $e = $CALC->_len($x->{value});
091c87b1 2148 wantarray ? ($e,0) : $e;
58cde26e
JH
2149 }
2150
2151sub digit
2152 {
0716bf9b 2153 # return the nth decimal digit, negative values count backward, 0 is right
ef9466ea 2154 my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2155
ef9466ea 2156 $n = $n->numify() if ref($n);
f9a08e12 2157 $CALC->_digit($x->{value},$n||0);
58cde26e
JH
2158 }
2159
2160sub _trailing_zeros
2161 {
b282a552 2162 # return the amount of trailing zeros in $x (as scalar)
58cde26e
JH
2163 my $x = shift;
2164 $x = $class->new($x) unless ref $x;
2165
9b924220 2166 return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
0716bf9b 2167
9b924220 2168 $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
58cde26e
JH
2169 }
2170
2171sub bsqrt
2172 {
990fb837 2173 # calculate square root of $x
b68b7ab1 2174 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2175
b3abae2a
JH
2176 return $x if $x->modify('bsqrt');
2177
990fb837
RGS
2178 return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
2179 return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
b3abae2a 2180
f9a08e12 2181 return $upgrade->bsqrt($x,@r) if defined $upgrade;
58cde26e 2182
9b924220
RGS
2183 $x->{value} = $CALC->_sqrt($x->{value});
2184 $x->round(@r);
58cde26e
JH
2185 }
2186
990fb837
RGS
2187sub broot
2188 {
2189 # calculate $y'th root of $x
c38b2de2 2190
990fb837
RGS
2191 # set up parameters
2192 my ($self,$x,$y,@r) = (ref($_[0]),@_);
c38b2de2
JH
2193
2194 $y = $self->new(2) unless defined $y;
2195
990fb837 2196 # objectify is costly, so avoid it
c38b2de2 2197 if ((!ref($x)) || (ref($x) ne ref($y)))
990fb837 2198 {
3a427a11 2199 ($self,$x,$y,@r) = objectify(2,$self || $class,@_);
990fb837
RGS
2200 }
2201
2202 return $x if $x->modify('broot');
2203
2204 # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
2205 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
2206 $y->{sign} !~ /^\+$/;
2207
2208 return $x->round(@r)
2209 if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
2210
c38b2de2 2211 return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
990fb837 2212
9b924220
RGS
2213 $x->{value} = $CALC->_root($x->{value},$y->{value});
2214 $x->round(@r);
990fb837
RGS
2215 }
2216
58cde26e
JH
2217sub exponent
2218 {
2219 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
ee15d750 2220 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 2221
ee15d750
JH
2222 if ($x->{sign} !~ /^[+-]$/)
2223 {
b282a552
T
2224 my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf
2225 return $self->new($s);
ee15d750 2226 }
b282a552
T
2227 return $self->bone() if $x->is_zero();
2228
7d193e39
T
2229 # 12300 => 2 trailing zeros => exponent is 2
2230 $self->new( $CALC->_zeros($x->{value}) );
58cde26e
JH
2231 }
2232
2233sub mantissa
2234 {
ee15d750
JH
2235 # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
2236 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 2237
ee15d750
JH
2238 if ($x->{sign} !~ /^[+-]$/)
2239 {
b282a552
T
2240 # for NaN, +inf, -inf: keep the sign
2241 return $self->new($x->{sign});
ee15d750 2242 }
b282a552 2243 my $m = $x->copy(); delete $m->{_p}; delete $m->{_a};
7d193e39 2244
b282a552 2245 # that's a bit inefficient:
7d193e39 2246 my $zeros = $CALC->_zeros($m->{value});
56b9c951 2247 $m->brsft($zeros,10) if $zeros != 0;
56b9c951 2248 $m;
58cde26e
JH
2249 }
2250
2251sub parts
2252 {
ee15d750 2253 # return a copy of both the exponent and the mantissa
091c87b1 2254 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
58cde26e 2255
091c87b1 2256 ($x->mantissa(),$x->exponent());
58cde26e
JH
2257 }
2258
2259##############################################################################
2260# rounding functions
2261
2262sub bfround
2263 {
2264 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
ee15d750 2265 # $n == 0 || $n == 1 => round to integer
ef9466ea 2266 my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
b282a552 2267
b68b7ab1 2268 my ($scale,$mode) = $x->_scale_p(@_);
b282a552
T
2269
2270 return $x if !defined $scale || $x->modify('bfround'); # no-op
58cde26e
JH
2271
2272 # no-op for BigInts if $n <= 0
b282a552 2273 $x->bround( $x->length()-$scale, $mode) if $scale > 0;
58cde26e 2274
ef9466ea
T
2275 delete $x->{_a}; # delete to save memory
2276 $x->{_p} = $scale; # store new _p
ee15d750 2277 $x;
58cde26e
JH
2278 }
2279
2280sub _scan_for_nonzero
2281 {
ae161977
RGS
2282 # internal, used by bround() to scan for non-zeros after a '5'
2283 my ($x,$pad,$xs,$len) = @_;
58cde26e 2284
ae161977 2285 return 0 if $len == 1; # "5" is trailed by invisible zeros
58cde26e
JH
2286 my $follow = $pad - 1;
2287 return 0 if $follow > $len || $follow < 1;
0716bf9b 2288
ae161977
RGS
2289 # use the string form to check whether only '0's follow or not
2290 substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0;
58cde26e
JH
2291 }
2292
2293sub fround
2294 {
091c87b1
T
2295 # Exists to make life easier for switch between MBF and MBI (should we
2296 # autoload fxxx() like MBF does for bxxx()?)
b68b7ab1 2297 my $x = shift; $x = $class->new($x) unless ref $x;
091c87b1 2298 $x->bround(@_);
58cde26e
JH
2299 }
2300
2301sub bround
2302 {
2303 # accuracy: +$n preserve $n digits from left,
2304 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF)
2305 # no-op for $n == 0
2306 # and overwrite the rest with 0's, return normalized number
2307 # do not return $x->bnorm(), but $x
61f5c3f5 2308
58cde26e 2309 my $x = shift; $x = $class->new($x) unless ref $x;
b68b7ab1
T
2310 my ($scale,$mode) = $x->_scale_a(@_);
2311 return $x if !defined $scale || $x->modify('bround'); # no-op
58cde26e 2312
61f5c3f5
T
2313 if ($x->is_zero() || $scale == 0)
2314 {
2315 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
2316 return $x;
2317 }
2318 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
58cde26e
JH
2319
2320 # we have fewer digits than we want to scale to
2321 my $len = $x->length();
56d9de68
T
2322 # convert $scale to a scalar in case it is an object (put's a limit on the
2323 # number length, but this would already limited by memory constraints), makes
2324 # it faster
2325 $scale = $scale->numify() if ref ($scale);
2326
ee15d750
JH
2327 # scale < 0, but > -len (not >=!)
2328 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
2329 {
61f5c3f5 2330 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
ee15d750
JH
2331 return $x;
2332 }
58cde26e
JH
2333
2334 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
2335 my ($pad,$digit_round,$digit_after);
2336 $pad = $len - $scale;
ee15d750
JH
2337 $pad = abs($scale-1) if $scale < 0;
2338
ae161977
RGS
2339 # do not use digit(), it is very costly for binary => decimal
2340 # getting the entire string is also costly, but we need to do it only once
0716bf9b
JH
2341 my $xs = $CALC->_str($x->{value});
2342 my $pl = -$pad-1;
56d9de68 2343
0716bf9b
JH
2344 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
2345 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
9b924220 2346 $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
0716bf9b 2347 $pl++; $pl ++ if $pad >= $len;
9b924220 2348 $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;
ee15d750 2349
58cde26e
JH
2350 # in case of 01234 we round down, for 6789 up, and only in case 5 we look
2351 # closer at the remaining digits of the original $x, remember decision
2352 my $round_up = 1; # default round up
2353 $round_up -- if
2354 ($mode eq 'trunc') || # trunc by round down
2355 ($digit_after =~ /[01234]/) || # round down anyway,
2356 # 6789 => round up
2357 ($digit_after eq '5') && # not 5000...0000
ae161977 2358 ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
58cde26e
JH
2359 (
2360 ($mode eq 'even') && ($digit_round =~ /[24680]/) ||
2361 ($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
2362 ($mode eq '+inf') && ($x->{sign} eq '-') ||
2363 ($mode eq '-inf') && ($x->{sign} eq '+') ||
2364 ($mode eq 'zero') # round down if zero, sign adjusted below
2365 );
61f5c3f5
T
2366 my $put_back = 0; # not yet modified
2367
61f5c3f5
T
2368 if (($pad > 0) && ($pad <= $len))
2369 {
ae161977
RGS
2370 substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
2371 $put_back = 1; # need to put back
58cde26e 2372 }
61f5c3f5
T
2373 elsif ($pad > $len)
2374 {
2375 $x->bzero(); # round to '0'
2376 }
2377
58cde26e
JH
2378 if ($round_up) # what gave test above?
2379 {
ae161977 2380 $put_back = 1; # need to put back
9b924220 2381 $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
61f5c3f5
T
2382
2383 # we modify directly the string variant instead of creating a number and
f9a08e12 2384 # adding it, since that is faster (we already have the string)
61f5c3f5
T
2385 my $c = 0; $pad ++; # for $pad == $len case
2386 while ($pad <= $len)
2387 {
9b924220
RGS
2388 $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
2389 substr($xs,-$pad,1) = $c; $pad++;
61f5c3f5
T
2390 last if $c != 0; # no overflow => early out
2391 }
9b924220 2392 $xs = '1'.$xs if $c == 0;
61f5c3f5 2393
58cde26e 2394 }
ae161977 2395 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
ee15d750
JH
2396
2397 $x->{_a} = $scale if $scale >= 0;
2398 if ($scale < 0)
2399 {
2400 $x->{_a} = $len+$scale;
2401 $x->{_a} = 0 if $scale < -$len;
2402 }
58cde26e
JH
2403 $x;
2404 }
2405
2406sub bfloor
2407 {
091c87b1
T
2408 # return integer less or equal then number; no-op since it's already integer
2409 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2410
f9a08e12 2411 $x->round(@r);
58cde26e
JH
2412 }
2413
2414sub bceil
2415 {
091c87b1
T
2416 # return integer greater or equal then number; no-op since it's already int
2417 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
58cde26e 2418
f9a08e12 2419 $x->round(@r);
58cde26e
JH
2420 }
2421
091c87b1
T
2422sub as_number
2423 {
2424 # An object might be asked to return itself as bigint on certain overloaded
7b29e1e6 2425 # operations. This does exactly this, so that sub classes can simple inherit
091c87b1
T
2426 # it or override with their own integer conversion routine.
2427 $_[0]->copy();
2428 }
58cde26e 2429
091c87b1 2430sub as_hex
58cde26e 2431 {
091c87b1
T
2432 # return as hex string, with prefixed 0x
2433 my $x = shift; $x = $class->new($x) if !ref($x);
2434
2435 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2436
b282a552 2437 my $s = '';
091c87b1 2438 $s = $x->{sign} if $x->{sign} eq '-';
9b924220 2439 $s . $CALC->_as_hex($x->{value});
58cde26e
JH
2440 }
2441
091c87b1 2442sub as_bin
58cde26e 2443 {
091c87b1
T
2444 # return as binary string, with prefixed 0b
2445 my $x = shift; $x = $class->new($x) if !ref($x);
2446
2447 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2448
b282a552 2449 my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
9b924220 2450 return $s . $CALC->_as_bin($x->{value});
58cde26e
JH
2451 }
2452
7b29e1e6
T
2453sub as_oct
2454 {
2455 # return as octal string, with prefixed 0
2456 my $x = shift; $x = $class->new($x) if !ref($x);
2457
2458 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
2459
2460 my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
2461 return $s . $CALC->_as_oct($x->{value});
2462 }
2463
091c87b1
T
2464##############################################################################
2465# private stuff (internal use only)
2466
58cde26e
JH
2467sub objectify
2468 {
2469 # check for strings, if yes, return objects instead
2470
2471 # the first argument is number of args objectify() should look at it will
2472 # return $count+1 elements, the first will be a classname. This is because
2473 # overloaded '""' calls bstr($object,undef,undef) and this would result in
3c4b39be 2474 # useless objects being created and thrown away. So we cannot simple loop
58cde26e
JH
2475 # over @_. If the given count is 0, all arguments will be used.
2476
2477 # If the second arg is a ref, use it as class.
2478 # If not, try to use it as classname, unless undef, then use $class
2479 # (aka Math::BigInt). The latter shouldn't happen,though.
2480
2481 # caller: gives us:
2482 # $x->badd(1); => ref x, scalar y
2483 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y
2484 # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
2485 # Math::BigInt::badd(1,2); => scalar x, scalar y
2486 # In the last case we check number of arguments to turn it silently into
574bacfe 2487 # $class,1,2. (We can not take '1' as class ;o)
58cde26e
JH
2488 # badd($class,1) is not supported (it should, eventually, try to add undef)
2489 # currently it tries 'Math::BigInt' + 1, which will not work.
ee15d750
JH
2490
2491 # some shortcut for the common cases
ee15d750
JH
2492 # $x->unary_op();
2493 return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
ee15d750 2494
58cde26e
JH
2495 my $count = abs(shift || 0);
2496
9393ace2 2497 my (@a,$k,$d); # resulting array, temp, and downgrade
58cde26e
JH
2498 if (ref $_[0])
2499 {
2500 # okay, got object as first
2501 $a[0] = ref $_[0];
2502 }
2503 else
2504 {
2505 # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
2506 $a[0] = $class;
58cde26e
JH
2507 $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
2508 }
8f675a64 2509
9393ace2
JH
2510 no strict 'refs';
2511 # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
2512 if (defined ${"$a[0]::downgrade"})
2513 {
2514 $d = ${"$a[0]::downgrade"};
2515 ${"$a[0]::downgrade"} = undef;
2516 }
2517
d614cd8b 2518 my $up = ${"$a[0]::upgrade"};
7d193e39 2519 # print STDERR "# Now in objectify, my class is today $a[0], count = $count\n";
58cde26e
JH
2520 if ($count == 0)
2521 {
2522 while (@_)
2523 {
2524 $k = shift;
2525 if (!ref($k))
2526 {
2527 $k = $a[0]->new($k);
2528 }
d614cd8b 2529 elsif (!defined $up && ref($k) ne $a[0])
58cde26e
JH
2530 {
2531 # foreign object, try to convert to integer
2532 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2533 }
58cde26e
JH
2534 push @a,$k;
2535 }
2536 }
2537 else
2538 {
2539 while ($count > 0)
2540 {
58cde26e 2541 $count--;
7d193e39 2542 $k = shift;
58cde26e
JH
2543 if (!ref($k))
2544 {
2545 $k = $a[0]->new($k);
2546 }
d614cd8b 2547 elsif (!defined $up && ref($k) ne $a[0])
58cde26e
JH
2548 {
2549 # foreign object, try to convert to integer
a0ac753d 2550 $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
e16b8f49 2551 }
58cde26e
JH
2552 push @a,$k;
2553 }
2554 push @a,@_; # return other params, too
2555 }
990fb837
RGS
2556 if (! wantarray)
2557 {
2558 require Carp; Carp::croak ("$class objectify needs list context");
2559 }
9393ace2 2560 ${"$a[0]::downgrade"} = $d;
58cde26e
JH
2561 @a;
2562 }
2563
b68b7ab1
T
2564sub _register_callback
2565 {
2566 my ($class,$callback) = @_;
2567
2568 if (ref($callback) ne 'CODE')
2569 {
2570 require Carp;
2571 Carp::croak ("$callback is not a coderef");
2572 }
2573 $CALLBACKS{$class} = $callback;
2574 }
2575
58cde26e
JH
2576sub import
2577 {
2578 my $self = shift;
61f5c3f5 2579
091c87b1 2580 $IMPORT++; # remember we did import()
8f675a64 2581 my @a; my $l = scalar @_;
7b29e1e6 2582 my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
8f675a64 2583 for ( my $i = 0; $i < $l ; $i++ )
58cde26e 2584 {
0716bf9b 2585 if ($_[$i] eq ':constant')
58cde26e 2586 {
0716bf9b 2587 # this causes overlord er load to step in
091c87b1
T
2588 overload::constant
2589 integer => sub { $self->new(shift) },
2590 binary => sub { $self->new(shift) };
0716bf9b 2591 }
b3abae2a
JH
2592 elsif ($_[$i] eq 'upgrade')
2593 {
2594 # this causes upgrading
2595 $upgrade = $_[$i+1]; # or undef to disable
8f675a64 2596 $i++;
b3abae2a 2597 }
7b29e1e6 2598 elsif ($_[$i] =~ /^(lib|try|only)\z/)
0716bf9b
JH
2599 {
2600 # this causes a different low lib to take care...
61f5c3f5 2601 $CALC = $_[$i+1] || '';
7b29e1e6
T
2602 # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
2603 $warn_or_die = 1 if $_[$i] eq 'lib';
2604 $warn_or_die = 2 if $_[$i] eq 'only';
8f675a64
JH
2605 $i++;
2606 }
2607 else
2608 {
2609 push @a, $_[$i];
58cde26e
JH
2610 }
2611 }
2612 # any non :constant stuff is handled by our parent, Exporter
b68b7ab1
T
2613 if (@a > 0)
2614 {
2615 require Exporter;
2616
2617 $self->SUPER::import(@a); # need it for subclasses
2618 $self->export_to_level(1,$self,@a); # need it for MBF
2619 }
58cde26e 2620
574bacfe
JH
2621 # try to load core math lib
2622 my @c = split /\s*,\s*/,$CALC;
b68b7ab1
T
2623 foreach (@c)
2624 {
2625 $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
2626 }
7b29e1e6
T
2627 push @c, \'FastCalc', \'Calc' # if all fail, try these
2628 if $warn_or_die < 2; # but not for "only"
61f5c3f5 2629 $CALC = ''; # signal error
7b29e1e6 2630 foreach my $l (@c)
574bacfe 2631 {
7b29e1e6
T
2632 # fallback libraries are "marked" as \'string', extract string if nec.
2633 my $lib = $l; $lib = $$l if ref($l);
2634
07d34614 2635 next if ($lib || '') eq '';
574bacfe
JH
2636 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
2637 $lib =~ s/\.pm$//;
61f5c3f5 2638 if ($] < 5.006)
574bacfe 2639 {
b68b7ab1
T
2640 # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
2641 # used in the same script, or eval("") inside import().
07d34614
T
2642 my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
2643 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
2644 require File::Spec;
2645 $file = File::Spec->catfile (@parts, $file);
2646 eval { require "$file"; $lib->import( @c ); }
574bacfe
JH
2647 }
2648 else
2649 {
61f5c3f5 2650 eval "use $lib qw/@c/;";
574bacfe 2651 }
9b924220
RGS
2652 if ($@ eq '')
2653 {
2654 my $ok = 1;
2655 # loaded it ok, see if the api_version() is high enough
2656 if ($lib->can('api_version') && $lib->api_version() >= 1.0)
2657 {
2658 $ok = 0;
2659 # api_version matches, check if it really provides anything we need
2660 for my $method (qw/
2661 one two ten
2662 str num
2663 add mul div sub dec inc
2664 acmp len digit is_one is_zero is_even is_odd
2665 is_two is_ten
7b29e1e6
T
2666 zeros new copy check
2667 from_hex from_oct from_bin as_hex as_bin as_oct
9b924220
RGS
2668 rsft lsft xor and or
2669 mod sqrt root fac pow modinv modpow log_int gcd
2670 /)
2671 {
2672 if (!$lib->can("_$method"))
2673 {
2674 if (($WARN{$lib}||0) < 2)
2675 {
2676 require Carp;
2677 Carp::carp ("$lib is missing method '_$method'");
2678 $WARN{$lib} = 1; # still warn about the lib
2679 }
2680 $ok++; last;
2681 }
2682 }
2683 }
2684 if ($ok == 0)
2685 {
2686 $CALC = $lib;
7b29e1e6
T
2687 if ($warn_or_die > 0 && ref($l))
2688 {
2689 require Carp;
2690 my $msg = "Math::BigInt: couldn't load specified math lib(s), fallback to $lib";
2691 Carp::carp ($msg) if $warn_or_die == 1;
2692 Carp::croak ($msg) if $warn_or_die == 2;
2693 }
9b924220
RGS
2694 last; # found a usable one, break
2695 }
2696 else
2697 {
2698 if (($WARN{$lib}||0) < 2)
2699 {
a87115f0 2700 my $ver = eval "\$$lib\::VERSION" || 'unknown';
9b924220
RGS
2701 require Carp;
2702 Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
2703 $WARN{$lib} = 2; # never warn again
2704 }
2705 }
2706 }
574bacfe 2707 }
990fb837
RGS
2708 if ($CALC eq '')
2709 {
2710 require Carp;
7b29e1e6
T
2711 if ($warn_or_die == 2)
2712 {
2713 Carp::croak ("Couldn't load specified math lib(s) and fallback disallowed");
2714 }
2715 else
2716 {
2717 Carp::croak ("Couldn't load any math lib(s), not even fallback to Calc.pm");
2718 }
091c87b1 2719 }
091c87b1 2720
b68b7ab1
T
2721 # notify callbacks
2722 foreach my $class (keys %CALLBACKS)
2723 {
2724 &{$CALLBACKS{$class}}($CALC);
2725 }
2726
2727 # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
2728 # functions
091c87b1
T
2729
2730 %CAN = ();
b68b7ab1 2731 for my $method (qw/ signed_and signed_or signed_xor /)
091c87b1
T
2732 {
2733 $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
990fb837 2734 }
b68b7ab1
T
2735
2736 # import done
58cde26e
JH
2737 }
2738
7b29e1e6
T
2739sub from_hex
2740 {
2741 # create a bigint from a hexadecimal string
2742 my ($self, $hs) = @_;
2743
7aa7e0ae 2744 my $rc = __from_hex($hs);
7b29e1e6
T
2745
2746 return $self->bnan() unless defined $rc;
2747
2748 $rc;
2749 }
2750
2751sub from_bin
2752 {
2753 # create a bigint from a hexadecimal string
2754 my ($self, $bs) = @_;
2755
7aa7e0ae 2756 my $rc = __from_bin($bs);
7b29e1e6
T
2757
2758 return $self->bnan() unless defined $rc;
2759
2760 $rc;
2761 }
2762
2763sub from_oct
2764 {
2765 # create a bigint from a hexadecimal string
2766 my ($self, $os) = @_;
2767
2768 my $x = $self->bzero();
2769
2770 # strip underscores
7aa7e0ae
T
2771 $os =~ s/([0-7])_([0-7])/$1$2/g;
2772 $os =~ s/([0-7])_([0-7])/$1$2/g;
7b29e1e6 2773
7aa7e0ae 2774 return $x->bnan() if $os !~ /^[\-\+]?0[0-7]+\z/;
7b29e1e6
T
2775
2776 my $sign = '+'; $sign = '-' if $os =~ /^-/;
2777
2778 $os =~ s/^[+-]//; # strip sign
2779 $x->{value} = $CALC->_from_oct($os);
2780 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2781 $x;
2782 }
2783
574bacfe 2784sub __from_hex
58cde26e 2785 {
b68b7ab1 2786 # internal
58cde26e
JH
2787 # convert a (ref to) big hex string to BigInt, return undef for error
2788 my $hs = shift;
2789
2790 my $x = Math::BigInt->bzero();
394e6ffb
JH
2791
2792 # strip underscores
9b924220
RGS
2793 $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
2794 $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
394e6ffb 2795
9b924220 2796 return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
58cde26e 2797
9b924220 2798 my $sign = '+'; $sign = '-' if $hs =~ /^-/;
58cde26e 2799
9b924220
RGS
2800 $hs =~ s/^[+-]//; # strip sign
2801 $x->{value} = $CALC->_from_hex($hs);
13a12e00
JH
2802 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2803 $x;
58cde26e
JH
2804 }
2805
574bacfe 2806sub __from_bin
58cde26e 2807 {
b68b7ab1 2808 # internal
58cde26e
JH
2809 # convert a (ref to) big binary string to BigInt, return undef for error
2810 my $bs = shift;
2811
2812 my $x = Math::BigInt->bzero();
7b29e1e6 2813
394e6ffb 2814 # strip underscores
9b924220
RGS
2815 $bs =~ s/([01])_([01])/$1$2/g;
2816 $bs =~ s/([01])_([01])/$1$2/g;
2817 return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/;
58cde26e 2818
9b924220
RGS
2819 my $sign = '+'; $sign = '-' if $bs =~ /^\-/;
2820 $bs =~ s/^[+-]//; # strip sign
2821
2822 $x->{value} = $CALC->_from_bin($bs);
13a12e00
JH
2823 $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
2824 $x;
58cde26e
JH
2825 }
2826
2827sub _split
2828 {
b68b7ab1
T
2829 # input: num_str; output: undef for invalid or
2830 # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,\$exp_sign,\$exp_value)
2831 # Internal, take apart a string and return the pieces.
2832 # Strip leading/trailing whitespace, leading zeros, underscore and reject
2833 # invalid input.
58cde26e
JH
2834 my $x = shift;
2835
574bacfe 2836 # strip white space at front, also extranous leading zeros
7b29e1e6
T
2837 $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
2838 $x =~ s/^\s+//; # but this will
2839 $x =~ s/\s+$//g; # strip white space at end
58cde26e 2840
574bacfe 2841 # shortcut, if nothing to split, return early
7b29e1e6 2842 if ($x =~ /^[+-]?[0-9]+\z/)
574bacfe 2843 {
9b924220
RGS
2844 $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
2845 return (\$sign, \$x, \'', \'', \0);
574bacfe 2846 }
58cde26e 2847
574bacfe 2848 # invalid starting char?
9b924220 2849 return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
58cde26e 2850
7b29e1e6
T
2851 return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string
2852 return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string
394e6ffb
JH
2853
2854 # strip underscores between digits
7b29e1e6
T
2855 $x =~ s/([0-9])_([0-9])/$1$2/g;
2856 $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
574bacfe 2857
58cde26e
JH
2858 # some possible inputs:
2859 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
aef458a0 2860 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
58cde26e 2861
9b924220 2862 my ($m,$e,$last) = split /[Ee]/,$x;
56d9de68 2863 return if defined $last; # last defined => 1e2E3 or others
58cde26e 2864 $e = '0' if !defined $e || $e eq "";
56d9de68 2865
58cde26e
JH
2866 # sign,value for exponent,mantint,mantfrac
2867 my ($es,$ev,$mis,$miv,$mfv);
2868 # valid exponent?
7b29e1e6 2869 if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
58cde26e
JH
2870 {
2871 $es = $1; $ev = $2;
58cde26e
JH
2872 # valid mantissa?
2873 return if $m eq '.' || $m eq '';
56d9de68 2874 my ($mi,$mf,$lastf) = split /\./,$m;
8df1e0a2 2875 return if defined $lastf; # lastf defined => 1.2.3 or others
58cde26e
JH
2876 $mi = '0' if !defined $mi;
2877 $mi .= '0' if $mi =~ /^[\-\+]?$/;
2878 $mf = '0' if !defined $mf || $mf eq '';
7b29e1e6 2879 if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
58cde26e
JH
2880 {
2881 $mis = $1||'+'; $miv = $2;
7b29e1e6 2882 return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
58cde26e 2883 $mfv = $1;
aef458a0
JH
2884 # handle the 0e999 case here
2885 $ev = 0 if $miv eq '0' && $mfv eq '';
58cde26e
JH
2886 return (\$mis,\$miv,\$mfv,\$es,\$ev);
2887 }
2888 }
2889 return; # NaN, not a number
2890 }
2891
58cde26e 2892##############################################################################
0716bf9b 2893# internal calculation routines (others are in Math::BigInt::Calc etc)
58cde26e 2894
dccbb853 2895sub __lcm
58cde26e
JH
2896 {
2897 # (BINT or num_str, BINT or num_str) return BINT
2898 # does modify first argument
2899 # LCM
2900
b68b7ab1 2901 my ($x,$ty) = @_;
58cde26e 2902 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
b68b7ab1
T
2903 my $method = ref($x) . '::bgcd';
2904 no strict 'refs';
2905 $x * $ty / &$method($x,$ty);
58cde26e
JH
2906 }
2907
58cde26e 2908###############################################################################
fdb4b05f
T
2909# trigonometric functions
2910
2911sub bpi
2912 {
2913 # Calculate PI to N digits. Unless upgrading is in effect, returns the
2914 # result truncated to an integer, that is, always returns '3'.
2915 my ($self,$n) = @_;
2916 if (@_ == 1)
2917 {
2918 # called like Math::BigInt::bpi(10);
2919 $n = $self; $self = $class;
2920 }
2921 $self = ref($self) if ref($self);
2922
2923 return $upgrade->new($n) if defined $upgrade;
2924
2925 # hard-wired to "3"
2926 $self->new(3);
2927 }
2928
60a1aa19
T
2929sub bcos
2930 {
2931 # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the
2932 # result truncated to an integer.
2933 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2934
2935 return $x if $x->modify('bcos');
2936
2937 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
2938
2939 return $upgrade->new($x)->bcos(@r) if defined $upgrade;
2940
20e2035c 2941 require Math::BigFloat;
60a1aa19
T
2942 # calculate the result and truncate it to integer
2943 my $t = Math::BigFloat->new($x)->bcos(@r)->as_int();
2944
2945 $x->bone() if $t->is_one();
2946 $x->bzero() if $t->is_zero();
2947 $x->round(@r);
2948 }
2949
2950sub bsin
2951 {
2952 # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
2953 # result truncated to an integer.
2954 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
2955
2956 return $x if $x->modify('bsin');
2957
2958 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
2959
2960 return $upgrade->new($x)->bsin(@r) if defined $upgrade;
2961
20e2035c 2962 require Math::BigFloat;
60a1aa19
T
2963 # calculate the result and truncate it to integer
2964 my $t = Math::BigFloat->new($x)->bsin(@r)->as_int();
2965
2966 $x->bone() if $t->is_one();
2967 $x->bzero() if $t->is_zero();
2968 $x->round(@r);
2969 }
2970
20e2035c
T
2971sub batan2
2972 {
30afc38d 2973 # calculate arcus tangens of ($y/$x)
20e2035c
T
2974
2975 # set up parameters
30afc38d 2976 my ($self,$y,$x,@r) = (ref($_[0]),@_);
20e2035c
T
2977 # objectify is costly, so avoid it
2978 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2979 {
30afc38d 2980 ($self,$y,$x,@r) = objectify(2,@_);
20e2035c
T
2981 }
2982
30afc38d 2983 return $y if $y->modify('batan2');
20e2035c 2984
30afc38d
T
2985 return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
2986
2987 return $y->bzero() if $y->is_zero() && $x->{sign} eq '+'; # x >= 0
20e2035c
T
2988
2989 # inf handling
30afc38d
T
2990 # +-inf => --PI/2 => +-1
2991 return $y->bone( substr($y->{sign},0,1) ) if $y->{sign} =~ /^[+-]inf$/;
20e2035c 2992
30afc38d 2993 return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
20e2035c
T
2994
2995 require Math::BigFloat;
30afc38d 2996 my $r = Math::BigFloat->new($y)->batan2(Math::BigFloat->new($x),@r)->as_int();
20e2035c
T
2997
2998 $x->{value} = $r->{value};
2999 $x->{sign} = $r->{sign};
3000
3001 $x;
3002 }
3003
60a1aa19
T
3004sub batan
3005 {
3006 # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the
3007 # result truncated to an integer.
3008 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
3009
3010 return $x if $x->modify('batan');
3011
3012 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
3013
3014 return $upgrade->new($x)->batan(@r) if defined $upgrade;
3015
3016 # calculate the result and truncate it to integer
3017 my $t = Math::BigFloat->new($x)->batan(@r);
3018
3019 $x->{value} = $CALC->_new( $x->as_int()->bstr() );
3020 $x->round(@r);
3021 }
3022
fdb4b05f 3023###############################################################################
b68b7ab1 3024# this method returns 0 if the object can be modified, or 1 if not.
b282a552 3025# We use a fast constant sub() here, to avoid costly calls. Subclasses
58cde26e
JH
3026# may override it with special code (f.i. Math::BigInt::Constant does so)
3027
0716bf9b 3028sub modify () { 0; }
e16b8f49 3029
a0d0e21e 30301;
a5f75d66
AD
3031__END__
3032
233f7bc0
T
3033=pod
3034
a5f75d66
AD
3035=head1 NAME
3036
233f7bc0 3037Math::BigInt - Arbitrary size integer/float math package
a5f75d66
AD
3038
3039=head1 SYNOPSIS
3040
3041 use Math::BigInt;
58cde26e 3042
990fb837
RGS
3043 # or make it faster: install (optional) Math::BigInt::GMP
3044 # and always use (it will fall back to pure Perl if the
3045 # GMP library is not installed):
3046
7b29e1e6 3047 # will warn if Math::BigInt::GMP cannot be found
990fb837
RGS
3048 use Math::BigInt lib => 'GMP';
3049
7b29e1e6
T
3050 # to supress the warning use this:
3051 # use Math::BigInt try => 'GMP';
3052
9b924220
RGS
3053 my $str = '1234567890';
3054 my @values = (64,74,18);
3055 my $n = 1; my $sign = '-';
3056
58cde26e 3057 # Number creation
fdb4b05f
T
3058 my $x = Math::BigInt->new($str); # defaults to 0
3059 my $y = $x->copy(); # make a true copy
3060 my $nan = Math::BigInt->bnan(); # create a NotANumber
3061 my $zero = Math::BigInt->bzero(); # create a +0
3062 my $inf = Math::BigInt->binf(); # create a +inf
3063 my $inf = Math::BigInt->binf('-'); # create a -inf
3064 my $one = Math::BigInt->bone(); # create a +1
3065 my $mone = Math::BigInt->bone('-'); # create a -1
3066
3067 my $pi = Math::BigInt->bpi(); # returns '3'
3068 # see Math::BigFloat::bpi()
58cde26e 3069
7b29e1e6
T
3070 $h = Math::BigInt->new('0x123'); # from hexadecimal
3071 $b = Math::BigInt->new('0b101'); # from binary
3072 $o = Math::BigInt->from_oct('0101'); # from octal
3073
56d9de68
T
3074 # Testing (don't modify their arguments)
3075 # (return true if the condition is met, otherwise false)
3076
3077 $x->is_zero(); # if $x is +0
3078 $x->is_nan(); # if $x is NaN
3079 $x->is_one(); # if $x is +1
3080 $x->is_one('-'); # if $x is -1
3081 $x->is_odd(); # if $x is odd
3082 $x->is_even(); # if $x is even
b282a552
T
3083 $x->is_pos(); # if $x >= 0
3084 $x->is_neg(); # if $x < 0
9b924220 3085 $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
56d9de68
T
3086 $x->is_int(); # if $x is an integer (not a float)
3087
3c4b39be 3088 # comparing and digit/sign extraction
56d9de68
T
3089 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
3090 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
3091 $x->sign(); # return the sign, either +,- or NaN
3092 $x->digit($n); # return the nth digit, counting from right
3093 $x->digit(-$n); # return the nth digit, counting from left
58cde26e 3094
990fb837
RGS
3095 # The following all modify their first argument. If you want to preserve
3096 # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
3c4b39be 3097 # necessary when mixing $a = $b assignments with non-overloaded math.
58cde26e 3098
56d9de68
T
3099 $x->bzero(); # set $x to 0
3100 $x->bnan(); # set $x to NaN
3101 $x->bone(); # set $x to +1
3102 $x->bone('-'); # set $x to -1
3103 $x->binf(); # set $x to inf
3104 $x->binf('-'); # set $x to -inf
3105
3106 $x->bneg(); # negation
3107 $x->babs(); # absolute value
3108 $x->bnorm(); # normalize (no-op in BigInt)
3109 $x->bnot(); # two's complement (bit wise not)
3110 $x->binc(); # increment $x by 1
3111 $x->bdec(); # decrement $x by 1
58cde26e 3112
56d9de68
T
3113 $x->badd($y); # addition (add $y to $x)
3114 $x->bsub($y); # subtraction (subtract $y from $x)
3115 $x->bmul($y); # multiplication (multiply $x by $y)
3116 $x->bdiv($y); # divide, set $x to quotient
3117 # return (quo,rem) or quo if scalar
3118
80365507
T
3119 $x->bmuladd($y,$z); # $x = $x * $y + $z
3120
56d9de68
T
3121 $x->bmod($y); # modulus (x % y)
3122 $x->bmodpow($exp,$mod); # modular exponentation (($num**$exp) % $mod))
3123 $x->bmodinv($mod); # the inverse of $x in the given modulus $mod
3124
3125 $x->bpow($y); # power of arguments (x ** y)
7d193e39
T
3126 $x->blsft($y); # left shift in base 2
3127 $x->brsft($y); # right shift in base 2
7b29e1e6
T
3128 # returns (quo,rem) or quo if in scalar context
3129 $x->blsft($y,$n); # left shift by $y places in base $n
3130 $x->brsft($y,$n); # right shift by $y places in base $n
3131 # returns (quo,rem) or quo if in scalar context
58cde26e 3132
56d9de68
T
3133 $x->band($y); # bitwise and
3134 $x->bior($y); # bitwise inclusive or
3135 $x->bxor($y); # bitwise exclusive or
3136 $x->bnot(); # bitwise not (two's complement)
3137
3138 $x->bsqrt(); # calculate square-root
990fb837 3139 $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
56d9de68 3140 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
58cde26e 3141
50109ad0
RGS
3142 $x->bnok($y); # x over y (binomial coefficient n over k)
3143
7d193e39
T
3144 $x->blog(); # logarithm of $x to base e (Euler's number)
3145 $x->blog($base); # logarithm of $x to base $base (f.i. 2)
3146 $x->bexp(); # calculate e ** $x where e is Euler's number
3147
990fb837 3148 $x->round($A,$P,$mode); # round to accuracy or precision using mode $mode
9b924220
RGS
3149 $x->bround($n); # accuracy: preserve $n digits
3150 $x->bfround($n); # round to $nth digit, no-op for BigInts
58cde26e 3151
990fb837 3152 # The following do not modify their arguments in BigInt (are no-ops),
56d9de68 3153 # but do so in BigFloat:
58cde26e 3154
56d9de68
T
3155 $x->bfloor(); # return integer less or equal than $x
3156 $x->bceil(); # return integer greater or equal than $x
58cde26e
JH
3157
3158 # The following do not modify their arguments:
3159
9b924220
RGS
3160 # greatest common divisor (no OO style)
3161 my $gcd = Math::BigInt::bgcd(@values);
3162 # lowest common multiplicator (no OO style)
3163 my $lcm = Math::BigInt::blcm(@values);
bd05a461 3164
56d9de68 3165 $x->length(); # return number of digits in number
9b924220 3166 ($xl,$f) = $x->length(); # length of number and length of fraction part,
b68b7ab1 3167 # latter is always 0 digits long for BigInts
56d9de68
T
3168
3169 $x->exponent(); # return exponent as BigInt
3170 $x->mantissa(); # return (signed) mantissa as BigInt
3171 $x->parts(); # return (mantissa,exponent) as BigInt
3172 $x->copy(); # make a true copy of $x (unlike $y = $x;)
b282a552
T
3173 $x->as_int(); # return as BigInt (in BigInt: same as copy())
3174 $x->numify(); # return as scalar (might overflow!)
bd05a461 3175
56d9de68 3176 # conversation to string (do not modify their argument)
b68b7ab1
T
3177 $x->bstr(); # normalized string (e.g. '3')
3178 $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
56d9de68
T
3179 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
3180 $x->as_bin(); # as signed binary string with prefixed 0b
7b29e1e6 3181 $x->as_oct(); # as signed octal string with prefixed 0
b282a552 3182
bd05a461 3183
f9a08e12 3184 # precision and accuracy (see section about rounding for more)
56d9de68
T
3185 $x->precision(); # return P of $x (or global, if P of $x undef)
3186 $x->precision($n); # set P of $x to $n
3187 $x->accuracy(); # return A of $x (or global, if A of $x undef)
3188 $x->accuracy($n); # set A $x to $n
f9a08e12 3189
56d9de68 3190 # Global methods
b68b7ab1
T
3191 Math::BigInt->precision(); # get/set global P for all BigInt objects
3192 Math::BigInt->accuracy(); # get/set global A for all BigInt objects
3193 Math::BigInt->round_mode(); # get/set global round mode, one of
7b29e1e6 3194 # 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
b68b7ab1 3195 Math::BigInt->config(); # return hash containing configuration
f9a08e12 3196
a5f75d66
AD
3197=head1 DESCRIPTION
3198
3c4b39be 3199All operators (including basic math operations) are overloaded if you
58cde26e 3200declare your big integers as
a5f75d66 3201
58cde26e 3202 $i = new Math::BigInt '123_456_789_123_456_789';
a5f75d66 3203
58cde26e
JH
3204Operations with overloaded operators preserve the arguments which is
3205exactly what you expect.
a5f75d66
AD
3206
3207=over 2
3208
aef458a0 3209=item Input
a5f75d66 3210
aef458a0
JH
3211Input values to these routines may be any string, that looks like a number
3212and results in an integer, including hexadecimal and binary numbers.
58cde26e 3213
aef458a0
JH
3214Scalars holding numbers may also be passed, but note that non-integer numbers
3215may already have lost precision due to the conversation to float. Quote
091c87b1 3216your input if you want BigInt to see all the digits:
a5f75d66 3217
aef458a0
JH
3218 $x = Math::BigInt->new(12345678890123456789); # bad
3219 $x = Math::BigInt->new('12345678901234567890'); # good
58cde26e 3220
56d9de68 3221You can include one underscore between any two digits.
58cde26e
JH
3222
3223This means integer values like 1.01E2 or even 1000E-2 are also accepted.
aef458a0 3224Non-integer values result in NaN.
58cde26e 3225
7b29e1e6
T
3226Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b")
3227are accepted, too. Please note that octal numbers are not recognized
3228by new(), so the following will print "123":
3229
3230 perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
3231
3232To convert an octal number, use from_oct();
3233
3234 perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
3235
aef458a0 3236Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
091c87b1
T
3237results in 'NaN'. This might change in the future, so use always the following
3238explicit forms to get a zero or NaN:
3239
3240 $zero = Math::BigInt->bzero();
3241 $nan = Math::BigInt->bnan();
58cde26e 3242
aef458a0 3243C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
091c87b1 3244are always stored in normalized form. If passed a string, creates a BigInt
aef458a0 3245object from the input.
a5f75d66
AD
3246
3247=item Output
3248
b68b7ab1
T
3249Output values are BigInt objects (normalized), except for the methods which
3250return a string (see L<SYNOPSIS>).
3251
58cde26e 3252Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
b68b7ab1
T
3253C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>)
3254return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort.
a5f75d66
AD
3255
3256=back
3257
b3abae2a
JH
3258=head1 METHODS
3259
56d9de68 3260Each of the methods below (except config(), accuracy() and precision())
b68b7ab1
T
3261accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R>
3262are C<accuracy>, C<precision> and C<round_mode>. Please see the section about
56d9de68 3263L<ACCURACY and PRECISION> for more information.
b3abae2a 3264
7b29e1e6 3265=head2 config()
8f675a64
JH
3266
3267 use Data::Dumper;
3268
3269 print Dumper ( Math::BigInt->config() );
56d9de68 3270 print Math::BigInt->config()->{lib},"\n";
8f675a64
JH
3271
3272Returns a hash containing the configuration, e.g. the version number, lib
56d9de68
T
3273loaded etc. The following hash keys are currently filled in with the
3274appropriate information.
3275
3276 key Description
3277 Example
3278 ============================================================
091c87b1 3279 lib Name of the low-level math library
56d9de68 3280 Math::BigInt::Calc
091c87b1 3281 lib_version Version of low-level math library (see 'lib')
56d9de68 3282 0.30
091c87b1 3283 class The class name of config() you just called
56d9de68 3284 Math::BigInt
091c87b1 3285 upgrade To which class math operations might be upgraded
56d9de68 3286 Math::BigFloat
091c87b1 3287 downgrade To which class math operations might be downgraded
56d9de68
T
3288 undef
3289 precision Global precision
3290 undef
3291 accuracy Global accuracy
3292 undef
3293 round_mode Global round mode
3294 even
3295 version version number of the class you used
3296 1.61
3c4b39be 3297 div_scale Fallback accuracy for div
56d9de68 3298 40
091c87b1
T
3299 trap_nan If true, traps creation of NaN via croak()
3300 1
3301 trap_inf If true, traps creation of +inf/-inf via croak()
3302 1
56d9de68 3303
c38b2de2 3304The following values can be set by passing C<config()> a reference to a hash:
93c87d9d
T
3305
3306 trap_inf trap_nan
3307 upgrade downgrade precision accuracy round_mode div_scale
3308
3309Example:
3310
3311 $new_cfg = Math::BigInt->config( { trap_inf => 1, precision => 5 } );
8f675a64 3312
7b29e1e6 3313=head2 accuracy()
13a12e00
JH
3314
3315 $x->accuracy(5); # local for $x
56d9de68 3316 CLASS->accuracy(5); # global for all members of CLASS
233f7bc0
T
3317 # Note: This also applies to new()!
3318
3319 $A = $x->accuracy(); # read out accuracy that affects $x
3320 $A = CLASS->accuracy(); # read out global accuracy
13a12e00
JH
3321
3322Set or get the global or local accuracy, aka how many significant digits the
233f7bc0
T
3323results have. If you set a global accuracy, then this also applies to new()!
3324
3325Warning! The accuracy I<sticks>, e.g. once you created a number under the
3326influence of C<< CLASS->accuracy($A) >>, all results from math operations with
3327that number will also be rounded.
3328
3c4b39be 3329In most cases, you should probably round the results explicitly using one of
233f7bc0
T
3330L<round()>, L<bround()> or L<bfround()> or by passing the desired accuracy
3331to the math operation as additional parameter:
3332
3333 my $x = Math::BigInt->new(30000);
3334 my $y = Math::BigInt->new(7);
3335 print scalar $x->copy()->bdiv($y, 2); # print 4300
3336 print scalar $x->copy()->bdiv($y)->bround(2); # print 4300
56d9de68
T
3337
3338Please see the section about L<ACCURACY AND PRECISION> for further details.
13a12e00
JH
3339
3340Value must be greater than zero. Pass an undef value to disable it:
3341
3342 $x->accuracy(undef);
3343 Math::BigInt->accuracy(undef);
3344
3345Returns the current accuracy. For C<$x->accuracy()> it will return either the
3346local accuracy, or if not defined, the global. This means the return value
3347represents the accuracy that will be in effect for $x:
3348
3349 $y = Math::BigInt->new(1234567); # unrounded
3350 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
233f7bc0 3351 $x = Math::BigInt->new(123456); # $x will be automatically rounded!
13a12e00
JH
3352 print "$x $y\n"; # '123500 1234567'
3353 print $x->accuracy(),"\n"; # will be 4
3354 print $y->accuracy(),"\n"; # also 4, since global is 4
3355 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
3356 print $x->accuracy(),"\n"; # still 4
3357 print $y->accuracy(),"\n"; # 5, since global is 5
3358
56d9de68
T
3359Note: Works also for subclasses like Math::BigFloat. Each class has it's own
3360globals separated from Math::BigInt, but it is possible to subclass
3361Math::BigInt and make the globals of the subclass aliases to the ones from
3362Math::BigInt.
3363
7b29e1e6 3364=head2 precision()
56d9de68 3365
233f7bc0
T
3366 $x->precision(-2); # local for $x, round at the second digit right of the dot
3367 $x->precision(2); # ditto, round at the second digit left of the dot
3368
3369 CLASS->precision(5); # Global for all members of CLASS
3370 # This also applies to new()!
3371 CLASS->precision(-5); # ditto
3372
3373 $P = CLASS->precision(); # read out global precision
3374 $P = $x->precision(); # read out precision that affects $x
3375
3376Note: You probably want to use L<accuracy()> instead. With L<accuracy> you
3377set the number of digits each result should have, with L<precision> you
3378set the place where to round!
56d9de68 3379
233f7bc0
T
3380C<precision()> sets or gets the global or local precision, aka at which digit
3381before or after the dot to round all results. A set global precision also
3382applies to all newly created numbers!
3383
3384In Math::BigInt, passing a negative number precision has no effect since no
3385numbers have digits after the dot. In L<Math::BigFloat>, it will round all
3386results to P digits after the dot.
56d9de68
T
3387
3388Please see the section about L<ACCURACY AND PRECISION> for further details.
3389
233f7bc0 3390Pass an undef value to disable it:
56d9de68
T
3391
3392 $x->precision(undef);
3393 Math::BigInt->precision(undef);
3394
3395Returns the current precision. For C<$x->precision()> it will return either the
3396local precision of $x, or if not defined, the global. This means the return
233f7bc0 3397value represents the prevision that will be in effect for $x:
56d9de68
T
3398
3399 $y = Math::BigInt->new(1234567); # unrounded
3400 print Math::BigInt->precision(4),"\n"; # set 4, print 4
3401 $x = Math::BigInt->new(123456); # will be automatically rounded
233f7bc0 3402 print $x; # print "120000"!
56d9de68 3403
233f7bc0
T
3404Note: Works also for subclasses like L<Math::BigFloat>. Each class has its
3405own globals separated from Math::BigInt, but it is possible to subclass
56d9de68
T
3406Math::BigInt and make the globals of the subclass aliases to the ones from
3407Math::BigInt.
3408
7b29e1e6 3409=head2 brsft()
b3abae2a
JH
3410
3411 $x->brsft($y,$n);
3412
3413Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
34142, but others work, too.
3415
3416Right shifting usually amounts to dividing $x by $n ** $y and truncating the
3417result:
3418
3419
3420 $x = Math::BigInt->new(10);
3421 $x->brsft(1); # same as $x >> 1: 5
3422 $x = Math::BigInt->new(1234);
3423 $x->brsft(2,10); # result 12
3424
3425There is one exception, and that is base 2 with negative $x:
3426
3427
3428 $x = Math::BigInt->new(-5);
3429 print $x->brsft(1);
3430
3431This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
3432result).
3433
7b29e1e6 3434=head2 new()
b3abae2a
JH
3435
3436 $x = Math::BigInt->new($str,$A,$P,$R);
3437
aef458a0 3438Creates a new BigInt object from a scalar or another BigInt object. The
b3abae2a
JH
3439input is accepted as decimal, hex (with leading '0x') or binary (with leading
3440'0b').
3441
aef458a0
JH
3442See L<Input> for more info on accepted input formats.
3443
7b29e1e6
T
3444=head2 from_oct()
3445
7aa7e0ae 3446 $x = Math::BigInt->from_oct("0775"); # input is octal
7b29e1e6
T
3447
3448=head2 from_hex()
3449
7aa7e0ae 3450 $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal
7b29e1e6
T
3451
3452=head2 from_bin()
3453
7aa7e0ae 3454 $x = Math::BigInt->from_oct("0x10011"); # input is binary
7b29e1e6
T
3455
3456=head2 bnan()
b3abae2a
JH
3457
3458 $x = Math::BigInt->bnan();
3459
3460Creates a new BigInt object representing NaN (Not A Number).
3461If used on an object, it will set it to NaN:
3462
3463 $x->bnan();
3464
7b29e1e6 3465=head2 bzero()
b3abae2a
JH
3466
3467 $x = Math::BigInt->bzero();
3468
3469Creates a new BigInt object representing zero.
3470If used on an object, it will set it to zero:
3471
3472 $x->bzero();
3473
7b29e1e6 3474=head2 binf()
b3abae2a
JH
3475
3476 $x = Math::BigInt->binf($sign);
3477
3478Creates a new BigInt object representing infinity. The optional argument is
3479either '-' or '+', indicating whether you want infinity or minus infinity.
3480If used on an object, it will set it to infinity:
3481
3482 $x->binf();
3483 $x->binf('-');
3484
7b29e1e6 3485=head2 bone()
b3abae2a
JH
3486
3487 $x = Math::BigInt->binf($sign);
3488
3489Creates a new BigInt object representing one. The optional argument is
3490either '-' or '+', indicating whether you want one or minus one.
3491If used on an object, it will set it to one:
3492
3493 $x->bone(); # +1
3494 $x->bone('-'); # -1
3495
56b9c951
JH
3496=head2 is_one()/is_zero()/is_nan()/is_inf()
3497
b3abae2a
JH
3498
3499 $x->is_zero(); # true if arg is +0
3500 $x->is_nan(); # true if arg is NaN
3501 $x->is_one(); # true if arg is +1
3502 $x->is_one('-'); # true if arg is -1
b3abae2a
JH
3503 $x->is_inf(); # true if +inf
3504 $x->is_inf('-'); # true if -inf (sign is default '+')
56b9c951 3505
3c4b39be 3506These methods all test the BigInt for being one specific value and return
56b9c951
JH
3507true or false depending on the input. These are faster than doing something
3508like:
3509
3510 if ($x == 0)
3511
7b29e1e6 3512=head2 is_pos()/is_neg()/is_positive()/is_negative()
56b9c951 3513
b68b7ab1
T
3514 $x->is_pos(); # true if > 0
3515 $x->is_neg(); # true if < 0
56b9c951
JH
3516
3517The methods return true if the argument is positive or negative, respectively.
3518C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
b68b7ab1 3519C<-inf> is negative. A C<zero> is neither positive nor negative.
56b9c951
JH
3520
3521These methods are only testing the sign, and not the value.
3522
3c4b39be 3523C<is_positive()> and C<is_negative()> are aliases to C<is_pos()> and
b282a552
T
3524C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were
3525introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced
3526in v1.68.
3527
56b9c951
JH
3528=head2 is_odd()/is_even()/is_int()
3529
3530 $x->is_odd(); # true if odd, false for even
3531 $x->is_even(); # true if even, false for odd
b3abae2a
JH
3532 $x->is_int(); # true if $x is an integer
3533
56b9c951
JH
3534The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
3535C<-inf> are not integers and are neither odd nor even.
b3abae2a 3536
c38b2de2
JH
3537In BigInt, all numbers except C<NaN>, C<+inf> and C<-inf> are integers.
3538
7b29e1e6 3539=head2 bcmp()
b3abae2a 3540
56b9c951
JH
3541 $x->bcmp($y);
3542
3543Compares $x with $y and takes the sign into account.
3544Returns -1, 0, 1 or undef.
b3abae2a 3545
7b29e1e6 3546=head2 bacmp()
b3abae2a 3547
56b9c951
JH
3548 $x->bacmp($y);
3549
3550Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
b3abae2a 3551
7b29e1e6 3552=head2 sign()
b3abae2a 3553
56b9c951
JH
3554 $x->sign();
3555
3556Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
b3abae2a 3557
b68b7ab1
T
3558If you want $x to have a certain sign, use one of the following methods:
3559
3560 $x->babs(); # '+'
3561 $x->babs()->bneg(); # '-'
3562 $x->bnan(); # 'NaN'
3563 $x->binf(); # '+inf'
3564 $x->binf('-'); # '-inf'
3565
7b29e1e6 3566=head2 digit()
091c87b1
T
3567
3568 $x->digit($n); # return the nth digit, counting from right
b3abae2a 3569
091c87b1 3570If C<$n> is negative, returns the digit counting from left.
b3abae2a 3571
7b29e1e6 3572=head2 bneg()
b3abae2a
JH
3573
3574 $x->bneg();
3575
3576Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
3577and '-inf', respectively. Does nothing for NaN or zero.
3578
7b29e1e6 3579=head2 babs()
b3abae2a
JH
3580
3581 $x->babs();
3582
86b76201 3583Set the number to its absolute value, e.g. change the sign from '-' to '+'
b3abae2a
JH
3584and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
3585numbers.
3586
7b29e1e6 3587=head2 bnorm()
b3abae2a 3588
56d9de68 3589 $x->bnorm(); # normalize (no-op)
b3abae2a 3590
7b29e1e6 3591=head2 bnot()
b3abae2a 3592
091c87b1
T
3593 $x->bnot();
3594
86b76201 3595Two's complement (bitwise not). This is equivalent to
091c87b1
T
3596
3597 $x->binc()->bneg();
3598
3599but faster.
b3abae2a 3600
7b29e1e6 3601=head2 binc()
b3abae2a 3602
56d9de68 3603 $x->binc(); # increment x by 1
b3abae2a 3604
7b29e1e6 3605=head2 bdec()
b3abae2a 3606
56d9de68 3607 $x->bdec(); # decrement x by 1
b3abae2a 3608
7b29e1e6 3609=head2 badd()
b3abae2a 3610
56d9de68 3611 $x->badd($y); # addition (add $y to $x)
b3abae2a 3612
7b29e1e6 3613=head2 bsub()
b3abae2a 3614
56d9de68 3615 $x->bsub($y); # subtraction (subtract $y from $x)
b3abae2a 3616
7b29e1e6 3617=head2 bmul()
b3abae2a 3618
56d9de68 3619 $x->bmul($y); # multiplication (multiply $x by $y)
b3abae2a 3620
80365507
T
3621=head2 bmuladd()
3622
3623 $x->bmuladd($y,$z);
3624
3625Multiply $x by $y, and then add $z to the result,
3626
3627This method was added in v1.87 of Math::BigInt (June 2007).
3628
7b29e1e6 3629=head2 bdiv()
b3abae2a 3630
56d9de68
T
3631 $x->bdiv($y); # divide, set $x to quotient
3632 # return (quo,rem) or quo if scalar
b3abae2a 3633
7b29e1e6 3634=head2 bmod()
b3abae2a 3635
56d9de68 3636 $x->bmod($y); # modulus (x % y)
b3abae2a 3637
7b29e1e6 3638=head2 bmodinv()
d614cd8b 3639
56d9de68 3640 num->bmodinv($mod); # modular inverse
d614cd8b
JH
3641
3642Returns the inverse of C<$num> in the given modulus C<$mod>. 'C<NaN>' is
3643returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
3644C<bgcd($num, $mod)==1>.
3645
7b29e1e6 3646=head2 bmodpow()
d614cd8b 3647
56d9de68
T
3648 $num->bmodpow($exp,$mod); # modular exponentation
3649 # ($num**$exp % $mod)
d614cd8b
JH
3650
3651Returns the value of C<$num> taken to the power C<$exp> in the modulus
3652C<$mod> using binary exponentation. C<bmodpow> is far superior to
3653writing
3654
56d9de68 3655 $num ** $exp % $mod
d614cd8b 3656
091c87b1 3657because it is much faster - it reduces internal variables into
d614cd8b
JH
3658the modulus whenever possible, so it operates on smaller numbers.
3659
3660C<bmodpow> also supports negative exponents.
3661
56d9de68 3662 bmodpow($num, -1, $mod)
d614cd8b
JH
3663
3664is exactly equivalent to
3665
56d9de68 3666 bmodinv($num, $mod)
d614cd8b 3667
7b29e1e6 3668=head2 bpow()
b3abae2a 3669
56d9de68 3670 $x->bpow($y); # power of arguments (x ** y)
b3abae2a 3671
7d193e39
T
3672=head2 blog()
3673
3674 $x->blog($base, $accuracy); # logarithm of x to the base $base
3675
3676If C<$base> is not defined, Euler's number (e) is used:
3677
3678 print $x->blog(undef, 100); # log(x) to 100 digits
3679
3680=head2 bexp()
3681
3682 $x->bexp($accuracy); # calculate e ** X
3683
3684Calculates the expression C<e ** $x> where C<e> is Euler's number.
3685
3686This method was added in v1.82 of Math::BigInt (April 2007).
3687
3688See also L<blog()>.
3689
50109ad0
RGS
3690=head2 bnok()
3691
3692 $x->bnok($y); # x over y (binomial coefficient n over k)
3693
3694Calculates the binomial coefficient n over k, also called the "choose"
3695function. The result is equivalent to:
3696
3697 ( n ) n!
3698 | - | = -------
3699 ( k ) k!(n-k)!
3700
3701This method was added in v1.84 of Math::BigInt (April 2007).
3702
fdb4b05f
T
3703=head2 bpi()
3704
3705 print Math::BigInt->bpi(100), "\n"; # 3
3706
20e2035c
T
3707Returns PI truncated to an integer, with the argument being ignored. This means
3708under BigInt this always returns C<3>.
fdb4b05f 3709
20e2035c
T
3710If upgrading is in effect, returns PI, rounded to N digits with the
3711current rounding mode:
fdb4b05f
T
3712
3713 use Math::BigFloat;
3714 use Math::BigInt upgrade => Math::BigFloat;
3715 print Math::BigInt->bpi(3), "\n"; # 3.14
3716 print Math::BigInt->bpi(100), "\n"; # 3.1415....
3717
3718This method was added in v1.87 of Math::BigInt (June 2007).
3719
60a1aa19
T
3720=head2 bcos()
3721
20e2035c 3722 my $x = Math::BigInt->new(1);
60a1aa19
T
3723 print $x->bcos(100), "\n";
3724
3725Calculate the cosinus of $x, modifying $x in place.
3726
20e2035c
T
3727In BigInt, unless upgrading is in effect, the result is truncated to an
3728integer.
3729
60a1aa19
T
3730This method was added in v1.87 of Math::BigInt (June 2007).
3731
3732=head2 bsin()
3733
20e2035c 3734 my $x = Math::BigInt->new(1);
60a1aa19
T
3735 print $x->bsin(100), "\n";
3736
3737Calculate the sinus of $x, modifying $x in place.
3738
20e2035c
T
3739In BigInt, unless upgrading is in effect, the result is truncated to an
3740integer.
3741
60a1aa19
T
3742This method was added in v1.87 of Math::BigInt (June 2007).
3743
30afc38d 3744=head2 batan2()
60a1aa19 3745
20e2035c 3746 my $x = Math::BigInt->new(1);
30afc38d
T
3747 my $y = Math::BigInt->new(1);
3748 print $y->batan2($x), "\n";
60a1aa19 3749
30afc38d 3750Calculate the arcus tangens of C<$y> divided by C<$x>, modifying $y in place.
60a1aa19 3751
20e2035c
T
3752In BigInt, unless upgrading is in effect, the result is truncated to an
3753integer.
3754
3755This method was added in v1.87 of Math::BigInt (June 2007).
3756
30afc38d 3757=head2 batan()
20e2035c 3758
30afc38d
T
3759 my $x = Math::BigFloat->new(0.5);
3760 print $x->batan(100), "\n";
20e2035c 3761
30afc38d 3762Calculate the arcus tangens of $x, modifying $x in place.
20e2035c
T
3763
3764In BigInt, unless upgrading is in effect, the result is truncated to an
3765integer.
3766
60a1aa19
T
3767This method was added in v1.87 of Math::BigInt (June 2007).
3768
7b29e1e6 3769=head2 blsft()
b3abae2a 3770
7d193e39 3771 $x->blsft($y); # left shift in base 2
56d9de68 3772 $x->blsft($y,$n); # left shift, in base $n (like 10)
b3abae2a 3773
7b29e1e6 3774=head2 brsft()
b3abae2a 3775
7d193e39 3776 $x->brsft($y); # right shift in base 2
56d9de68 3777 $x->brsft($y,$n); # right shift, in base $n (like 10)
b3abae2a 3778
7b29e1e6 3779=head2 band()
b3abae2a 3780
56d9de68 3781 $x->band($y); # bitwise and
b3abae2a 3782
7b29e1e6 3783=head2 bior()
b3abae2a 3784
56d9de68 3785 $x->bior($y); # bitwise inclusive or
b3abae2a 3786
7b29e1e6 3787=head2 bxor()
b3abae2a 3788
56d9de68 3789 $x->bxor($y); # bitwise exclusive or
b3abae2a 3790
7b29e1e6 3791=head2 bnot()
b3abae2a 3792
56d9de68 3793 $x->bnot(); # bitwise not (two's complement)
b3abae2a 3794
7b29e1e6 3795=head2 bsqrt()
b3abae2a 3796
56d9de68 3797 $x->bsqrt(); # calculate square-root
b3abae2a 3798
f7f86b73
T
3799=head2 broot()
3800
3801 $x->broot($N);
3802
3803Calculates the N'th root of C<$x>.
3804
7b29e1e6 3805=head2 bfac()
b3abae2a 3806
56d9de68 3807 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
b3abae2a 3808
7b29e1e6 3809=head2 round()
b3abae2a 3810
56d9de68
T
3811 $x->round($A,$P,$round_mode);
3812
3813Round $x to accuracy C<$A> or precision C<$P> using the round mode
3814C<$round_mode>.
b3abae2a 3815
7b29e1e6 3816=head2 bround()
b3abae2a 3817
56d9de68 3818 $x->bround($N); # accuracy: preserve $N digits
b3abae2a 3819
7b29e1e6 3820=head2 bfround()
b3abae2a 3821
56d9de68 3822 $x->bfround($N); # round to $Nth digit, no-op for BigInts
b3abae2a 3823
7b29e1e6 3824=head2 bfloor()
b3abae2a
JH
3825
3826 $x->bfloor();
3827
3828Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
3829does change $x in BigFloat.
3830
7b29e1e6 3831=head2 bceil()
b3abae2a
JH
3832
3833 $x->bceil();
3834
3835Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
3836does change $x in BigFloat.
3837
7b29e1e6 3838=head2 bgcd()
b3abae2a 3839
56d9de68 3840 bgcd(@values); # greatest common divisor (no OO style)
b3abae2a 3841
7b29e1e6 3842=head2 blcm()
b3abae2a 3843
56d9de68 3844 blcm(@values); # lowest common multiplicator (no OO style)
b3abae2a 3845
7b29e1e6 3846head2 length()
b3abae2a
JH
3847
3848 $x->length();
3849 ($xl,$fl) = $x->length();
3850
3851Returns the number of digits in the decimal representation of the number.
3852In list context, returns the length of the integer and fraction part. For
3853BigInt's, the length of the fraction part will always be 0.
3854
7b29e1e6 3855=head2 exponent()
b3abae2a
JH
3856
3857 $x->exponent();
3858
3859Return the exponent of $x as BigInt.
3860
7b29e1e6 3861=head2 mantissa()
b3abae2a
JH
3862
3863 $x->mantissa();
3864
3865Return the signed mantissa of $x as BigInt.
3866
7b29e1e6 3867=head2 parts()
b3abae2a 3868
56d9de68 3869 $x->parts(); # return (mantissa,exponent) as BigInt
b3abae2a 3870
7b29e1e6 3871=head2 copy()
b3abae2a 3872
56d9de68 3873 $x->copy(); # make a true copy of $x (unlike $y = $x;)
b3abae2a 3874
7b29e1e6 3875=head2 as_int()/as_number()
b3abae2a 3876
b282a552
T
3877 $x->as_int();
3878
3879Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as
3880C<copy()>.
3881
3882C<as_number()> is an alias to this method. C<as_number> was introduced in
3883v1.22, while C<as_int()> was only introduced in v1.68.
b3abae2a 3884
7b29e1e6 3885=head2 bstr()
b282a552
T
3886
3887 $x->bstr();
b3abae2a 3888
3c4b39be 3889Returns a normalized string representation of C<$x>.
b3abae2a 3890
7b29e1e6 3891=head2 bsstr()
b3abae2a 3892
56d9de68 3893 $x->bsstr(); # normalized string in scientific notation
b3abae2a 3894
7b29e1e6 3895=head2 as_hex()
b3abae2a 3896
56d9de68 3897 $x->as_hex(); # as signed hexadecimal string with prefixed 0x
b3abae2a 3898
7b29e1e6 3899=head2 as_bin()
b3abae2a 3900
56d9de68 3901 $x->as_bin(); # as signed binary string with prefixed 0b
b3abae2a 3902
7b29e1e6
T
3903=head2 as_oct()
3904
3905 $x->as_oct(); # as signed octal string with prefixed 0
3906
3907=head2 numify()
3908
3909 print $x->numify();
3910
3911This returns a normal Perl scalar from $x. It is used automatically
3912whenever a scalar is needed, for instance in array index operations.
3913
3914This loses precision, to avoid this use L<as_int()> instead.
3915
3916=head2 modify()
3917
3918 $x->modify('bpowd');
3919
3920This method returns 0 if the object can be modified with the given
3921peration, or 1 if not.
3922
3923This is used for instance by L<Math::BigInt::Constant>.
3924
3925=head2 upgrade()/downgrade()
3926
3927Set/get the class for downgrade/upgrade operations. Thuis is used
3928for instance by L<bignum>. The defaults are '', thus the following
3929operation will create a BigInt, not a BigFloat:
3930
3931 my $i = Math::BigInt->new(123);
3932 my $f = Math::BigFloat->new('123.1');
3933
3934 print $i + $f,"\n"; # print 246
3935
3936=head2 div_scale()
3937
3938Set/get the number of digits for the default precision in divide
3939operations.
3940
3941=head2 round_mode()
3942
3943Set/get the current round mode.
3944
0716bf9b
JH
3945=head1 ACCURACY and PRECISION
3946
b22b3e31 3947Since version v1.33, Math::BigInt and Math::BigFloat have full support for
0716bf9b 3948accuracy and precision based rounding, both automatically after every
091c87b1 3949operation, as well as manually.
0716bf9b
JH
3950
3951This section describes the accuracy/precision handling in Math::Big* as it
b22b3e31 3952used to be and as it is now, complete with an explanation of all terms and
0716bf9b
JH
3953abbreviations.
3954
3955Not yet implemented things (but with correct description) are marked with '!',
3956things that need to be answered are marked with '?'.
3957
3958In the next paragraph follows a short description of terms used here (because
574bacfe 3959these may differ from terms used by others people or documentation).
0716bf9b 3960
b22b3e31 3961During the rest of this document, the shortcuts A (for accuracy), P (for
0716bf9b
JH
3962precision), F (fallback) and R (rounding mode) will be used.
3963
3964=head2 Precision P
3965
3966A fixed number of digits before (positive) or after (negative)
b22b3e31
PN
3967the decimal point. For example, 123.45 has a precision of -2. 0 means an
3968integer like 123 (or 120). A precision of 2 means two digits to the left
3969of the decimal point are zero, so 123 with P = 1 becomes 120. Note that
3970numbers with zeros before the decimal point may have different precisions,
3971because 1200 can have p = 0, 1 or 2 (depending on what the inital value
3972was). It could also have p < 0, when the digits after the decimal point
3973are zero.
0716bf9b 3974
574bacfe
JH
3975The string output (of floating point numbers) will be padded with zeros:
3976
3977 Initial value P A Result String
3978 ------------------------------------------------------------
3979 1234.01 -3 1000 1000
3980 1234 -2 1200 1200
3981 1234.5 -1 1230 1230
3982 1234.001 1 1234 1234.0
3983 1234.01 0 1234 1234
3984 1234.01 2 1234.01 1234.01
3985 1234.01 5 1234.01 1234.01000
3986
3987For BigInts, no padding occurs.
0716bf9b
JH
3988
3989=head2 Accuracy A
3990
3991Number of significant digits. Leading zeros are not counted. A
3992number may have an accuracy greater than the non-zero digits
b22b3e31
PN
3993when there are zeros in it or trailing zeros. For example, 123.456 has
3994A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
0716bf9b 3995
574bacfe
JH
3996The string output (of floating point numbers) will be padded with zeros:
3997
3998 Initial value P A Result String
3999 ------------------------------------------------------------
4000 1234.01 3 1230 1230
4001 1234.01 6 1234.01 1234.01
4002 1234.1 8 1234.1 1234.1000
4003
4004For BigInts, no padding occurs.
4005
0716bf9b 4006=head2 Fallback F
a5f75d66 4007
574bacfe
JH
4008When both A and P are undefined, this is used as a fallback accuracy when
4009dividing numbers.
0716bf9b
JH
4010
4011=head2 Rounding mode R
4012
4013When rounding a number, different 'styles' or 'kinds'
4014of rounding are possible. (Note that random rounding, as in
4015Math::Round, is not implemented.)
58cde26e
JH
4016
4017=over 2
a5f75d66 4018
0716bf9b
JH
4019=item 'trunc'
4020
4021truncation invariably removes all digits following the
4022rounding place, replacing them with zeros. Thus, 987.65 rounded
b22b3e31 4023to tens (P=1) becomes 980, and rounded to the fourth sigdig
0716bf9b 4024becomes 987.6 (A=4). 123.456 rounded to the second place after the
b22b3e31 4025decimal point (P=-2) becomes 123.46.
0716bf9b
JH
4026
4027All other implemented styles of rounding attempt to round to the
4028"nearest digit." If the digit D immediately to the right of the
4029rounding place (skipping the decimal point) is greater than 5, the
4030number is incremented at the rounding place (possibly causing a
4031cascade of incrementation): e.g. when rounding to units, 0.9 rounds
4032to 1, and -19.9 rounds to -20. If D < 5, the number is similarly
4033truncated at the rounding place: e.g. when rounding to units, 0.4
4034rounds to 0, and -19.4 rounds to -19.
4035
4036However the results of other styles of rounding differ if the
4037digit immediately to the right of the rounding place (skipping the
4038decimal point) is 5 and if there are no digits, or no digits other
4039than 0, after that 5. In such cases:
4040
4041=item 'even'
4042
4043rounds the digit at the rounding place to 0, 2, 4, 6, or 8
4044if it is not already. E.g., when rounding to the first sigdig, 0.45
4045becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
4046
4047=item 'odd'
4048
4049rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if
4050it is not already. E.g., when rounding to the first sigdig, 0.45
4051becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6.
4052
4053=item '+inf'
4054
4055round to plus infinity, i.e. always round up. E.g., when
4056rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5,
b22b3e31 4057and 0.4501 also becomes 0.5.
0716bf9b
JH
4058
4059=item '-inf'
4060
4061round to minus infinity, i.e. always round down. E.g., when
4062rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6,
4063but 0.4501 becomes 0.5.
4064
4065=item 'zero'
4066
4067round to zero, i.e. positive numbers down, negative ones up.
4068E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
4069becomes -0.5, but 0.4501 becomes 0.5.
4070
7b29e1e6
T
4071=item 'common'
4072
4073round up if the digit immediately to the right of the rounding place
4074is 5 or greater, otherwise round down. E.g., 0.15 becomes 0.2 and
40750.149 becomes 0.1.
4076
0716bf9b
JH
4077=back
4078
4079The handling of A & P in MBI/MBF (the old core code shipped with Perl
4080versions <= 5.7.2) is like this:
4081
4082=over 2
a5f75d66 4083
0716bf9b
JH
4084=item Precision
4085
b22b3e31
PN
4086 * ffround($p) is able to round to $p number of digits after the decimal
4087 point
0716bf9b
JH
4088 * otherwise P is unused
4089
4090=item Accuracy (significant digits)
4091
4092 * fround($a) rounds to $a significant digits
4093 * only fdiv() and fsqrt() take A as (optional) paramater
b22b3e31 4094 + other operations simply create the same number (fneg etc), or more (fmul)
0716bf9b
JH
4095 of digits
4096 + rounding/truncating is only done when explicitly calling one of fround
4097 or ffround, and never for BigInt (not implemented)
b22b3e31 4098 * fsqrt() simply hands its accuracy argument over to fdiv.
0716bf9b
JH
4099 * the documentation and the comment in the code indicate two different ways
4100 on how fdiv() determines the maximum number of digits it should calculate,
4101 and the actual code does yet another thing
4102 POD:
4103 max($Math::BigFloat::div_scale,length(dividend)+length(divisor))
4104 Comment:
4105 result has at most max(scale, length(dividend), length(divisor)) digits
4106 Actual code:
4107 scale = max(scale, length(dividend)-1,length(divisor)-1);
3c4b39be 4108 scale += length(divisor) - length(dividend);
b22b3e31 4109 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3).
0716bf9b
JH
4110 Actually, the 'difference' added to the scale is calculated from the
4111 number of "significant digits" in dividend and divisor, which is derived
4112 by looking at the length of the mantissa. Which is wrong, since it includes
091c87b1 4113 the + sign (oops) and actually gets 2 for '+100' and 4 for '+101'. Oops
0716bf9b
JH
4114 again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
4115 assumption that 124 has 3 significant digits, while 120/7 will get you
4116 '17', not '17.1' since 120 is thought to have 2 significant digits.
dccbb853 4117 The rounding after the division then uses the remainder and $y to determine
0716bf9b 4118 wether it must round up or down.
b22b3e31
PN
4119 ? I have no idea which is the right way. That's why I used a slightly more
4120 ? simple scheme and tweaked the few failing testcases to match it.
58cde26e 4121
0716bf9b 4122=back
5dc6f178 4123
0716bf9b 4124This is how it works now:
5dc6f178 4125
0716bf9b 4126=over 2
5dc6f178 4127
0716bf9b
JH
4128=item Setting/Accessing
4129
091c87b1
T
4130 * You can set the A global via C<< Math::BigInt->accuracy() >> or
4131 C<< Math::BigFloat->accuracy() >> or whatever class you are using.
4132 * You can also set P globally by using C<< Math::SomeClass->precision() >>
4133 likewise.
0716bf9b 4134 * Globals are classwide, and not inherited by subclasses.
091c87b1
T
4135 * to undefine A, use C<< Math::SomeCLass->accuracy(undef); >>
4136 * to undefine P, use C<< Math::SomeClass->precision(undef); >>
4137 * Setting C<< Math::SomeClass->accuracy() >> clears automatically
4138 C<< Math::SomeClass->precision() >>, and vice versa.
0716bf9b 4139 * To be valid, A must be > 0, P can have any value.
b22b3e31
PN
4140 * If P is negative, this means round to the P'th place to the right of the
4141 decimal point; positive values mean to the left of the decimal point.
4142 P of 0 means round to integer.
091c87b1
T
4143 * to find out the current global A, use C<< Math::SomeClass->accuracy() >>
4144 * to find out the current global P, use C<< Math::SomeClass->precision() >>
4145 * use C<< $x->accuracy() >> respective C<< $x->precision() >> for the local
4146 setting of C<< $x >>.
3c4b39be 4147 * Please note that C<< $x->accuracy() >> respective C<< $x->precision() >>
091c87b1
T
4148 return eventually defined global A or P, when C<< $x >>'s A or P is not
4149 set.
0716bf9b
JH
4150
4151=item Creating numbers
4152
86b76201 4153 * When you create a number, you can give the desired A or P via:
b3abae2a
JH
4154 $x = Math::BigInt->new($number,$A,$P);
4155 * Only one of A or P can be defined, otherwise the result is NaN
4156 * If no A or P is give ($x = Math::BigInt->new($number) form), then the
4157 globals (if set) will be used. Thus changing the global defaults later on
b22b3e31 4158 will not change the A or P of previously created numbers (i.e., A and P of
b3abae2a
JH
4159 $x will be what was in effect when $x was created)
4160 * If given undef for A and P, B<no> rounding will occur, and the globals will
4161 B<not> be used. This is used by subclasses to create numbers without
86b76201 4162 suffering rounding in the parent. Thus a subclass is able to have its own
b3abae2a 4163 globals enforced upon creation of a number by using
091c87b1 4164 C<< $x = Math::BigInt->new($number,undef,undef) >>:
b3abae2a 4165
990fb837 4166 use Math::BigInt::SomeSubclass;
b3abae2a
JH
4167 use Math::BigInt;
4168
4169 Math::BigInt->accuracy(2);
4170 Math::BigInt::SomeSubClass->accuracy(3);
4171 $x = Math::BigInt::SomeSubClass->new(1234);
4172
4173 $x is now 1230, and not 1200. A subclass might choose to implement
4174 this otherwise, e.g. falling back to the parent's A and P.
0716bf9b
JH
4175
4176=item Usage
4177
b22b3e31 4178 * If A or P are enabled/defined, they are used to round the result of each
0716bf9b 4179 operation according to the rules below
b22b3e31
PN
4180 * Negative P is ignored in Math::BigInt, since BigInts never have digits
4181 after the decimal point
091c87b1
T
4182 * Math::BigFloat uses Math::BigInt internally, but setting A or P inside
4183 Math::BigInt as globals does not tamper with the parts of a BigFloat.
4184 A flag is used to mark all Math::BigFloat numbers as 'never round'.
0716bf9b
JH
4185
4186=item Precedence
4187
b22b3e31 4188 * It only makes sense that a number has only one of A or P at a time.
091c87b1
T
4189 If you set either A or P on one object, or globally, the other one will
4190 be automatically cleared.
b3abae2a
JH
4191 * If two objects are involved in an operation, and one of them has A in
4192 effect, and the other P, this results in an error (NaN).
3c4b39be 4193 * A takes precedence over P (Hint: A comes before P).
091c87b1
T
4194 If neither of them is defined, nothing is used, i.e. the result will have
4195 as many digits as it can (with an exception for fdiv/fsqrt) and will not
4196 be rounded.
b22b3e31
PN
4197 * There is another setting for fdiv() (and thus for fsqrt()). If neither of
4198 A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
4199 If either the dividend's or the divisor's mantissa has more digits than
4200 the value of F, the higher value will be used instead of F.
4201 This is to limit the digits (A) of the result (just consider what would
4202 happen with unlimited A and P in the case of 1/3 :-)
b3abae2a 4203 * fdiv will calculate (at least) 4 more digits than required (determined by
0716bf9b 4204 A, P or F), and, if F is not used, round the result
b22b3e31 4205 (this will still fail in the case of a result like 0.12345000000001 with A
574bacfe 4206 or P of 5, but this can not be helped - or can it?)
091c87b1 4207 * Thus you can have the math done by on Math::Big* class in two modi:
0716bf9b
JH
4208 + never round (this is the default):
4209 This is done by setting A and P to undef. No math operation
b22b3e31 4210 will round the result, with fdiv() and fsqrt() as exceptions to guard
3c4b39be 4211 against overflows. You must explicitly call bround(), bfround() or
b22b3e31
PN
4212 round() (the latter with parameters).
4213 Note: Once you have rounded a number, the settings will 'stick' on it
4214 and 'infect' all other numbers engaged in math operations with it, since
0716bf9b
JH
4215 local settings have the highest precedence. So, to get SaferRound[tm],
4216 use a copy() before rounding like this:
4217
4218 $x = Math::BigFloat->new(12.34);
4219 $y = Math::BigFloat->new(98.76);
4220 $z = $x * $y; # 1218.6984
4221 print $x->copy()->fround(3); # 12.3 (but A is now 3!)
4222 $z = $x * $y; # still 1218.6984, without
4223 # copy would have been 1210!
4224
4225 + round after each op:
b22b3e31
PN
4226 After each single operation (except for testing like is_zero()), the
4227 method round() is called and the result is rounded appropriately. By
0716bf9b 4228 setting proper values for A and P, you can have all-the-same-A or
b22b3e31
PN
4229 all-the-same-P modes. For example, Math::Currency might set A to undef,
4230 and P to -2, globally.
0716bf9b 4231
b22b3e31
PN
4232 ?Maybe an extra option that forbids local A & P settings would be in order,
4233 ?so that intermediate rounding does not 'poison' further math?
0716bf9b
JH
4234
4235=item Overriding globals
4236
4237 * you will be able to give A, P and R as an argument to all the calculation
b22b3e31 4238 routines; the second parameter is A, the third one is P, and the fourth is
b3abae2a 4239 R (shift right by one for binary operations like badd). P is used only if
b22b3e31
PN
4240 the first parameter (A) is undefined. These three parameters override the
4241 globals in the order detailed as follows, i.e. the first defined value
0716bf9b 4242 wins:
b22b3e31 4243 (local: per object, global: global default, parameter: argument to sub)
0716bf9b
JH
4244 + parameter A
4245 + parameter P
4246 + local A (if defined on both of the operands: smaller one is taken)
b3abae2a 4247 + local P (if defined on both of the operands: bigger one is taken)
0716bf9b
JH
4248 + global A
4249 + global P
4250 + global F
b22b3e31 4251 * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
0716bf9b
JH
4252 arguments (A and P) instead of one
4253
4254=item Local settings
4255
091c87b1
T
4256 * You can set A or P locally by using C<< $x->accuracy() >> or
4257 C<< $x->precision() >>
0716bf9b 4258 and thus force different A and P for different objects/numbers.
b22b3e31 4259 * Setting A or P this way immediately rounds $x to the new value.
091c87b1 4260 * C<< $x->accuracy() >> clears C<< $x->precision() >>, and vice versa.
0716bf9b
JH
4261
4262=item Rounding
4263
b22b3e31 4264 * the rounding routines will use the respective global or local settings.
0716bf9b
JH
4265 fround()/bround() is for accuracy rounding, while ffround()/bfround()
4266 is for precision
4267 * the two rounding functions take as the second parameter one of the
4268 following rounding modes (R):
7b29e1e6 4269 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', 'common'
091c87b1
T
4270 * you can set/get the global R by using C<< Math::SomeClass->round_mode() >>
4271 or by setting C<< $Math::SomeClass::round_mode >>
4272 * after each operation, C<< $result->round() >> is called, and the result may
b22b3e31
PN
4273 eventually be rounded (that is, if A or P were set either locally,
4274 globally or as parameter to the operation)
091c87b1 4275 * to manually round a number, call C<< $x->round($A,$P,$round_mode); >>
b22b3e31 4276 this will round the number by using the appropriate rounding function
0716bf9b 4277 and then normalize it.
b22b3e31 4278 * rounding modifies the local settings of the number:
0716bf9b
JH
4279
4280 $x = Math::BigFloat->new(123.456);
4281 $x->accuracy(5);
4282 $x->bround(4);
4283
4284 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy()
4285 will be 4 from now on.
4286
4287=item Default values
4288
4289 * R: 'even'
4290 * F: 40
4291 * A: undef
4292 * P: undef
4293
4294=item Remarks
4295
4296 * The defaults are set up so that the new code gives the same results as
4297 the old code (except in a few cases on fdiv):
4298 + Both A and P are undefined and thus will not be used for rounding
4299 after each operation.
4300 + round() is thus a no-op, unless given extra parameters A and P
58cde26e
JH
4301
4302=back
4303
b68b7ab1
T
4304=head1 Infinity and Not a Number
4305
4306While BigInt has extensive handling of inf and NaN, certain quirks remain.
4307
4308=over 2
4309
4310=item oct()/hex()
4311
4312These perl routines currently (as of Perl v.5.8.6) cannot handle passed
4313inf.
4314
4315 te@linux:~> perl -wle 'print 2 ** 3333'
4316 inf
4317 te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
4318 1
4319 te@linux:~> perl -wle 'print oct(2 ** 3333)'
4320 0
4321 te@linux:~> perl -wle 'print hex(2 ** 3333)'
4322 Illegal hexadecimal digit 'i' ignored at -e line 1.
4323 0
4324
4325The same problems occur if you pass them Math::BigInt->binf() objects. Since
4326overloading these routines is not possible, this cannot be fixed from BigInt.
4327
4328=item ==, !=, <, >, <=, >= with NaNs
4329
4330BigInt's bcmp() routine currently returns undef to signal that a NaN was
3c4b39be 4331involved in a comparison. However, the overload code turns that into
b68b7ab1
T
4332either 1 or '' and thus operations like C<< NaN != NaN >> might return
4333wrong values.
4334
4335=item log(-inf)
4336
4337C<< log(-inf) >> is highly weird. Since log(-x)=pi*i+log(x), then
4338log(-inf)=pi*i+inf. However, since the imaginary part is finite, the real
4339infinity "overshadows" it, so the number might as well just be infinity.
4340However, the result is a complex number, and since BigInt/BigFloat can only
4341have real numbers as results, the result is NaN.
4342
4343=item exp(), cos(), sin(), atan2()
4344
4345These all might have problems handling infinity right.
4346
4347=back
4348
0716bf9b
JH
4349=head1 INTERNALS
4350
574bacfe 4351The actual numbers are stored as unsigned big integers (with seperate sign).
b68b7ab1 4352
574bacfe 4353You should neither care about nor depend on the internal representation; it
b68b7ab1
T
4354might change without notice. Use B<ONLY> method calls like C<< $x->sign(); >>
4355instead relying on the internal representation.
574bacfe
JH
4356
4357=head2 MATH LIBRARY
58cde26e 4358
574bacfe 4359Math with the numbers is done (by default) by a module called
091c87b1 4360C<Math::BigInt::Calc>. This is equivalent to saying:
574bacfe
JH
4361
4362 use Math::BigInt lib => 'Calc';
58cde26e 4363
0716bf9b 4364You can change this by using:
58cde26e 4365
0716bf9b 4366 use Math::BigInt lib => 'BitVect';
58cde26e 4367
574bacfe
JH
4368The following would first try to find Math::BigInt::Foo, then
4369Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
0716bf9b 4370
574bacfe 4371 use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
58cde26e 4372
091c87b1 4373Since Math::BigInt::GMP is in almost all cases faster than Calc (especially in
b68b7ab1 4374math involving really big numbers, where it is B<much> faster), and there is
091c87b1
T
4375no penalty if Math::BigInt::GMP is not installed, it is a good idea to always
4376use the following:
4377
4378 use Math::BigInt lib => 'GMP';
4379
4380Different low-level libraries use different formats to store the
b68b7ab1
T
4381numbers. You should B<NOT> depend on the number having a specific format
4382internally.
091c87b1
T
4383
4384See the respective math library module documentation for further details.
58cde26e 4385
574bacfe
JH
4386=head2 SIGN
4387
b68b7ab1 4388The sign is either '+', '-', 'NaN', '+inf' or '-inf'.
574bacfe
JH
4389
4390A sign of 'NaN' is used to represent the result when input arguments are not
4391numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
4392minus infinity. You will get '+inf' when dividing a positive number by 0, and
4393'-inf' when dividing any negative number by 0.
58cde26e
JH
4394
4395=head2 mantissa(), exponent() and parts()
4396
4397C<mantissa()> and C<exponent()> return the said parts of the BigInt such
4398that:
4399
4400 $m = $x->mantissa();
4401 $e = $x->exponent();
4402 $y = $m * ( 10 ** $e );
4403 print "ok\n" if $x == $y;
4404
b22b3e31
PN
4405C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
4406in one go. Both the returned mantissa and exponent have a sign.
58cde26e 4407
7b29e1e6
T
4408Currently, for BigInts C<$e> is always 0, except +inf and -inf, where it is
4409C<+inf>; and for NaN, where it is C<NaN>; and for C<$x == 0>, where it is C<1>
4410(to be compatible with Math::BigFloat's internal representation of a zero as
4411C<0E1>).
58cde26e 4412
091c87b1
T
4413C<$m> is currently just a copy of the original number. The relation between
4414C<$e> and C<$m> will stay always the same, though their real values might
4415change.
0716bf9b 4416
58cde26e
JH
4417=head1 EXAMPLES
4418
394e6ffb 4419 use Math::BigInt;
574bacfe
JH
4420
4421 sub bint { Math::BigInt->new(shift); }
4422
394e6ffb 4423 $x = Math::BigInt->bstr("1234") # string "1234"
58cde26e 4424 $x = "$x"; # same as bstr()
990fb837
RGS
4425 $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
4426 $x = Math::BigInt->babs("-12345"); # BigInt "12345"
7b29e1e6 4427 $x = Math::BigInt->bnorm("-0.00"); # BigInt "0"
58cde26e
JH
4428 $x = bint(1) + bint(2); # BigInt "3"
4429 $x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
4430 $x = bint(1); # BigInt "1"
4431 $x = $x + 5 / 2; # BigInt "3"
4432 $x = $x ** 3; # BigInt "27"
4433 $x *= 2; # BigInt "54"
394e6ffb 4434 $x = Math::BigInt->new(0); # BigInt "0"
58cde26e
JH
4435 $x--; # BigInt "-1"
4436 $x = Math::BigInt->badd(4,5) # BigInt "9"
58cde26e 4437 print $x->bsstr(); # 9e+0
a5f75d66 4438
0716bf9b
JH
4439Examples for rounding:
4440
4441 use Math::BigFloat;
4442 use Test;
4443
4444 $x = Math::BigFloat->new(123.4567);
4445 $y = Math::BigFloat->new(123.456789);
394e6ffb 4446 Math::BigFloat->accuracy(4); # no more A than 4
0716bf9b
JH
4447
4448 ok ($x->copy()->fround(),123.4); # even rounding
4449 print $x->copy()->fround(),"\n"; # 123.4
4450 Math::BigFloat->round_mode('odd'); # round to odd
4451 print $x->copy()->fround(),"\n"; # 123.5
394e6ffb 4452 Math::BigFloat->accuracy(5); # no more A than 5
0716bf9b
JH
4453 Math::BigFloat->round_mode('odd'); # round to odd
4454 print $x->copy()->fround(),"\n"; # 123.46
4455 $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
4456 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
4457
394e6ffb
JH
4458 Math::BigFloat->accuracy(undef); # A not important now
4459 Math::BigFloat->precision(2); # P important
4460 print $x->copy()->bnorm(),"\n"; # 123.46
4461 print $x->copy()->fround(),"\n"; # 123.46
0716bf9b 4462
bd05a461
JH
4463Examples for converting:
4464
4465 my $x = Math::BigInt->new('0b1'.'01' x 123);
4466 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
4467
b3ac6de7
IZ
4468=head1 Autocreating constants
4469
56b9c951
JH
4470After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
4471and binary constants in the given scope are converted to C<Math::BigInt>.
4472This conversion happens at compile time.
b3ac6de7 4473
b22b3e31 4474In particular,
b3ac6de7 4475
58cde26e
JH
4476 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
4477
56b9c951 4478prints the integer value of C<2**100>. Note that without conversion of
0716bf9b 4479constants the expression 2**100 will be calculated as perl scalar.
58cde26e
JH
4480
4481Please note that strings and floating point constants are not affected,
4482so that
4483
4484 use Math::BigInt qw/:constant/;
4485
4486 $x = 1234567890123456789012345678901234567890
4487 + 123456789123456789;
b22b3e31 4488 $y = '1234567890123456789012345678901234567890'
58cde26e 4489 + '123456789123456789';
b3ac6de7 4490
b22b3e31 4491do not work. You need an explicit Math::BigInt->new() around one of the
394e6ffb
JH
4492operands. You should also quote large constants to protect loss of precision:
4493
990fb837 4494 use Math::BigInt;
394e6ffb
JH
4495
4496 $x = Math::BigInt->new('1234567889123456789123456789123456789');
4497
4498Without the quotes Perl would convert the large number to a floating point
4499constant at compile time and then hand the result to BigInt, which results in
4500an truncated result or a NaN.
58cde26e 4501
56b9c951
JH
4502This also applies to integers that look like floating point constants:
4503
4504 use Math::BigInt ':constant';
4505
4506 print ref(123e2),"\n";
4507 print ref(123.2e2),"\n";
4508
4509will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
4510to get this to work.
4511
58cde26e
JH
4512=head1 PERFORMANCE
4513
4514Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x
4515must be made in the second case. For long numbers, the copy can eat up to 20%
b22b3e31 4516of the work (in the case of addition/subtraction, less for
58cde26e
JH
4517multiplication/division). If $y is very small compared to $x, the form
4518$x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes
4519more time then the actual addition.
4520
b22b3e31 4521With a technique called copy-on-write, the cost of copying with overload could
394e6ffb
JH
4522be minimized or even completely avoided. A test implementation of COW did show
4523performance gains for overloaded math, but introduced a performance loss due
3c4b39be 4524to a constant overhead for all other operations. So Math::BigInt does currently
091c87b1 4525not COW.
394e6ffb 4526
091c87b1
T
4527The rewritten version of this module (vs. v0.01) is slower on certain
4528operations, like C<new()>, C<bstr()> and C<numify()>. The reason are that it
4529does now more work and handles much more cases. The time spent in these
4530operations is usually gained in the other math operations so that code on
4531the average should get (much) faster. If they don't, please contact the author.
58cde26e 4532
394e6ffb 4533Some operations may be slower for small numbers, but are significantly faster
091c87b1
T
4534for big numbers. Other operations are now constant (O(1), like C<bneg()>,
4535C<babs()> etc), instead of O(N) and thus nearly always take much less time.
4536These optimizations were done on purpose.
58cde26e 4537
574bacfe
JH
4538If you find the Calc module to slow, try to install any of the replacement
4539modules and see if they help you.
b3ac6de7 4540
574bacfe 4541=head2 Alternative math libraries
0716bf9b
JH
4542
4543You can use an alternative library to drive Math::BigInt via:
4544
4545 use Math::BigInt lib => 'Module';
4546
394e6ffb 4547See L<MATH LIBRARY> for more information.
0716bf9b 4548
394e6ffb 4549For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
574bacfe 4550
b3abae2a
JH
4551=head2 SUBCLASSING
4552
4553=head1 Subclassing Math::BigInt
4554
4555The basic design of Math::BigInt allows simple subclasses with very little
4556work, as long as a few simple rules are followed:
4557
4558=over 2
4559
4560=item *
4561
4562The public API must remain consistent, i.e. if a sub-class is overloading
4563addition, the sub-class must use the same name, in this case badd(). The
4564reason for this is that Math::BigInt is optimized to call the object methods
4565directly.
4566
4567=item *
4568
4569The private object hash keys like C<$x->{sign}> may not be changed, but
4570additional keys can be added, like C<$x->{_custom}>.
4571
4572=item *
4573
4574Accessor functions are available for all existing object hash keys and should
4575be used instead of directly accessing the internal hash keys. The reason for
4576this is that Math::BigInt itself has a pluggable interface which permits it
4577to support different storage methods.
4578
4579=back
4580
4581More complex sub-classes may have to replicate more of the logic internal of
4582Math::BigInt if they need to change more basic behaviors. A subclass that
4583needs to merely change the output only needs to overload C<bstr()>.
4584
4585All other object methods and overloaded functions can be directly inherited
4586from the parent class.
4587
86b76201 4588At the very minimum, any subclass will need to provide its own C<new()> and can
b3abae2a
JH
4589store additional hash keys in the object. There are also some package globals
4590that must be defined, e.g.:
4591
4592 # Globals
4593 $accuracy = undef;
4594 $precision = -2; # round to 2 decimal places
4595 $round_mode = 'even';
4596 $div_scale = 40;
4597
4598Additionally, you might want to provide the following two globals to allow
4599auto-upgrading and auto-downgrading to work correctly:
4600
4601 $upgrade = undef;
4602 $downgrade = undef;
4603
4604This allows Math::BigInt to correctly retrieve package globals from the
4605subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
4606t/Math/BigFloat/SubClass.pm completely functional subclass examples.
4607
4608Don't forget to
4609
4610 use overload;
4611
4612in your subclass to automatically inherit the overloading from the parent. If
4613you like, you can change part of the overloading, look at Math::String for an
4614example.
4615
4616=head1 UPGRADING
4617
4618When used like this:
4619
4620 use Math::BigInt upgrade => 'Foo::Bar';
4621
4622certain operations will 'upgrade' their calculation and thus the result to
4623the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
4624
4625 use Math::BigInt upgrade => 'Math::BigFloat';
4626
4627As a shortcut, you can use the module C<bignum>:
4628
4629 use bignum;
4630
4631Also good for oneliners:
4632
4633 perl -Mbignum -le 'print 2 ** 255'
4634
4635This makes it possible to mix arguments of different classes (as in 2.5 + 2)
4636as well es preserve accuracy (as in sqrt(3)).
4637
4638Beware: This feature is not fully implemented yet.
4639
4640=head2 Auto-upgrade
4641
4642The following methods upgrade themselves unconditionally; that is if upgrade
4643is in effect, they will always hand up their work:
4644
4645=over 2
4646
4647=item bsqrt()
4648
4649=item div()
4650
4651=item blog()
4652
7d193e39
T
4653=item bexp()
4654
b3abae2a
JH
4655=back
4656
4657Beware: This list is not complete.
4658
4659All other methods upgrade themselves only when one (or all) of their
4660arguments are of the class mentioned in $upgrade (This might change in later
4661versions to a more sophisticated scheme):
4662
fdb4b05f
T
4663=head1 EXPORTS
4664
4665C<Math::BigInt> exports nothing by default, but can export the following methods:
4666
4667 bgcd
4668 blcm
4669
58cde26e
JH
4670=head1 CAVEATS
4671
4672Some things might not work as you expect them. Below is documented what is
4673known to be troublesome:
4674
4675=over 1
4676
091c87b1 4677=item bstr(), bsstr() and 'cmp'
58cde26e 4678
091c87b1
T
4679Both C<bstr()> and C<bsstr()> as well as automated stringify via overload now
4680drop the leading '+'. The old code would return '+3', the new returns '3'.
4681This is to be consistent with Perl and to make C<cmp> (especially with
4682overloading) to work as you expect. It also solves problems with C<Test.pm>,
86b76201 4683because its C<ok()> uses 'eq' internally.
58cde26e 4684
091c87b1
T
4685Mark Biggar said, when asked about to drop the '+' altogether, or make only
4686C<cmp> work:
58cde26e
JH
4687
4688 I agree (with the first alternative), don't add the '+' on positive
4689 numbers. It's not as important anymore with the new internal
4690 form for numbers. It made doing things like abs and neg easier,
4691 but those have to be done differently now anyway.
4692
4693So, the following examples will now work all as expected:
4694
4695 use Test;
4696 BEGIN { plan tests => 1 }
4697 use Math::BigInt;
4698
4699 my $x = new Math::BigInt 3*3;
4700 my $y = new Math::BigInt 3*3;
4701
4702 ok ($x,3*3);
4703 print "$x eq 9" if $x eq $y;
4704 print "$x eq 9" if $x eq '9';
4705 print "$x eq 9" if $x eq 3*3;
4706
4707Additionally, the following still works:
4708
4709 print "$x == 9" if $x == $y;
4710 print "$x == 9" if $x == 9;
4711 print "$x == 9" if $x == 3*3;
4712
4713There is now a C<bsstr()> method to get the string in scientific notation aka
4714C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
3c4b39be 4715for comparison, but Perl will represent some numbers as 100 and others
091c87b1
T
4716as 1e+308. If in doubt, convert both arguments to Math::BigInt before
4717comparing them as strings:
58cde26e
JH
4718
4719 use Test;
4720 BEGIN { plan tests => 3 }
4721 use Math::BigInt;
4722
4723 $x = Math::BigInt->new('1e56'); $y = 1e56;
4724 ok ($x,$y); # will fail
4725 ok ($x->bsstr(),$y); # okay
4726 $y = Math::BigInt->new($y);
4727 ok ($x,$y); # okay
4728
3c4b39be 4729Alternatively, simple use C<< <=> >> for comparisons, this will get it
091c87b1
T
4730always right. There is not yet a way to get a number automatically represented
4731as a string that matches exactly the way Perl represents it.
574bacfe 4732
b68b7ab1
T
4733See also the section about L<Infinity and Not a Number> for problems in
4734comparing NaNs.
4735
58cde26e
JH
4736=item int()
4737
4738C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
4739Perl scalar:
4740
4741 $x = Math::BigInt->new(123);
4742 $y = int($x); # BigInt 123
4743 $x = Math::BigFloat->new(123.45);
4744 $y = int($x); # BigInt 123
4745
b68b7ab1
T
4746In all Perl versions you can use C<as_number()> or C<as_int> for the same
4747effect:
58cde26e
JH
4748
4749 $x = Math::BigFloat->new(123.45);
4750 $y = $x->as_number(); # BigInt 123
b68b7ab1 4751 $y = $x->as_int(); # ditto
58cde26e
JH
4752
4753This also works for other subclasses, like Math::String.
4754
b68b7ab1
T
4755If you want a real Perl scalar, use C<numify()>:
4756
4757 $y = $x->numify(); # 123 as scalar
4758
4759This is seldom necessary, though, because this is done automatically, like
4760when you access an array:
4761
4762 $z = $array[$x]; # does work automatically
4763
dccbb853 4764=item length
58cde26e
JH
4765
4766The following will probably not do what you expect:
4767
bd05a461
JH
4768 $c = Math::BigInt->new(123);
4769 print $c->length(),"\n"; # prints 30
4770
4771It prints both the number of digits in the number and in the fraction part
4772since print calls C<length()> in list context. Use something like:
4773
4774 print scalar $c->length(),"\n"; # prints 3
4775
4776=item bdiv
4777
4778The following will probably not do what you expect:
4779
58cde26e
JH
4780 print $c->bdiv(10000),"\n";
4781
dccbb853 4782It prints both quotient and remainder since print calls C<bdiv()> in list
3c4b39be 4783context. Also, C<bdiv()> will modify $c, so be careful. You probably want
58cde26e
JH
4784to use
4785
4786 print $c / 10000,"\n";
4787 print scalar $c->bdiv(10000),"\n"; # or if you want to modify $c
4788
4789instead.
4790
4791The quotient is always the greatest integer less than or equal to the
4792real-valued quotient of the two operands, and the remainder (when it is
4793nonzero) always has the same sign as the second operand; so, for
4794example,
4795
dccbb853
JH
4796 1 / 4 => ( 0, 1)
4797 1 / -4 => (-1,-3)
4798 -3 / 4 => (-1, 1)
4799 -3 / -4 => ( 0,-3)
4800 -11 / 2 => (-5,1)
4801 11 /-2 => (-5,-1)
58cde26e
JH
4802
4803As a consequence, the behavior of the operator % agrees with the
4804behavior of Perl's built-in % operator (as documented in the perlop
4805manpage), and the equation
4806
4807 $x == ($x / $y) * $y + ($x % $y)
4808
4809holds true for any $x and $y, which justifies calling the two return
dccbb853
JH
4810values of bdiv() the quotient and remainder. The only exception to this rule
4811are when $y == 0 and $x is negative, then the remainder will also be
3c4b39be 4812negative. See below under "infinity handling" for the reasoning behind this.
58cde26e
JH
4813
4814Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
4815not change BigInt's way to do things. This is because under 'use integer' Perl
4816will do what the underlying C thinks is right and this is different for each
4817system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
4818the author to implement it ;)
4819
dccbb853
JH
4820=item infinity handling
4821
4822Here are some examples that explain the reasons why certain results occur while
4823handling infinity:
4824
4825The following table shows the result of the division and the remainder, so that
4826the equation above holds true. Some "ordinary" cases are strewn in to show more
4827clearly the reasoning:
4828
4829 A / B = C, R so that C * B + R = A
4830 =========================================================
4831 5 / 8 = 0, 5 0 * 8 + 5 = 5
4832 0 / 8 = 0, 0 0 * 8 + 0 = 0
4833 0 / inf = 0, 0 0 * inf + 0 = 0
4834 0 /-inf = 0, 0 0 * -inf + 0 = 0
4835 5 / inf = 0, 5 0 * inf + 5 = 5
4836 5 /-inf = 0, 5 0 * -inf + 5 = 5
4837 -5/ inf = 0, -5 0 * inf + -5 = -5
4838 -5/-inf = 0, -5 0 * -inf + -5 = -5
4839 inf/ 5 = inf, 0 inf * 5 + 0 = inf
4840 -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
4841 inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
4842 -inf/ -5 = inf, 0 inf * -5 + 0 = -inf
4843 5/ 5 = 1, 0 1 * 5 + 0 = 5
4844 -5/ -5 = 1, 0 1 * -5 + 0 = -5
4845 inf/ inf = 1, 0 1 * inf + 0 = inf
4846 -inf/-inf = 1, 0 1 * -inf + 0 = -inf
4847 inf/-inf = -1, 0 -1 * -inf + 0 = inf
4848 -inf/ inf = -1, 0 1 * -inf + 0 = -inf
4849 8/ 0 = inf, 8 inf * 0 + 8 = 8
4850 inf/ 0 = inf, inf inf * 0 + inf = inf
4851 0/ 0 = NaN
4852
4853These cases below violate the "remainder has the sign of the second of the two
4854arguments", since they wouldn't match up otherwise.
4855
4856 A / B = C, R so that C * B + R = A
4857 ========================================================
4858 -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
4859 -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
4860
58cde26e
JH
4861=item Modifying and =
4862
4863Beware of:
4864
4865 $x = Math::BigFloat->new(5);
4866 $y = $x;
4867
4868It will not do what you think, e.g. making a copy of $x. Instead it just makes
4869a second reference to the B<same> object and stores it in $y. Thus anything
17baacb7
JH
4870that modifies $x (except overloaded operators) will modify $y, and vice versa.
4871Or in other words, C<=> is only safe if you modify your BigInts only via
4872overloaded math. As soon as you use a method call it breaks:
58cde26e
JH
4873
4874 $x->bmul(2);
4875 print "$x, $y\n"; # prints '10, 10'
4876
4877If you want a true copy of $x, use:
4878
4879 $y = $x->copy();
4880
17baacb7
JH
4881You can also chain the calls like this, this will make first a copy and then
4882multiply it by 2:
4883
4884 $y = $x->copy()->bmul(2);
4885
b22b3e31 4886See also the documentation for overload.pm regarding C<=>.
58cde26e
JH
4887
4888=item bpow
4889
4890C<bpow()> (and the rounding functions) now modifies the first argument and
574bacfe 4891returns it, unlike the old code which left it alone and only returned the
58cde26e
JH
4892result. This is to be consistent with C<badd()> etc. The first three will
4893modify $x, the last one won't:
4894
4895 print bpow($x,$i),"\n"; # modify $x
4896 print $x->bpow($i),"\n"; # ditto
4897 print $x **= $i,"\n"; # the same
4898 print $x ** $i,"\n"; # leave $x alone
4899
4900The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
4901
4902=item Overloading -$x
4903
4904The following:
4905
4906 $x = -$x;
4907
4908is slower than
4909
4910 $x->bneg();
4911
4912since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
4913needs to preserve $x since it does not know that it later will get overwritten.
0716bf9b 4914This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
58cde26e 4915
58cde26e
JH
4916=item Mixing different object types
4917
4918In Perl you will get a floating point value if you do one of the following:
4919
4920 $float = 5.0 + 2;
4921 $float = 2 + 5.0;
4922 $float = 5 / 2;
4923
4924With overloaded math, only the first two variants will result in a BigFloat:
4925
4926 use Math::BigInt;
4927 use Math::BigFloat;
4928
4929 $mbf = Math::BigFloat->new(5);
4930 $mbi2 = Math::BigInteger->new(5);
4931 $mbi = Math::BigInteger->new(2);
4932
4933 # what actually gets called:
4934 $float = $mbf + $mbi; # $mbf->badd()
4935 $float = $mbf / $mbi; # $mbf->bdiv()
4936 $integer = $mbi + $mbf; # $mbi->badd()
4937 $integer = $mbi2 / $mbi; # $mbi2->bdiv()
4938 $integer = $mbi2 / $mbf; # $mbi2->bdiv()
4939
4940This is because math with overloaded operators follows the first (dominating)
394e6ffb 4941operand, and the operation of that is called and returns thus the result. So,
58cde26e
JH
4942Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
4943the result should be a Math::BigFloat or the second operant is one.
4944
4945To get a Math::BigFloat you either need to call the operation manually,
4946make sure the operands are already of the proper type or casted to that type
4947via Math::BigFloat->new():
4948
4949 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
4950
4951Beware of simple "casting" the entire expression, this would only convert
4952the already computed result:
4953
4954 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
4955
0716bf9b 4956Beware also of the order of more complicated expressions like:
58cde26e
JH
4957
4958 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
4959 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
4960
4961If in doubt, break the expression into simpler terms, or cast all operands
4962to the desired resulting type.
4963
4964Scalar values are a bit different, since:
4965
4966 $float = 2 + $mbf;
4967 $float = $mbf + 2;
4968
4969will both result in the proper type due to the way the overloaded math works.
4970
4971This section also applies to other overloaded math packages, like Math::String.
4972
990fb837
RGS
4973One solution to you problem might be autoupgrading|upgrading. See the
4974pragmas L<bignum>, L<bigint> and L<bigrat> for an easy way to do this.
b3abae2a 4975
58cde26e
JH
4976=item bsqrt()
4977
394e6ffb 4978C<bsqrt()> works only good if the result is a big integer, e.g. the square
58cde26e 4979root of 144 is 12, but from 12 the square root is 3, regardless of rounding
990fb837 4980mode. The reason is that the result is always truncated to an integer.
58cde26e
JH
4981
4982If you want a better approximation of the square root, then use:
4983
4984 $x = Math::BigFloat->new(12);
394e6ffb 4985 Math::BigFloat->precision(0);
58cde26e
JH
4986 Math::BigFloat->round_mode('even');
4987 print $x->copy->bsqrt(),"\n"; # 4
4988
394e6ffb 4989 Math::BigFloat->precision(2);
58cde26e
JH
4990 print $x->bsqrt(),"\n"; # 3.46
4991 print $x->bsqrt(3),"\n"; # 3.464
4992
b3abae2a
JH
4993=item brsft()
4994
4995For negative numbers in base see also L<brsft|brsft>.
4996
58cde26e
JH
4997=back
4998
4999=head1 LICENSE
5000
5001This program is free software; you may redistribute it and/or modify it under
5002the same terms as Perl itself.
a5f75d66 5003
0716bf9b
JH
5004=head1 SEE ALSO
5005
990fb837
RGS
5006L<Math::BigFloat>, L<Math::BigRat> and L<Math::Big> as well as
5007L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
5008
5009The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest
5010because they solve the autoupgrading/downgrading issue, at least partly.
0716bf9b 5011
027dc388
JH
5012The package at
5013L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
5014more documentation including a full version history, testcases, empty
5015subclass files and benchmarks.
574bacfe 5016
58cde26e 5017=head1 AUTHORS
a5f75d66 5018
58cde26e 5019Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
7b29e1e6
T
5020Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2006
5021and still at it in 2007.
990fb837
RGS
5022
5023Many people contributed in one or more ways to the final beast, see the file
3c4b39be 5024CREDITS for an (incomplete) list. If you miss your name, please drop me a
990fb837 5025mail. Thank you!
a5f75d66
AD
5026
5027=cut