ensure that utf8 Perl code magically called from a regex localizes $.
[p5sagit/p5-mst-13.2.git] / lib / Math / BigRat.pm
CommitLineData
a4e2b1c6 1
2#
7d341013 3# "Tax the rat farms." - Lord Vetinari
a4e2b1c6 4#
184f15d5 5
6# The following hash values are used:
7# sign : +,-,NaN,+inf,-inf
8# _d : denominator
9# _n : numeraotr (value = _n/_d)
10# _a : accuracy
11# _p : precision
b1f79218 12# _f : flags, used by MBR to flag parts of a rational as untouchable
7afd7a91 13# You should not look at the innards of a BigRat - use the methods for this.
184f15d5 14
15package Math::BigRat;
16
a4e2b1c6 17require 5.005_03;
184f15d5 18use strict;
19
7afd7a91 20require Exporter;
184f15d5 21use Math::BigFloat;
9b924220 22use vars qw($VERSION @ISA $PACKAGE $upgrade $downgrade
990fb837 23 $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
184f15d5 24
25@ISA = qw(Exporter Math::BigFloat);
184f15d5 26
9b924220 27$VERSION = '0.12';
184f15d5 28
990fb837 29use overload; # inherit from Math::BigFloat
184f15d5 30
9b924220 31BEGIN { *objectify = \&Math::BigInt::objectify; }
32
184f15d5 33##############################################################################
34# global constants, flags and accessory
35
184f15d5 36$accuracy = $precision = undef;
37$round_mode = 'even';
38$div_scale = 40;
39$upgrade = undef;
40$downgrade = undef;
41
990fb837 42# these are internally, and not to be used from the outside
43
44use constant MB_NEVER_ROUND => 0x0001;
45
46$_trap_nan = 0; # are NaNs ok? set w/ config()
47$_trap_inf = 0; # are infs ok? set w/ config()
48
184f15d5 49my $nan = 'NaN';
6de7f0cc 50my $MBI = 'Math::BigInt';
9b924220 51my $CALC = 'Math::BigInt::Calc';
52my $class = 'Math::BigRat';
53my $IMPORT = 0;
184f15d5 54
8f675a64 55sub isa
56 {
57 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
58 UNIVERSAL::isa(@_);
59 }
60
9b924220 61sub BEGIN
62 {
63 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD;
64 }
65
184f15d5 66sub _new_from_float
67 {
7afd7a91 68 # turn a single float input into a rational number (like '0.1')
184f15d5 69 my ($self,$f) = @_;
70
71 return $self->bnan() if $f->is_nan();
9b924220 72 return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
184f15d5 73
9b924220 74 local $Math::BigInt::accuracy = undef;
75 local $Math::BigInt::precision = undef;
76 $self->{_n} = $MBI->new($CALC->_str ( $f->{_m} ),undef,undef);# mantissa
6de7f0cc 77 $self->{_d} = $MBI->bone();
9b924220 78 $self->{sign} = $f->{sign} || '+';
79 if ($f->{_es} eq '-')
184f15d5 80 {
81 # something like Math::BigRat->new('0.1');
9b924220 82 # 1 / 1 => 1/10
83 $self->{_d}->blsft( $MBI->new($CALC->_str ( $f->{_e} )),10);
184f15d5 84 }
85 else
86 {
87 # something like Math::BigRat->new('10');
88 # 1 / 1 => 10/1
9b924220 89 $self->{_n}->blsft( $MBI->new($CALC->_str($f->{_e})),10) unless
90 $CALC->_is_zero($f->{_e});
184f15d5 91 }
184f15d5 92 $self;
93 }
94
95sub new
96 {
97 # create a Math::BigRat
98 my $class = shift;
99
100 my ($n,$d) = shift;
101
102 my $self = { }; bless $self,$class;
103
184f15d5 104 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
105
6de7f0cc 106 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
184f15d5 107 {
184f15d5 108 if ($n->isa('Math::BigFloat'))
109 {
7afd7a91 110 $self->_new_from_float($n);
184f15d5 111 }
112 if ($n->isa('Math::BigInt'))
113 {
990fb837 114 # TODO: trap NaN, inf
8f675a64 115 $self->{_n} = $n->copy(); # "mantissa" = $n
6de7f0cc 116 $self->{_d} = $MBI->bone();
8f675a64 117 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
8f675a64 118 }
119 if ($n->isa('Math::BigInt::Lite'))
120 {
990fb837 121 # TODO: trap NaN, inf
122 $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
123 $self->{_n} = $MBI->new(abs($$n),undef,undef); # "mantissa" = $n
6de7f0cc 124 $self->{_d} = $MBI->bone();
184f15d5 125 }
7afd7a91 126 return $self->bnorm();
184f15d5 127 }
128 return $n->copy() if ref $n;
184f15d5 129
130 if (!defined $n)
131 {
7d341013 132 $self->{_n} = $MBI->bzero(); # undef => 0
6de7f0cc 133 $self->{_d} = $MBI->bone();
184f15d5 134 $self->{sign} = '+';
135 return $self->bnorm();
136 }
137 # string input with / delimiter
138 if ($n =~ /\s*\/\s*/)
139 {
990fb837 140 return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
141 return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
184f15d5 142 ($n,$d) = split (/\//,$n);
143 # try as BigFloats first
144 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
145 {
146 # one of them looks like a float
7d341013 147 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
148 local $Math::BigFloat::accuracy = undef;
149 local $Math::BigFloat::precision = undef;
150 local $Math::BigInt::accuracy = undef;
151 local $Math::BigInt::precision = undef;
9b924220 152
153 my $nf = Math::BigFloat->new($n,undef,undef);
990fb837 154 $self->{sign} = '+';
155 return $self->bnan() if $nf->is_nan();
9b924220 156 $self->{_n} = $MBI->new( $CALC->_str( $nf->{_m} ) );
157
184f15d5 158 # now correct $self->{_n} due to $n
7d341013 159 my $f = Math::BigFloat->new($d,undef,undef);
990fb837 160 return $self->bnan() if $f->is_nan();
9b924220 161 $self->{_d} = $MBI->new( $CALC->_str( $f->{_m} ) );
162
990fb837 163 # calculate the difference between nE and dE
9b924220 164 my $diff_e = $MBI->new ($nf->exponent())->bsub ( $f->exponent);
990fb837 165 if ($diff_e->is_negative())
166 {
167 # < 0: mul d with it
168 $self->{_d}->blsft($diff_e->babs(),10);
169 }
170 elsif (!$diff_e->is_zero())
184f15d5 171 {
990fb837 172 # > 0: mul n with it
173 $self->{_n}->blsft($diff_e,10);
184f15d5 174 }
184f15d5 175 }
176 else
177 {
7d341013 178 # both d and n are (big)ints
179 $self->{_n} = $MBI->new($n,undef,undef);
180 $self->{_d} = $MBI->new($d,undef,undef);
990fb837 181 $self->{sign} = '+';
182 return $self->bnan() if $self->{_n}->{sign} eq $nan ||
183 $self->{_d}->{sign} eq $nan;
93c87d9d 184 # handle inf and NAN cases:
990fb837 185 if ($self->{_n}->is_inf() || $self->{_d}->is_inf())
186 {
187 # inf/inf => NaN
188 return $self->bnan() if
189 ($self->{_n}->is_inf() && $self->{_d}->is_inf());
7afd7a91 190 if ($self->{_n}->is_inf())
191 {
192 my $s = '+'; # '+inf/+123' or '-inf/-123'
193 $s = '-' if substr($self->{_n}->{sign},0,1) ne $self->{_d}->{sign};
194 # +-inf/123 => +-inf
195 return $self->binf($s);
196 }
990fb837 197 # 123/inf => 0
198 return $self->bzero();
199 }
184f15d5 200
990fb837 201 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
184f15d5 202 # if $d is negative, flip sign
203 $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
990fb837 204 $self->{_d}->babs(); # normalize
184f15d5 205 }
990fb837 206
184f15d5 207 return $self->bnorm();
208 }
209
210 # simple string input
211 if (($n =~ /[\.eE]/))
212 {
7d341013 213 # looks like a float, quacks like a float, so probably is a float
214 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
215 local $Math::BigFloat::accuracy = undef;
216 local $Math::BigFloat::precision = undef;
217 local $Math::BigInt::accuracy = undef;
218 local $Math::BigInt::precision = undef;
990fb837 219 $self->{sign} = 'NaN';
7d341013 220 $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
184f15d5 221 }
222 else
223 {
7d341013 224 $self->{_n} = $MBI->new($n,undef,undef);
6de7f0cc 225 $self->{_d} = $MBI->bone();
990fb837 226 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
a4e2b1c6 227 return $self->bnan() if $self->{sign} eq 'NaN';
228 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
184f15d5 229 }
230 $self->bnorm();
231 }
232
9b924220 233sub copy
234 {
235 my ($c,$x);
236 if (@_ > 1)
237 {
238 # if two arguments, the first one is the class to "swallow" subclasses
239 ($c,$x) = @_;
240 }
241 else
242 {
243 $x = shift;
244 $c = ref($x);
245 }
246 return unless ref($x); # only for objects
247
248 my $self = {}; bless $self,$c;
249
250 $self->{sign} = $x->{sign};
251 $self->{_d} = $x->{_d}->copy();
252 $self->{_n} = $x->{_n}->copy();
253 $self->{_a} = $x->{_a} if defined $x->{_a};
254 $self->{_p} = $x->{_p} if defined $x->{_p};
255 $self;
256 }
257
990fb837 258##############################################################################
259
260sub config
261 {
262 # return (later set?) configuration data as hash ref
263 my $class = shift || 'Math::BigFloat';
264
265 my $cfg = $class->SUPER::config(@_);
266
267 # now we need only to override the ones that are different from our parent
268 $cfg->{class} = $class;
269 $cfg->{with} = $MBI;
270 $cfg;
271 }
272
273##############################################################################
8f675a64 274
184f15d5 275sub bstr
276 {
7afd7a91 277 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 278
279 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
280 {
281 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
282 return $s;
283 }
284
7afd7a91 285 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
184f15d5 286
7afd7a91 287 return $s . $x->{_n}->bstr() if $x->{_d}->is_one();
288 $s . $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
184f15d5 289 }
290
291sub bsstr
292 {
293 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
294
295 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
296 {
297 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
298 return $s;
299 }
300
301 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
7afd7a91 302 $s . $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
184f15d5 303 }
304
305sub bnorm
306 {
307 # reduce the number to the shortest form and remember this (so that we
308 # don't reduce again)
309 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
310
990fb837 311 # both parts must be BigInt's (or whatever we are using today)
312 if (ref($x->{_n}) ne $MBI)
313 {
314 require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).')');
315 }
316 if (ref($x->{_d}) ne $MBI)
317 {
318 require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).')');
319 }
6de7f0cc 320
184f15d5 321 # this is to prevent automatically rounding when MBI's globals are set
322 $x->{_d}->{_f} = MB_NEVER_ROUND;
323 $x->{_n}->{_f} = MB_NEVER_ROUND;
324 # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
7afd7a91 325 delete $x->{_d}->{_a}; delete $x->{_n}->{_a};
326 delete $x->{_d}->{_p}; delete $x->{_n}->{_p};
184f15d5 327
6de7f0cc 328 # no normalize for NaN, inf etc.
329 return $x if $x->{sign} !~ /^[+-]$/;
330
184f15d5 331 # normalize zeros to 0/1
332 if (($x->{sign} =~ /^[+-]$/) &&
333 ($x->{_n}->is_zero()))
334 {
a4e2b1c6 335 $x->{sign} = '+'; # never -0
6de7f0cc 336 $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
184f15d5 337 return $x;
338 }
339
a4e2b1c6 340 return $x if $x->{_d}->is_one(); # no need to reduce
6de7f0cc 341
184f15d5 342 # reduce other numbers
8f675a64 343 # disable upgrade in BigInt, otherwise deep recursion
344 local $Math::BigInt::upgrade = undef;
7d341013 345 local $Math::BigInt::accuracy = undef;
346 local $Math::BigInt::precision = undef;
184f15d5 347 my $gcd = $x->{_n}->bgcd($x->{_d});
348
349 if (!$gcd->is_one())
350 {
351 $x->{_n}->bdiv($gcd);
352 $x->{_d}->bdiv($gcd);
353 }
184f15d5 354 $x;
355 }
356
357##############################################################################
358# special values
359
360sub _bnan
361 {
990fb837 362 # used by parent class bnan() to initialize number to NaN
184f15d5 363 my $self = shift;
990fb837 364
365 if ($_trap_nan)
366 {
367 require Carp;
368 my $class = ref($self);
369 Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
370 }
a4e2b1c6 371 $self->{_n} = $MBI->bzero();
372 $self->{_d} = $MBI->bzero();
184f15d5 373 }
374
375sub _binf
376 {
7d341013 377 # used by parent class bone() to initialize number to +inf/-inf
184f15d5 378 my $self = shift;
990fb837 379
380 if ($_trap_inf)
381 {
382 require Carp;
383 my $class = ref($self);
384 Carp::croak ("Tried to set $self to inf in $class\::_binf()");
385 }
a4e2b1c6 386 $self->{_n} = $MBI->bzero();
387 $self->{_d} = $MBI->bzero();
184f15d5 388 }
389
390sub _bone
391 {
7d341013 392 # used by parent class bone() to initialize number to +1/-1
184f15d5 393 my $self = shift;
a4e2b1c6 394 $self->{_n} = $MBI->bone();
395 $self->{_d} = $MBI->bone();
184f15d5 396 }
397
398sub _bzero
399 {
990fb837 400 # used by parent class bzero() to initialize number to 0
184f15d5 401 my $self = shift;
a4e2b1c6 402 $self->{_n} = $MBI->bzero();
403 $self->{_d} = $MBI->bone();
184f15d5 404 }
405
406##############################################################################
407# mul/add/div etc
408
409sub badd
410 {
7afd7a91 411 # add two rational numbers
7d341013 412
413 # set up parameters
414 my ($self,$x,$y,@r) = (ref($_[0]),@_);
415 # objectify is costly, so avoid it
416 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
417 {
418 ($self,$x,$y,@r) = objectify(2,@_);
419 }
184f15d5 420
6de7f0cc 421 $x = $self->new($x) unless $x->isa($self);
422 $y = $self->new($y) unless $y->isa($self);
184f15d5 423
8f675a64 424 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
7d341013 425 # TODO: inf handling
184f15d5 426
427 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
428 # - + - = --------- = --
429 # 4 3 4*3 12
430
7d341013 431 # we do not compute the gcd() here, but simple do:
432 # 5 7 5*3 + 7*4 41
433 # - + - = --------- = --
434 # 4 3 4*3 12
435
436 # the gcd() calculation and reducing is then done in bnorm()
184f15d5 437
7d341013 438 local $Math::BigInt::accuracy = undef;
439 local $Math::BigInt::precision = undef;
440
441 $x->{_n}->bmul($y->{_d}); $x->{_n}->{sign} = $x->{sign};
442 my $m = $y->{_n}->copy()->bmul($x->{_d});
184f15d5 443 $m->{sign} = $y->{sign}; # 2/1 - 2/1
444 $x->{_n}->badd($m);
445
446 $x->{_d}->bmul($y->{_d});
447
7afd7a91 448 # calculate sign of result and norm our _n part
184f15d5 449 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
450
7d341013 451 $x->bnorm()->round(@r);
184f15d5 452 }
453
454sub bsub
455 {
7afd7a91 456 # subtract two rational numbers
7d341013 457
458 # set up parameters
459 my ($self,$x,$y,@r) = (ref($_[0]),@_);
460 # objectify is costly, so avoid it
461 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
462 {
463 ($self,$x,$y,@r) = objectify(2,@_);
464 }
184f15d5 465
7afd7a91 466 # flip sign of $x, call badd(), then flip sign of result
467 $x->{sign} =~ tr/+-/-+/
468 unless $x->{sign} eq '+' && $x->{_n}->is_zero(); # not -0
469 $x->badd($y,@r); # does norm and round
470 $x->{sign} =~ tr/+-/-+/
471 unless $x->{sign} eq '+' && $x->{_n}->is_zero(); # not -0
472 $x;
184f15d5 473 }
474
475sub bmul
476 {
7afd7a91 477 # multiply two rational numbers
7d341013 478
479 # set up parameters
480 my ($self,$x,$y,@r) = (ref($_[0]),@_);
481 # objectify is costly, so avoid it
482 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
483 {
484 ($self,$x,$y,@r) = objectify(2,@_);
485 }
184f15d5 486
9b924220 487 $x = $self->new($x) unless $x->isa($self);
488 $y = $self->new($y) unless $y->isa($self);
8f675a64 489
184f15d5 490 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
491
492 # inf handling
493 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
494 {
495 return $x->bnan() if $x->is_zero() || $y->is_zero();
496 # result will always be +-inf:
497 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
498 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
499 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
500 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
501 return $x->binf('-');
502 }
503
504 # x== 0 # also: or y == 1 or y == -1
505 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
506
184f15d5 507 # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
508 # and reducing in one step)
509
510 # 1 1 2 1
511 # - * - = - = -
512 # 4 3 12 6
7d341013 513
514 local $Math::BigInt::accuracy = undef;
515 local $Math::BigInt::precision = undef;
184f15d5 516 $x->{_n}->bmul($y->{_n});
517 $x->{_d}->bmul($y->{_d});
518
519 # compute new sign
520 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
521
7d341013 522 $x->bnorm()->round(@r);
184f15d5 523 }
524
525sub bdiv
526 {
527 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
528 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
7d341013 529
530 # set up parameters
531 my ($self,$x,$y,@r) = (ref($_[0]),@_);
532 # objectify is costly, so avoid it
533 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
534 {
535 ($self,$x,$y,@r) = objectify(2,@_);
536 }
184f15d5 537
9b924220 538 $x = $self->new($x) unless $x->isa($self);
539 $y = $self->new($y) unless $y->isa($self);
8f675a64 540
184f15d5 541 return $self->_div_inf($x,$y)
542 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
543
544 # x== 0 # also: or y == 1 or y == -1
545 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
546
547 # TODO: list context, upgrade
548
184f15d5 549 # 1 1 1 3
550 # - / - == - * -
551 # 4 3 4 1
7d341013 552
9b924220 553 local $Math::BigInt::accuracy = undef;
554 local $Math::BigInt::precision = undef;
184f15d5 555 $x->{_n}->bmul($y->{_d});
556 $x->{_d}->bmul($y->{_n});
557
558 # compute new sign
559 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
560
7d341013 561 $x->bnorm()->round(@r);
6de7f0cc 562 $x;
184f15d5 563 }
564
990fb837 565sub bmod
566 {
567 # compute "remainder" (in Perl way) of $x / $y
568
569 # set up parameters
570 my ($self,$x,$y,@r) = (ref($_[0]),@_);
571 # objectify is costly, so avoid it
572 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
573 {
574 ($self,$x,$y,@r) = objectify(2,@_);
575 }
576
9b924220 577 $x = $self->new($x) unless $x->isa($self);
578 $y = $self->new($y) unless $y->isa($self);
990fb837 579
580 return $self->_div_inf($x,$y)
581 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
582
583 return $self->_div_inf($x,$y)
584 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
585
586 return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
587
588 # compute $x - $y * floor($x/$y), keeping the sign of $x
589
93c87d9d 590 # locally disable these, since they would interfere
990fb837 591 local $Math::BigInt::upgrade = undef;
592 local $Math::BigInt::accuracy = undef;
593 local $Math::BigInt::precision = undef;
594
595 my $u = $x->copy()->babs();
93c87d9d 596 # first, do a "normal" division ($x/$y)
990fb837 597 $u->{_d}->bmul($y->{_n});
598 $u->{_n}->bmul($y->{_d});
599
600 # compute floor
601 if (!$u->{_d}->is_one())
602 {
603 $u->{_n}->bdiv($u->{_d}); # 22/7 => 3/1 w/ truncate
604 # no need to set $u->{_d} to 1, since later we set it to $y->{_d}
605 #$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
606 }
607
608 # compute $y * $u
609 $u->{_d} = $y->{_d}; # 1 * $y->{_d}, see floor above
610 $u->{_n}->bmul($y->{_n});
611
612 my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make abs
613 # compute $x - $u
614 $x->bsub($u);
615 $x->{sign} = $xsign; # put sign back
616
617 $x->bnorm()->round(@r);
990fb837 618 }
619
184f15d5 620##############################################################################
a4e2b1c6 621# bdec/binc
622
623sub bdec
624 {
625 # decrement value (subtract 1)
626 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
627
628 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
629
9b924220 630 local $Math::BigInt::accuracy = undef;
631 local $Math::BigInt::precision = undef;
a4e2b1c6 632 if ($x->{sign} eq '-')
633 {
634 $x->{_n}->badd($x->{_d}); # -5/2 => -7/2
635 }
636 else
637 {
638 if ($x->{_n}->bacmp($x->{_d}) < 0)
639 {
640 # 1/3 -- => -2/3
641 $x->{_n} = $x->{_d} - $x->{_n};
642 $x->{sign} = '-';
643 }
644 else
645 {
646 $x->{_n}->bsub($x->{_d}); # 5/2 => 3/2
647 }
648 }
649 $x->bnorm()->round(@r);
a4e2b1c6 650 }
651
652sub binc
653 {
654 # increment value (add 1)
655 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
656
657 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
658
9b924220 659 local $Math::BigInt::accuracy = undef;
660 local $Math::BigInt::precision = undef;
a4e2b1c6 661 if ($x->{sign} eq '-')
662 {
663 if ($x->{_n}->bacmp($x->{_d}) < 0)
664 {
665 # -1/3 ++ => 2/3 (overflow at 0)
666 $x->{_n} = $x->{_d} - $x->{_n};
667 $x->{sign} = '+';
668 }
669 else
670 {
671 $x->{_n}->bsub($x->{_d}); # -5/2 => -3/2
672 }
673 }
674 else
675 {
676 $x->{_n}->badd($x->{_d}); # 5/2 => 7/2
677 }
678 $x->bnorm()->round(@r);
a4e2b1c6 679 }
680
681##############################################################################
184f15d5 682# is_foo methods (the rest is inherited)
683
684sub is_int
685 {
686 # return true if arg (BRAT or num_str) is an integer
9b924220 687 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 688
689 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
7d341013 690 $x->{_d}->is_one(); # x/y && y != 1 => no integer
184f15d5 691 0;
692 }
693
694sub is_zero
695 {
696 # return true if arg (BRAT or num_str) is zero
9b924220 697 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 698
699 return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
700 0;
701 }
702
703sub is_one
704 {
705 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
9b924220 706 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 707
9b924220 708 my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
184f15d5 709 return 1
710 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
711 0;
712 }
713
714sub is_odd
715 {
716 # return true if arg (BFLOAT or num_str) is odd or false if even
9b924220 717 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 718
719 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
720 ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
721 0;
722 }
723
724sub is_even
725 {
726 # return true if arg (BINT or num_str) is even or false if odd
9b924220 727 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 728
729 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
730 return 1 if ($x->{_d}->is_one() # x/3 is never
731 && $x->{_n}->is_even()); # but 4/1 is
732 0;
733 }
734
184f15d5 735##############################################################################
736# parts() and friends
737
738sub numerator
739 {
740 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
a4e2b1c6 741
742 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
743
184f15d5 744 my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
745 $n;
746 }
747
748sub denominator
749 {
750 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
751
a4e2b1c6 752 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
184f15d5 753 $x->{_d}->copy();
754 }
755
756sub parts
757 {
758 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
759
a4e2b1c6 760 return ($self->bnan(),$self->bnan()) if $x->{sign} eq 'NaN';
761 return ($self->binf(),$self->binf()) if $x->{sign} eq '+inf';
762 return ($self->binf('-'),$self->binf()) if $x->{sign} eq '-inf';
763
184f15d5 764 my $n = $x->{_n}->copy();
765 $n->{sign} = $x->{sign};
a4e2b1c6 766 return ($n,$x->{_d}->copy());
184f15d5 767 }
768
769sub length
770 {
9b924220 771 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
772
773 return $nan unless $x->is_int();
774 $x->{_n}->length(); # length(-123/1) => length(123)
184f15d5 775 }
776
777sub digit
778 {
9b924220 779 my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
780
781 return $nan unless $x->is_int();
782 $x->{_n}->digit($n); # digit(-123/1,2) => digit(123,2)
184f15d5 783 }
784
785##############################################################################
786# special calc routines
787
788sub bceil
789 {
790 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
791
792 return $x unless $x->{sign} =~ /^[+-]$/;
793 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
794
990fb837 795 local $Math::BigInt::upgrade = undef;
796 local $Math::BigInt::accuracy = undef;
797 local $Math::BigInt::precision = undef;
a4e2b1c6 798 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
184f15d5 799 $x->{_d}->bone();
800 $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
a4e2b1c6 801 $x->{sign} = '+' if $x->{_n}->is_zero(); # -0 => 0
184f15d5 802 $x;
803 }
804
805sub bfloor
806 {
807 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
808
809 return $x unless $x->{sign} =~ /^[+-]$/;
810 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
811
990fb837 812 local $Math::BigInt::upgrade = undef;
813 local $Math::BigInt::accuracy = undef;
814 local $Math::BigInt::precision = undef;
a4e2b1c6 815 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
184f15d5 816 $x->{_d}->bone();
817 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
818 $x;
819 }
820
821sub bfac
822 {
a4e2b1c6 823 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
824
7afd7a91 825 # if $x is an integer
a4e2b1c6 826 if (($x->{sign} eq '+') && ($x->{_d}->is_one()))
827 {
828 $x->{_n}->bfac();
829 return $x->round(@r);
830 }
831 $x->bnan();
184f15d5 832 }
833
834sub bpow
835 {
7d341013 836 # power ($x ** $y)
837
838 # set up parameters
839 my ($self,$x,$y,@r) = (ref($_[0]),@_);
840 # objectify is costly, so avoid it
841 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
842 {
843 ($self,$x,$y,@r) = objectify(2,@_);
844 }
184f15d5 845
846 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
847 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
848 return $x->bone(@r) if $y->is_zero();
849 return $x->round(@r) if $x->is_one() || $y->is_one();
850 if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
851 {
852 # if $x == -1 and odd/even y => +1/-1
853 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
854 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
855 }
856 # 1 ** -y => 1 / (1 ** |y|)
857 # so do test for negative $y after above's clause
858 # return $x->bnan() if $y->{sign} eq '-';
859 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
860
a4e2b1c6 861 # shortcut y/1 (and/or x/1)
862 if ($y->{_d}->is_one())
863 {
864 # shortcut for x/1 and y/1
865 if ($x->{_d}->is_one())
866 {
867 $x->{_n}->bpow($y->{_n}); # x/1 ** y/1 => (x ** y)/1
868 if ($y->{sign} eq '-')
869 {
870 # 0.2 ** -3 => 1/(0.2 ** 3)
871 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
872 }
873 # correct sign; + ** + => +
874 if ($x->{sign} eq '-')
875 {
876 # - * - => +, - * - * - => -
877 $x->{sign} = '+' if $y->{_n}->is_even();
878 }
879 return $x->round(@r);
880 }
881 # x/z ** y/1
882 $x->{_n}->bpow($y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
883 $x->{_d}->bpow($y->{_n});
884 if ($y->{sign} eq '-')
885 {
886 # 0.2 ** -3 => 1/(0.2 ** 3)
887 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
888 }
889 # correct sign; + ** + => +
890 if ($x->{sign} eq '-')
891 {
892 # - * - => +, - * - * - => -
893 $x->{sign} = '+' if $y->{_n}->is_even();
894 }
895 return $x->round(@r);
896 }
897
898 # regular calculation (this is wrong for d/e ** f/g)
184f15d5 899 my $pow2 = $self->__one();
a4e2b1c6 900 my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
901 my $two = $MBI->new(2);
184f15d5 902 while (!$y1->is_one())
903 {
184f15d5 904 $pow2->bmul($x) if $y1->is_odd();
905 $y1->bdiv($two);
906 $x->bmul($x);
907 }
908 $x->bmul($pow2) unless $pow2->is_one();
909 # n ** -x => 1/n ** x
910 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
7d341013 911 $x->bnorm()->round(@r);
184f15d5 912 }
913
914sub blog
915 {
7afd7a91 916 # set up parameters
917 my ($self,$x,$y,@r) = (ref($_[0]),@_);
918
919 # objectify is costly, so avoid it
920 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
921 {
9b924220 922 ($self,$x,$y,@r) = objectify(2,$class,@_);
7afd7a91 923 }
924
9b924220 925 # blog(1,Y) => 0
926 return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
927
7afd7a91 928 # $x <= 0 => NaN
929 return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
930
931 if ($x->is_int() && $y->is_int())
932 {
933 return $self->new($x->as_number()->blog($y->as_number(),@r));
934 }
935
9b924220 936 # do it with floats
937 $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
938 }
939
940sub _as_float
941 {
942 my $x = shift;
943
944 local $Math::BigFloat::upgrade = undef;
945 local $Math::BigFloat::accuracy = undef;
946 local $Math::BigFloat::precision = undef;
947 # 22/7 => 3.142857143..
948 Math::BigFloat->new($x->{_n})->bdiv($x->{_d}, $x->accuracy());
7afd7a91 949 }
950
951sub broot
952 {
953 # set up parameters
954 my ($self,$x,$y,@r) = (ref($_[0]),@_);
955 # objectify is costly, so avoid it
956 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
957 {
958 ($self,$x,$y,@r) = objectify(2,@_);
959 }
960
961 if ($x->is_int() && $y->is_int())
962 {
963 return $self->new($x->as_number()->broot($y->as_number(),@r));
964 }
9b924220 965
966 # do it with floats
967 $x->_new_from_float( $x->_as_float()->broot($y,@r) );
7afd7a91 968 }
969
970sub bmodpow
971 {
972 # set up parameters
973 my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
974 # objectify is costly, so avoid it
975 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
976 {
977 ($self,$x,$y,$m,@r) = objectify(3,@_);
978 }
979
980 # $x or $y or $m are NaN or +-inf => NaN
981 return $x->bnan()
982 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
983 $m->{sign} !~ /^[+-]$/;
984
985 if ($x->is_int() && $y->is_int() && $m->is_int())
986 {
987 return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
988 }
989
990 warn ("bmodpow() not fully implemented");
991 $x->bnan();
992 }
993
994sub bmodinv
995 {
996 # set up parameters
997 my ($self,$x,$y,@r) = (ref($_[0]),@_);
998 # objectify is costly, so avoid it
999 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1000 {
1001 ($self,$x,$y,@r) = objectify(2,@_);
1002 }
1003
1004 # $x or $y are NaN or +-inf => NaN
1005 return $x->bnan()
1006 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
1007
1008 if ($x->is_int() && $y->is_int())
1009 {
1010 return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
1011 }
1012
1013 warn ("bmodinv() not fully implemented");
1014 $x->bnan();
184f15d5 1015 }
1016
1017sub bsqrt
1018 {
990fb837 1019 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1020
1021 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1022 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1023 return $x->round(@r) if $x->is_zero() || $x->is_one();
1024
1025 local $Math::BigFloat::upgrade = undef;
1026 local $Math::BigFloat::downgrade = undef;
1027 local $Math::BigFloat::precision = undef;
1028 local $Math::BigFloat::accuracy = undef;
1029 local $Math::BigInt::upgrade = undef;
1030 local $Math::BigInt::precision = undef;
1031 local $Math::BigInt::accuracy = undef;
9b924220 1032
93c87d9d 1033 $x->{_d} = Math::BigFloat->new($x->{_d})->bsqrt();
1034 $x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt();
184f15d5 1035
990fb837 1036 # if sqrt(D) was not integer
9b924220 1037 if ($x->{_d}->{_es} ne '+')
990fb837 1038 {
9b924220 1039 $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1
1040 $x->{_d} = $MBI->new($CALC->_str($x->{_d}->{_m})); # 7.1/45.1 => 71/45.1
990fb837 1041 }
1042 # if sqrt(N) was not integer
9b924220 1043 if ($x->{_n}->{_es} ne '+')
990fb837 1044 {
9b924220 1045 $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1
1046 $x->{_n} = $MBI->new($CALC->_str($x->{_n}->{_m})); # 710/45.1 => 710/451
990fb837 1047 }
1048
1049 # convert parts to $MBI again
9b924220 1050 $x->{_n} = $x->{_n}->as_number() unless $x->{_n}->isa($MBI);
1051 $x->{_d} = $x->{_d}->as_number() unless $x->{_d}->isa($MBI);
990fb837 1052 $x->bnorm()->round(@r);
184f15d5 1053 }
1054
1055sub blsft
1056 {
9b924220 1057 my ($self,$x,$y,$b,@r) = objectify(3,@_);
184f15d5 1058
9b924220 1059 $b = 2 unless defined $b;
1060 $b = $self->new($b) unless ref ($b);
1061 $x->bmul( $b->copy()->bpow($y), @r);
184f15d5 1062 $x;
1063 }
1064
1065sub brsft
1066 {
9b924220 1067 my ($self,$x,$y,$b,@r) = objectify(2,@_);
184f15d5 1068
9b924220 1069 $b = 2 unless defined $b;
1070 $b = $self->new($b) unless ref ($b);
1071 $x->bdiv( $b->copy()->bpow($y), @r);
184f15d5 1072 $x;
1073 }
1074
1075##############################################################################
1076# round
1077
1078sub round
1079 {
1080 $_[0];
1081 }
1082
1083sub bround
1084 {
1085 $_[0];
1086 }
1087
1088sub bfround
1089 {
1090 $_[0];
1091 }
1092
1093##############################################################################
1094# comparing
1095
1096sub bcmp
1097 {
7afd7a91 1098 # compare two signed numbers
1099
1100 # set up parameters
1101 my ($self,$x,$y) = (ref($_[0]),@_);
1102 # objectify is costly, so avoid it
1103 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1104 {
1105 ($self,$x,$y) = objectify(2,@_);
1106 }
184f15d5 1107
1108 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1109 {
1110 # handle +-inf and NaN
1111 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1112 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1113 return +1 if $x->{sign} eq '+inf';
1114 return -1 if $x->{sign} eq '-inf';
1115 return -1 if $y->{sign} eq '+inf';
1116 return +1;
1117 }
1118 # check sign for speed first
1119 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1120 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1121
1122 # shortcut
1123 my $xz = $x->{_n}->is_zero();
1124 my $yz = $y->{_n}->is_zero();
1125 return 0 if $xz && $yz; # 0 <=> 0
1126 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1127 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1128
1129 my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
1130 my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
1131 $t->bcmp($u);
1132 }
1133
1134sub bacmp
1135 {
7afd7a91 1136 # compare two numbers (as unsigned)
9b924220 1137
7afd7a91 1138 # set up parameters
1139 my ($self,$x,$y) = (ref($_[0]),@_);
1140 # objectify is costly, so avoid it
1141 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1142 {
9b924220 1143 ($self,$x,$y) = objectify(2,$class,@_);
7afd7a91 1144 }
184f15d5 1145
1146 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1147 {
1148 # handle +-inf and NaN
1149 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1150 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
7afd7a91 1151 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1152 return -1;
184f15d5 1153 }
1154
1155 my $t = $x->{_n} * $y->{_d};
1156 my $u = $y->{_n} * $x->{_d};
1157 $t->bacmp($u);
1158 }
1159
1160##############################################################################
1161# output conversation
1162
7d341013 1163sub numify
1164 {
1165 # convert 17/8 => float (aka 2.125)
1166 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1167
1168 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
1169
93c87d9d 1170 # N/1 => N
1171 return $x->{_n}->numify() if $x->{_d}->is_one();
1172
1173 # N/D
1174 my $neg = 1; $neg = -1 if $x->{sign} ne '+';
1175 $neg * $x->{_n}->numify() / $x->{_d}->numify(); # return sign * N/D
7d341013 1176 }
1177
184f15d5 1178sub as_number
1179 {
9b924220 1180 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
184f15d5 1181
990fb837 1182 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1183
1184 # need to disable these, otherwise bdiv() gives BigRat again
1185 local $Math::BigInt::upgrade = undef;
1186 local $Math::BigInt::accuracy = undef;
1187 local $Math::BigInt::precision = undef;
184f15d5 1188 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
1189 $t->{sign} = $x->{sign};
1190 $t;
1191 }
1192
9b924220 1193sub as_bin
1194 {
1195 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1196
1197 return $x unless $x->is_int();
1198
1199 my $s = $x->{sign}; $s = '' if $s eq '+';
1200 $s . $x->{_n}->as_bin();
1201 }
1202
1203sub as_hex
1204 {
1205 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1206
1207 return $x unless $x->is_int();
1208
1209 my $s = $x->{sign}; $s = '' if $s eq '+';
1210 $s . $x->{_n}->as_hex();
1211 }
1212
6de7f0cc 1213sub import
1214 {
1215 my $self = shift;
1216 my $l = scalar @_;
1217 my $lib = ''; my @a;
9b924220 1218 $IMPORT++;
1219
6de7f0cc 1220 for ( my $i = 0; $i < $l ; $i++)
1221 {
1222# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
1223 if ( $_[$i] eq ':constant' )
1224 {
1225 # this rest causes overlord er load to step in
1226 # print "overload @_\n";
1227 overload::constant float => sub { $self->new(shift); };
1228 }
1229# elsif ($_[$i] eq 'upgrade')
1230# {
1231# # this causes upgrading
1232# $upgrade = $_[$i+1]; # or undef to disable
1233# $i++;
1234# }
1235 elsif ($_[$i] eq 'downgrade')
1236 {
1237 # this causes downgrading
1238 $downgrade = $_[$i+1]; # or undef to disable
1239 $i++;
1240 }
1241 elsif ($_[$i] eq 'lib')
1242 {
1243 $lib = $_[$i+1] || ''; # default Calc
1244 $i++;
1245 }
1246 elsif ($_[$i] eq 'with')
1247 {
1248 $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
1249 $i++;
1250 }
1251 else
1252 {
1253 push @a, $_[$i];
1254 }
1255 }
9b924220 1256 # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still work
6de7f0cc 1257 my $mbilib = eval { Math::BigInt->config()->{lib} };
1258 if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
1259 {
1260 # MBI already loaded
1261 $MBI->import('lib',"$lib,$mbilib", 'objectify');
1262 }
1263 else
1264 {
a4e2b1c6 1265 # MBI not loaded, or not with "Math::BigInt"
6de7f0cc 1266 $lib .= ",$mbilib" if defined $mbilib;
1267
6de7f0cc 1268 if ($] < 5.006)
1269 {
1270 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1271 # used in the same script, or eval inside import().
1272 my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
1273 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
1274 $file = File::Spec->catfile (@parts, $file);
1275 eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
1276 }
1277 else
1278 {
1279 my $rc = "use $MBI lib => '$lib', 'objectify';";
1280 eval $rc;
1281 }
1282 }
93c87d9d 1283 if ($@)
1284 {
1285 require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
1286 }
6de7f0cc 1287
9b924220 1288 $CALC = Math::BigFloat->config()->{lib};
1289
6de7f0cc 1290 # any non :constant stuff is handled by our parent, Exporter
1291 # even if @_ is empty, to give it a chance
1292 $self->SUPER::import(@a); # for subclasses
1293 $self->export_to_level(1,$self,@a); # need this, too
1294 }
184f15d5 1295
12961;
1297
1298__END__
1299
1300=head1 NAME
1301
7afd7a91 1302Math::BigRat - arbitrarily big rational numbers
184f15d5 1303
1304=head1 SYNOPSIS
1305
7d341013 1306 use Math::BigRat;
184f15d5 1307
7afd7a91 1308 my $x = Math::BigRat->new('3/7'); $x += '5/9';
184f15d5 1309
7d341013 1310 print $x->bstr(),"\n";
1311 print $x ** 2,"\n";
184f15d5 1312
7afd7a91 1313 my $y = Math::BigRat->new('inf');
1314 print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
1315
1316 my $z = Math::BigRat->new(144); $z->bsqrt();
1317
184f15d5 1318=head1 DESCRIPTION
1319
7d341013 1320Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
7afd7a91 1321for arbitrarily big rational numbers.
184f15d5 1322
1323=head2 MATH LIBRARY
1324
1325Math with the numbers is done (by default) by a module called
1326Math::BigInt::Calc. This is equivalent to saying:
1327
1328 use Math::BigRat lib => 'Calc';
1329
1330You can change this by using:
1331
1332 use Math::BigRat lib => 'BitVect';
1333
1334The following would first try to find Math::BigInt::Foo, then
1335Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1336
1337 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1338
1339Calc.pm uses as internal format an array of elements of some decimal base
7d341013 1340(usually 1e7, but this might be different for some systems) with the least
184f15d5 1341significant digit first, while BitVect.pm uses a bit vector of base 2, most
1342significant bit first. Other modules might use even different means of
1343representing the numbers. See the respective module documentation for further
1344details.
1345
7d341013 1346Currently the following replacement libraries exist, search for them at CPAN:
1347
1348 Math::BigInt::BitVect
1349 Math::BigInt::GMP
1350 Math::BigInt::Pari
1351 Math::BigInt::FastCalc
1352
184f15d5 1353=head1 METHODS
1354
7d341013 1355Any methods not listed here are dervied from Math::BigFloat (or
6de7f0cc 1356Math::BigInt), so make sure you check these two modules for further
1357information.
1358
1359=head2 new()
184f15d5 1360
1361 $x = Math::BigRat->new('1/3');
1362
1363Create a new Math::BigRat object. Input can come in various forms:
1364
7d341013 1365 $x = Math::BigRat->new(123); # scalars
7afd7a91 1366 $x = Math::BigRat->new('inf'); # infinity
7d341013 1367 $x = Math::BigRat->new('123.3'); # float
184f15d5 1368 $x = Math::BigRat->new('1/3'); # simple string
1369 $x = Math::BigRat->new('1 / 3'); # spaced
1370 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1371 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1372 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
6de7f0cc 1373 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
184f15d5 1374
6de7f0cc 1375=head2 numerator()
184f15d5 1376
1377 $n = $x->numerator();
1378
1379Returns a copy of the numerator (the part above the line) as signed BigInt.
1380
6de7f0cc 1381=head2 denominator()
184f15d5 1382
1383 $d = $x->denominator();
1384
1385Returns a copy of the denominator (the part under the line) as positive BigInt.
1386
6de7f0cc 1387=head2 parts()
184f15d5 1388
1389 ($n,$d) = $x->parts();
1390
1391Return a list consisting of (signed) numerator and (unsigned) denominator as
1392BigInts.
1393
6de7f0cc 1394=head2 as_number()
1395
7d341013 1396 $x = Math::BigRat->new('13/7');
1397 print $x->as_number(),"\n"; # '1'
1398
990fb837 1399Returns a copy of the object as BigInt trunced it to integer.
6de7f0cc 1400
a4e2b1c6 1401=head2 bfac()
6de7f0cc 1402
a4e2b1c6 1403 $x->bfac();
6de7f0cc 1404
a4e2b1c6 1405Calculates the factorial of $x. For instance:
6de7f0cc 1406
a4e2b1c6 1407 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1408 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
184f15d5 1409
7d341013 1410Works currently only for integers.
6de7f0cc 1411
a4e2b1c6 1412=head2 blog()
6de7f0cc 1413
a4e2b1c6 1414Is not yet implemented.
6de7f0cc 1415
a4e2b1c6 1416=head2 bround()/round()/bfround()
6de7f0cc 1417
a4e2b1c6 1418Are not yet implemented.
6de7f0cc 1419
990fb837 1420=head2 bmod()
1421
1422 use Math::BigRat;
1423 my $x = Math::BigRat->new('7/4');
1424 my $y = Math::BigRat->new('4/3');
1425 print $x->bmod($y);
1426
1427Set $x to the remainder of the division of $x by $y.
1428
7d341013 1429=head2 is_one()
1430
1431 print "$x is 1\n" if $x->is_one();
1432
1433Return true if $x is exactly one, otherwise false.
1434
1435=head2 is_zero()
1436
1437 print "$x is 0\n" if $x->is_zero();
1438
1439Return true if $x is exactly zero, otherwise false.
1440
1441=head2 is_positive()
1442
1443 print "$x is >= 0\n" if $x->is_positive();
1444
1445Return true if $x is positive (greater than or equal to zero), otherwise
1446false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1447
1448=head2 is_negative()
1449
1450 print "$x is < 0\n" if $x->is_negative();
1451
1452Return true if $x is negative (smaller than zero), otherwise false. Please
1453note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1454
1455=head2 is_int()
1456
1457 print "$x is an integer\n" if $x->is_int();
1458
1459Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1460false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1461
1462=head2 is_odd()
1463
1464 print "$x is odd\n" if $x->is_odd();
1465
1466Return true if $x is odd, otherwise false.
1467
1468=head2 is_even()
1469
1470 print "$x is even\n" if $x->is_even();
1471
1472Return true if $x is even, otherwise false.
1473
1474=head2 bceil()
1475
1476 $x->bceil();
1477
1478Set $x to the next bigger integer value (e.g. truncate the number to integer
1479and then increment it by one).
1480
1481=head2 bfloor()
1482
1483 $x->bfloor();
1484
1485Truncate $x to an integer value.
6de7f0cc 1486
7afd7a91 1487=head2 bsqrt()
1488
1489 $x->bsqrt();
1490
1491Calculate the square root of $x.
1492
990fb837 1493=head2 config
1494
1495 use Data::Dumper;
1496
1497 print Dumper ( Math::BigRat->config() );
1498 print Math::BigRat->config()->{lib},"\n";
1499
1500Returns a hash containing the configuration, e.g. the version number, lib
1501loaded etc. The following hash keys are currently filled in with the
1502appropriate information.
1503
1504 key RO/RW Description
1505 Example
1506 ============================================================
1507 lib RO Name of the Math library
1508 Math::BigInt::Calc
1509 lib_version RO Version of 'lib'
1510 0.30
1511 class RO The class of config you just called
1512 Math::BigRat
1513 version RO version number of the class you used
1514 0.10
1515 upgrade RW To which class numbers are upgraded
1516 undef
1517 downgrade RW To which class numbers are downgraded
1518 undef
1519 precision RW Global precision
1520 undef
1521 accuracy RW Global accuracy
1522 undef
1523 round_mode RW Global round mode
1524 even
1525 div_scale RW Fallback acccuracy for div
1526 40
1527 trap_nan RW Trap creation of NaN (undef = no)
1528 undef
1529 trap_inf RW Trap creation of +inf/-inf (undef = no)
1530 undef
1531
1532By passing a reference to a hash you may set the configuration values. This
1533works only for values that a marked with a C<RW> above, anything else is
1534read-only.
1535
a4e2b1c6 1536=head1 BUGS
6de7f0cc 1537
7d341013 1538Some things are not yet implemented, or only implemented half-way:
1539
1540=over 2
1541
1542=item inf handling (partial)
1543
1544=item NaN handling (partial)
1545
1546=item rounding (not implemented except for bceil/bfloor)
1547
1548=item $x ** $y where $y is not an integer
1549
7afd7a91 1550=item bmod(), blog(), bmodinv() and bmodpow() (partial)
1551
7d341013 1552=back
184f15d5 1553
1554=head1 LICENSE
1555
1556This program is free software; you may redistribute it and/or modify it under
1557the same terms as Perl itself.
1558
1559=head1 SEE ALSO
1560
1561L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1562L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1563
7d341013 1564See L<http://search.cpan.org/search?dist=bignum> for a way to use
1565Math::BigRat.
1566
1567The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1568may contain more documentation and examples as well as testcases.
184f15d5 1569
1570=head1 AUTHORS
1571
7afd7a91 1572(C) by Tels L<http://bloodgate.com/> 2001, 2002, 2003, 2004.
184f15d5 1573
1574=cut