3 # "Tax the rat farms." - Lord Vetinari
6 # The following hash values are used:
7 # sign : +,-,NaN,+inf,-inf
9 # _n : numeraotr (value = _n/_d)
12 # _f : flags, used by MBR to flag parts of a rationale as untouchable
21 use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
22 $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
24 @ISA = qw(Exporter Math::BigFloat);
29 use overload; # inherit from Math::BigFloat
31 ##############################################################################
32 # global constants, flags and accessory
34 $accuracy = $precision = undef;
40 # these are internally, and not to be used from the outside
42 use constant MB_NEVER_ROUND => 0x0001;
44 $_trap_nan = 0; # are NaNs ok? set w/ config()
45 $_trap_inf = 0; # are infs ok? set w/ config()
48 my $class = 'Math::BigRat';
49 my $MBI = 'Math::BigInt';
53 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
59 # turn a single float input into a rationale (like '0.1')
62 return $self->bnan() if $f->is_nan();
63 return $self->binf('-inf') if $f->{sign} eq '-inf';
64 return $self->binf('+inf') if $f->{sign} eq '+inf';
66 $self->{_n} = $f->{_m}->copy(); # mantissa
67 $self->{_d} = $MBI->bone();
68 $self->{sign} = $f->{sign} || '+'; $self->{_n}->{sign} = '+';
69 if ($f->{_e}->{sign} eq '-')
71 # something like Math::BigRat->new('0.1');
72 $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10
76 # something like Math::BigRat->new('10');
78 $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
85 # create a Math::BigRat
90 my $self = { }; bless $self,$class;
92 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
94 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
96 if ($n->isa('Math::BigFloat'))
98 return $self->_new_from_float($n)->bnorm();
100 if ($n->isa('Math::BigInt'))
102 # TODO: trap NaN, inf
103 $self->{_n} = $n->copy(); # "mantissa" = $n
104 $self->{_d} = $MBI->bone();
105 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
106 return $self->bnorm();
108 if ($n->isa('Math::BigInt::Lite'))
110 # TODO: trap NaN, inf
111 $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
112 $self->{_n} = $MBI->new(abs($$n),undef,undef); # "mantissa" = $n
113 $self->{_d} = $MBI->bone();
114 return $self->bnorm();
117 return $n->copy() if ref $n;
121 $self->{_n} = $MBI->bzero(); # undef => 0
122 $self->{_d} = $MBI->bone();
124 return $self->bnorm();
126 # string input with / delimiter
127 if ($n =~ /\s*\/\s*/)
129 return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
130 return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
131 ($n,$d) = split (/\//,$n);
132 # try as BigFloats first
133 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
135 # one of them looks like a float
136 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
137 local $Math::BigFloat::accuracy = undef;
138 local $Math::BigFloat::precision = undef;
139 local $Math::BigInt::accuracy = undef;
140 local $Math::BigInt::precision = undef;
141 my $nf = Math::BigFloat->new($n);
143 return $self->bnan() if $nf->is_nan();
144 $self->{_n} = $nf->{_m};
145 # now correct $self->{_n} due to $n
146 my $f = Math::BigFloat->new($d,undef,undef);
147 $self->{_d} = $f->{_m};
148 return $self->bnan() if $f->is_nan();
149 #print "n=$nf e$nf->{_e} d=$f e$f->{_e}\n";
150 # calculate the difference between nE and dE
151 my $diff_e = $nf->{_e}->copy()->bsub ( $f->{_e} );
152 if ($diff_e->is_negative())
155 $self->{_d}->blsft($diff_e->babs(),10);
157 elsif (!$diff_e->is_zero())
160 $self->{_n}->blsft($diff_e,10);
165 # both d and n are (big)ints
166 $self->{_n} = $MBI->new($n,undef,undef);
167 $self->{_d} = $MBI->new($d,undef,undef);
169 return $self->bnan() if $self->{_n}->{sign} eq $nan ||
170 $self->{_d}->{sign} eq $nan;
171 # handle inf and NAN cases:
172 if ($self->{_n}->is_inf() || $self->{_d}->is_inf())
175 return $self->bnan() if
176 ($self->{_n}->is_inf() && $self->{_d}->is_inf());
178 return $self->binf($self->{sign}) if $self->{_n}->is_inf();
180 return $self->bzero();
183 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
184 # if $d is negative, flip sign
185 $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
186 $self->{_d}->babs(); # normalize
189 return $self->bnorm();
192 # simple string input
193 if (($n =~ /[\.eE]/))
195 # looks like a float, quacks like a float, so probably is a float
196 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
197 local $Math::BigFloat::accuracy = undef;
198 local $Math::BigFloat::precision = undef;
199 local $Math::BigInt::accuracy = undef;
200 local $Math::BigInt::precision = undef;
201 $self->{sign} = 'NaN';
202 $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
206 $self->{_n} = $MBI->new($n,undef,undef);
207 $self->{_d} = $MBI->bone();
208 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
209 return $self->bnan() if $self->{sign} eq 'NaN';
210 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
215 ##############################################################################
219 # return (later set?) configuration data as hash ref
220 my $class = shift || 'Math::BigFloat';
222 my $cfg = $class->SUPER::config(@_);
224 # now we need only to override the ones that are different from our parent
225 $cfg->{class} = $class;
230 ##############################################################################
234 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
236 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
238 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
242 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
244 return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
245 return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr();
250 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
252 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
254 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
258 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
259 return $s . $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
264 # reduce the number to the shortest form and remember this (so that we
265 # don't reduce again)
266 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
268 # both parts must be BigInt's (or whatever we are using today)
269 if (ref($x->{_n}) ne $MBI)
271 require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).')');
273 if (ref($x->{_d}) ne $MBI)
275 require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).')');
278 # this is to prevent automatically rounding when MBI's globals are set
279 $x->{_d}->{_f} = MB_NEVER_ROUND;
280 $x->{_n}->{_f} = MB_NEVER_ROUND;
281 # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
282 $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
283 $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
285 # no normalize for NaN, inf etc.
286 return $x if $x->{sign} !~ /^[+-]$/;
288 # normalize zeros to 0/1
289 if (($x->{sign} =~ /^[+-]$/) &&
290 ($x->{_n}->is_zero()))
292 $x->{sign} = '+'; # never -0
293 $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
297 return $x if $x->{_d}->is_one(); # no need to reduce
299 # reduce other numbers
300 # disable upgrade in BigInt, otherwise deep recursion
301 local $Math::BigInt::upgrade = undef;
302 local $Math::BigInt::accuracy = undef;
303 local $Math::BigInt::precision = undef;
304 my $gcd = $x->{_n}->bgcd($x->{_d});
308 $x->{_n}->bdiv($gcd);
309 $x->{_d}->bdiv($gcd);
314 ##############################################################################
319 # used by parent class bnan() to initialize number to NaN
325 my $class = ref($self);
326 Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
328 $self->{_n} = $MBI->bzero();
329 $self->{_d} = $MBI->bzero();
334 # used by parent class bone() to initialize number to +inf/-inf
340 my $class = ref($self);
341 Carp::croak ("Tried to set $self to inf in $class\::_binf()");
343 $self->{_n} = $MBI->bzero();
344 $self->{_d} = $MBI->bzero();
349 # used by parent class bone() to initialize number to +1/-1
351 $self->{_n} = $MBI->bone();
352 $self->{_d} = $MBI->bone();
357 # used by parent class bzero() to initialize number to 0
359 $self->{_n} = $MBI->bzero();
360 $self->{_d} = $MBI->bone();
363 ##############################################################################
371 my ($self,$x,$y,@r) = (ref($_[0]),@_);
372 # objectify is costly, so avoid it
373 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
375 ($self,$x,$y,@r) = objectify(2,@_);
378 $x = $self->new($x) unless $x->isa($self);
379 $y = $self->new($y) unless $y->isa($self);
381 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
384 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
385 # - + - = --------- = --
388 # we do not compute the gcd() here, but simple do:
390 # - + - = --------- = --
393 # the gcd() calculation and reducing is then done in bnorm()
395 local $Math::BigInt::accuracy = undef;
396 local $Math::BigInt::precision = undef;
398 $x->{_n}->bmul($y->{_d}); $x->{_n}->{sign} = $x->{sign};
399 my $m = $y->{_n}->copy()->bmul($x->{_d});
400 $m->{sign} = $y->{sign}; # 2/1 - 2/1
403 $x->{_d}->bmul($y->{_d});
406 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
408 $x->bnorm()->round(@r);
413 # subtract two rationales
416 my ($self,$x,$y,@r) = (ref($_[0]),@_);
417 # objectify is costly, so avoid it
418 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
420 ($self,$x,$y,@r) = objectify(2,@_);
423 # TODO: $self instead or $class??
424 $x = $class->new($x) unless $x->isa($class);
425 $y = $class->new($y) unless $y->isa($class);
427 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
430 # 1 1 gcd(3,4) = 1 1*3 - 1*4 7
431 # - - - = --------- = --
434 # we do not compute the gcd() here, but simple do:
436 # - - - = --------- = - --
439 local $Math::BigInt::accuracy = undef;
440 local $Math::BigInt::precision = undef;
442 $x->{_n}->bmul($y->{_d}); $x->{_n}->{sign} = $x->{sign};
443 my $m = $y->{_n}->copy()->bmul($x->{_d});
444 $m->{sign} = $y->{sign}; # 2/1 - 2/1
447 $x->{_d}->bmul($y->{_d});
450 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
452 $x->bnorm()->round(@r);
457 # multiply two rationales
460 my ($self,$x,$y,@r) = (ref($_[0]),@_);
461 # objectify is costly, so avoid it
462 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
464 ($self,$x,$y,@r) = objectify(2,@_);
467 # TODO: $self instead or $class??
468 $x = $class->new($x) unless $x->isa($class);
469 $y = $class->new($y) unless $y->isa($class);
471 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
474 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
476 return $x->bnan() if $x->is_zero() || $y->is_zero();
477 # result will always be +-inf:
478 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
479 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
480 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
481 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
482 return $x->binf('-');
485 # x== 0 # also: or y == 1 or y == -1
486 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
488 # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
489 # and reducing in one step)
495 local $Math::BigInt::accuracy = undef;
496 local $Math::BigInt::precision = undef;
497 $x->{_n}->bmul($y->{_n});
498 $x->{_d}->bmul($y->{_d});
501 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
503 $x->bnorm()->round(@r);
508 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
509 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
512 my ($self,$x,$y,@r) = (ref($_[0]),@_);
513 # objectify is costly, so avoid it
514 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
516 ($self,$x,$y,@r) = objectify(2,@_);
519 # TODO: $self instead or $class??
520 $x = $class->new($x) unless $x->isa($class);
521 $y = $class->new($y) unless $y->isa($class);
523 return $self->_div_inf($x,$y)
524 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
526 # x== 0 # also: or y == 1 or y == -1
527 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
529 # TODO: list context, upgrade
535 # local $Math::BigInt::accuracy = undef;
536 # local $Math::BigInt::precision = undef;
537 $x->{_n}->bmul($y->{_d});
538 $x->{_d}->bmul($y->{_n});
541 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
543 $x->bnorm()->round(@r);
549 # compute "remainder" (in Perl way) of $x / $y
552 my ($self,$x,$y,@r) = (ref($_[0]),@_);
553 # objectify is costly, so avoid it
554 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
556 ($self,$x,$y,@r) = objectify(2,@_);
559 # TODO: $self instead or $class??
560 $x = $class->new($x) unless $x->isa($class);
561 $y = $class->new($y) unless $y->isa($class);
563 return $self->_div_inf($x,$y)
564 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
566 return $self->_div_inf($x,$y)
567 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
569 return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
571 # compute $x - $y * floor($x/$y), keeping the sign of $x
573 # locally disable these, since they would interfere
574 local $Math::BigInt::upgrade = undef;
575 local $Math::BigInt::accuracy = undef;
576 local $Math::BigInt::precision = undef;
578 my $u = $x->copy()->babs();
579 # first, do a "normal" division ($x/$y)
580 $u->{_d}->bmul($y->{_n});
581 $u->{_n}->bmul($y->{_d});
584 if (!$u->{_d}->is_one())
586 $u->{_n}->bdiv($u->{_d}); # 22/7 => 3/1 w/ truncate
587 # no need to set $u->{_d} to 1, since later we set it to $y->{_d}
588 #$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
592 $u->{_d} = $y->{_d}; # 1 * $y->{_d}, see floor above
593 $u->{_n}->bmul($y->{_n});
595 my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make abs
598 $x->{sign} = $xsign; # put sign back
600 $x->bnorm()->round(@r);
603 ##############################################################################
608 # decrement value (subtract 1)
609 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
611 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
613 if ($x->{sign} eq '-')
615 $x->{_n}->badd($x->{_d}); # -5/2 => -7/2
619 if ($x->{_n}->bacmp($x->{_d}) < 0)
622 $x->{_n} = $x->{_d} - $x->{_n};
627 $x->{_n}->bsub($x->{_d}); # 5/2 => 3/2
630 $x->bnorm()->round(@r);
635 # increment value (add 1)
636 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
638 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
640 if ($x->{sign} eq '-')
642 if ($x->{_n}->bacmp($x->{_d}) < 0)
644 # -1/3 ++ => 2/3 (overflow at 0)
645 $x->{_n} = $x->{_d} - $x->{_n};
650 $x->{_n}->bsub($x->{_d}); # -5/2 => -3/2
655 $x->{_n}->badd($x->{_d}); # 5/2 => 7/2
657 $x->bnorm()->round(@r);
660 ##############################################################################
661 # is_foo methods (the rest is inherited)
665 # return true if arg (BRAT or num_str) is an integer
666 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
668 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
669 $x->{_d}->is_one(); # x/y && y != 1 => no integer
675 # return true if arg (BRAT or num_str) is zero
676 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
678 return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
684 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
685 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
687 my $sign = shift || ''; $sign = '+' if $sign ne '-';
689 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
695 # return true if arg (BFLOAT or num_str) is odd or false if even
696 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
698 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
699 ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
705 # return true if arg (BINT or num_str) is even or false if odd
706 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
708 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
709 return 1 if ($x->{_d}->is_one() # x/3 is never
710 && $x->{_n}->is_even()); # but 4/1 is
716 *objectify = \&Math::BigInt::objectify;
719 ##############################################################################
720 # parts() and friends
724 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
726 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
728 my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
734 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
736 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
742 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
744 return ($self->bnan(),$self->bnan()) if $x->{sign} eq 'NaN';
745 return ($self->binf(),$self->binf()) if $x->{sign} eq '+inf';
746 return ($self->binf('-'),$self->binf()) if $x->{sign} eq '-inf';
748 my $n = $x->{_n}->copy();
749 $n->{sign} = $x->{sign};
750 return ($n,$x->{_d}->copy());
763 ##############################################################################
764 # special calc routines
768 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
770 return $x unless $x->{sign} =~ /^[+-]$/;
771 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
773 local $Math::BigInt::upgrade = undef;
774 local $Math::BigInt::accuracy = undef;
775 local $Math::BigInt::precision = undef;
776 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
778 $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
779 $x->{sign} = '+' if $x->{_n}->is_zero(); # -0 => 0
785 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
787 return $x unless $x->{sign} =~ /^[+-]$/;
788 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
790 local $Math::BigInt::upgrade = undef;
791 local $Math::BigInt::accuracy = undef;
792 local $Math::BigInt::precision = undef;
793 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
795 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
801 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
803 if (($x->{sign} eq '+') && ($x->{_d}->is_one()))
806 return $x->round(@r);
816 my ($self,$x,$y,@r) = (ref($_[0]),@_);
817 # objectify is costly, so avoid it
818 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
820 ($self,$x,$y,@r) = objectify(2,@_);
823 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
824 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
825 return $x->bone(@r) if $y->is_zero();
826 return $x->round(@r) if $x->is_one() || $y->is_one();
827 if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
829 # if $x == -1 and odd/even y => +1/-1
830 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
831 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
833 # 1 ** -y => 1 / (1 ** |y|)
834 # so do test for negative $y after above's clause
835 # return $x->bnan() if $y->{sign} eq '-';
836 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
838 # shortcut y/1 (and/or x/1)
839 if ($y->{_d}->is_one())
841 # shortcut for x/1 and y/1
842 if ($x->{_d}->is_one())
844 $x->{_n}->bpow($y->{_n}); # x/1 ** y/1 => (x ** y)/1
845 if ($y->{sign} eq '-')
847 # 0.2 ** -3 => 1/(0.2 ** 3)
848 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
850 # correct sign; + ** + => +
851 if ($x->{sign} eq '-')
853 # - * - => +, - * - * - => -
854 $x->{sign} = '+' if $y->{_n}->is_even();
856 return $x->round(@r);
859 $x->{_n}->bpow($y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
860 $x->{_d}->bpow($y->{_n});
861 if ($y->{sign} eq '-')
863 # 0.2 ** -3 => 1/(0.2 ** 3)
864 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
866 # correct sign; + ** + => +
867 if ($x->{sign} eq '-')
869 # - * - => +, - * - * - => -
870 $x->{sign} = '+' if $y->{_n}->is_even();
872 return $x->round(@r);
875 # regular calculation (this is wrong for d/e ** f/g)
876 my $pow2 = $self->__one();
877 my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
878 my $two = $MBI->new(2);
879 while (!$y1->is_one())
881 $pow2->bmul($x) if $y1->is_odd();
885 $x->bmul($pow2) unless $pow2->is_one();
886 # n ** -x => 1/n ** x
887 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
888 $x->bnorm()->round(@r);
893 return Math::BigRat->bnan();
898 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
900 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
901 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
902 return $x->round(@r) if $x->is_zero() || $x->is_one();
904 local $Math::BigFloat::upgrade = undef;
905 local $Math::BigFloat::downgrade = undef;
906 local $Math::BigFloat::precision = undef;
907 local $Math::BigFloat::accuracy = undef;
908 local $Math::BigInt::upgrade = undef;
909 local $Math::BigInt::precision = undef;
910 local $Math::BigInt::accuracy = undef;
911 $x->{_d} = Math::BigFloat->new($x->{_d})->bsqrt();
912 $x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt();
914 # if sqrt(D) was not integer
915 if ($x->{_d}->{_e}->{sign} ne '+')
917 $x->{_n}->blsft($x->{_d}->{_e}->babs(),10); # 7.1/4.51 => 7.1/45.1
918 $x->{_d} = $x->{_d}->{_m}; # 7.1/45.1 => 71/45.1
920 # if sqrt(N) was not integer
921 if ($x->{_n}->{_e}->{sign} ne '+')
923 $x->{_d}->blsft($x->{_n}->{_e}->babs(),10); # 71/45.1 => 710/45.1
924 $x->{_n} = $x->{_n}->{_m}; # 710/45.1 => 710/451
927 # convert parts to $MBI again
928 $x->{_n} = $x->{_n}->as_number();
929 $x->{_d} = $x->{_d}->as_number();
930 $x->bnorm()->round(@r);
935 my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
937 $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
943 my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
945 $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
949 ##############################################################################
967 ##############################################################################
972 my ($self,$x,$y) = objectify(2,@_);
974 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
976 # handle +-inf and NaN
977 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
978 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
979 return +1 if $x->{sign} eq '+inf';
980 return -1 if $x->{sign} eq '-inf';
981 return -1 if $y->{sign} eq '+inf';
984 # check sign for speed first
985 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
986 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
989 my $xz = $x->{_n}->is_zero();
990 my $yz = $y->{_n}->is_zero();
991 return 0 if $xz && $yz; # 0 <=> 0
992 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
993 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
995 my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
996 my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
1002 my ($self,$x,$y) = objectify(2,@_);
1004 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1006 # handle +-inf and NaN
1007 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1008 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1009 return +1; # inf is always bigger
1012 my $t = $x->{_n} * $y->{_d};
1013 my $u = $y->{_n} * $x->{_d};
1017 ##############################################################################
1018 # output conversation
1022 # convert 17/8 => float (aka 2.125)
1023 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1025 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
1028 return $x->{_n}->numify() if $x->{_d}->is_one();
1031 my $neg = 1; $neg = -1 if $x->{sign} ne '+';
1032 $neg * $x->{_n}->numify() / $x->{_d}->numify(); # return sign * N/D
1037 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1039 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1041 # need to disable these, otherwise bdiv() gives BigRat again
1042 local $Math::BigInt::upgrade = undef;
1043 local $Math::BigInt::accuracy = undef;
1044 local $Math::BigInt::precision = undef;
1045 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
1046 $t->{sign} = $x->{sign};
1054 my $lib = ''; my @a;
1055 for ( my $i = 0; $i < $l ; $i++)
1057 # print "at $_[$i] (",$_[$i+1]||'undef',")\n";
1058 if ( $_[$i] eq ':constant' )
1060 # this rest causes overlord er load to step in
1061 # print "overload @_\n";
1062 overload::constant float => sub { $self->new(shift); };
1064 # elsif ($_[$i] eq 'upgrade')
1066 # # this causes upgrading
1067 # $upgrade = $_[$i+1]; # or undef to disable
1070 elsif ($_[$i] eq 'downgrade')
1072 # this causes downgrading
1073 $downgrade = $_[$i+1]; # or undef to disable
1076 elsif ($_[$i] eq 'lib')
1078 $lib = $_[$i+1] || ''; # default Calc
1081 elsif ($_[$i] eq 'with')
1083 $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
1091 # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
1092 my $mbilib = eval { Math::BigInt->config()->{lib} };
1093 if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
1095 # MBI already loaded
1096 $MBI->import('lib',"$lib,$mbilib", 'objectify');
1100 # MBI not loaded, or not with "Math::BigInt"
1101 $lib .= ",$mbilib" if defined $mbilib;
1105 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1106 # used in the same script, or eval inside import().
1107 my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
1108 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
1109 $file = File::Spec->catfile (@parts, $file);
1110 eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
1114 my $rc = "use $MBI lib => '$lib', 'objectify';";
1120 require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
1123 # any non :constant stuff is handled by our parent, Exporter
1124 # even if @_ is empty, to give it a chance
1125 $self->SUPER::import(@a); # for subclasses
1126 $self->export_to_level(1,$self,@a); # need this, too
1135 Math::BigRat - arbitrarily big rationales
1141 $x = Math::BigRat->new('3/7'); $x += '5/9';
1143 print $x->bstr(),"\n";
1148 Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1149 for arbitrarily big rationales.
1153 Math with the numbers is done (by default) by a module called
1154 Math::BigInt::Calc. This is equivalent to saying:
1156 use Math::BigRat lib => 'Calc';
1158 You can change this by using:
1160 use Math::BigRat lib => 'BitVect';
1162 The following would first try to find Math::BigInt::Foo, then
1163 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1165 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1167 Calc.pm uses as internal format an array of elements of some decimal base
1168 (usually 1e7, but this might be different for some systems) with the least
1169 significant digit first, while BitVect.pm uses a bit vector of base 2, most
1170 significant bit first. Other modules might use even different means of
1171 representing the numbers. See the respective module documentation for further
1174 Currently the following replacement libraries exist, search for them at CPAN:
1176 Math::BigInt::BitVect
1179 Math::BigInt::FastCalc
1183 Any methods not listed here are dervied from Math::BigFloat (or
1184 Math::BigInt), so make sure you check these two modules for further
1189 $x = Math::BigRat->new('1/3');
1191 Create a new Math::BigRat object. Input can come in various forms:
1193 $x = Math::BigRat->new(123); # scalars
1194 $x = Math::BigRat->new('123.3'); # float
1195 $x = Math::BigRat->new('1/3'); # simple string
1196 $x = Math::BigRat->new('1 / 3'); # spaced
1197 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1198 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1199 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
1200 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
1204 $n = $x->numerator();
1206 Returns a copy of the numerator (the part above the line) as signed BigInt.
1208 =head2 denominator()
1210 $d = $x->denominator();
1212 Returns a copy of the denominator (the part under the line) as positive BigInt.
1216 ($n,$d) = $x->parts();
1218 Return a list consisting of (signed) numerator and (unsigned) denominator as
1223 $x = Math::BigRat->new('13/7');
1224 print $x->as_number(),"\n"; # '1'
1226 Returns a copy of the object as BigInt trunced it to integer.
1232 Calculates the factorial of $x. For instance:
1234 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1235 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
1237 Works currently only for integers.
1241 Is not yet implemented.
1243 =head2 bround()/round()/bfround()
1245 Are not yet implemented.
1250 my $x = Math::BigRat->new('7/4');
1251 my $y = Math::BigRat->new('4/3');
1254 Set $x to the remainder of the division of $x by $y.
1258 print "$x is 1\n" if $x->is_one();
1260 Return true if $x is exactly one, otherwise false.
1264 print "$x is 0\n" if $x->is_zero();
1266 Return true if $x is exactly zero, otherwise false.
1268 =head2 is_positive()
1270 print "$x is >= 0\n" if $x->is_positive();
1272 Return true if $x is positive (greater than or equal to zero), otherwise
1273 false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1275 =head2 is_negative()
1277 print "$x is < 0\n" if $x->is_negative();
1279 Return true if $x is negative (smaller than zero), otherwise false. Please
1280 note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1284 print "$x is an integer\n" if $x->is_int();
1286 Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1287 false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1291 print "$x is odd\n" if $x->is_odd();
1293 Return true if $x is odd, otherwise false.
1297 print "$x is even\n" if $x->is_even();
1299 Return true if $x is even, otherwise false.
1305 Set $x to the next bigger integer value (e.g. truncate the number to integer
1306 and then increment it by one).
1312 Truncate $x to an integer value.
1318 print Dumper ( Math::BigRat->config() );
1319 print Math::BigRat->config()->{lib},"\n";
1321 Returns a hash containing the configuration, e.g. the version number, lib
1322 loaded etc. The following hash keys are currently filled in with the
1323 appropriate information.
1325 key RO/RW Description
1327 ============================================================
1328 lib RO Name of the Math library
1330 lib_version RO Version of 'lib'
1332 class RO The class of config you just called
1334 version RO version number of the class you used
1336 upgrade RW To which class numbers are upgraded
1338 downgrade RW To which class numbers are downgraded
1340 precision RW Global precision
1342 accuracy RW Global accuracy
1344 round_mode RW Global round mode
1346 div_scale RW Fallback acccuracy for div
1348 trap_nan RW Trap creation of NaN (undef = no)
1350 trap_inf RW Trap creation of +inf/-inf (undef = no)
1353 By passing a reference to a hash you may set the configuration values. This
1354 works only for values that a marked with a C<RW> above, anything else is
1359 Some things are not yet implemented, or only implemented half-way:
1363 =item inf handling (partial)
1365 =item NaN handling (partial)
1367 =item rounding (not implemented except for bceil/bfloor)
1369 =item $x ** $y where $y is not an integer
1375 This program is free software; you may redistribute it and/or modify it under
1376 the same terms as Perl itself.
1380 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1381 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1383 See L<http://search.cpan.org/search?dist=bignum> for a way to use
1386 The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1387 may contain more documentation and examples as well as testcases.
1391 (C) by Tels L<http://bloodgate.com/> 2001-2002.