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 # inf handling is missing here
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 local $Math::BigInt::upgrade = undef;
574 local $Math::BigInt::accuracy = undef;
575 local $Math::BigInt::precision = undef;
577 my $u = $x->copy()->babs();
578 # do a "normal" division ($x/$y)
579 $u->{_d}->bmul($y->{_n});
580 $u->{_n}->bmul($y->{_d});
583 if (!$u->{_d}->is_one())
585 $u->{_n}->bdiv($u->{_d}); # 22/7 => 3/1 w/ truncate
586 # no need to set $u->{_d} to 1, since later we set it to $y->{_d}
587 #$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
591 $u->{_d} = $y->{_d}; # 1 * $y->{_d}, see floor above
592 $u->{_n}->bmul($y->{_n});
594 my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make abs
597 $x->{sign} = $xsign; # put sign back
599 $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(@r);
912 $x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt(@r);
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}->{_n}; # 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
1027 my $t = Math::BigFloat->new($x->{_n});
1028 $t->bneg() if $x->is_negative();
1035 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1037 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1039 # need to disable these, otherwise bdiv() gives BigRat again
1040 local $Math::BigInt::upgrade = undef;
1041 local $Math::BigInt::accuracy = undef;
1042 local $Math::BigInt::precision = undef;
1043 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
1044 $t->{sign} = $x->{sign};
1052 my $lib = ''; my @a;
1053 for ( my $i = 0; $i < $l ; $i++)
1055 # print "at $_[$i] (",$_[$i+1]||'undef',")\n";
1056 if ( $_[$i] eq ':constant' )
1058 # this rest causes overlord er load to step in
1059 # print "overload @_\n";
1060 overload::constant float => sub { $self->new(shift); };
1062 # elsif ($_[$i] eq 'upgrade')
1064 # # this causes upgrading
1065 # $upgrade = $_[$i+1]; # or undef to disable
1068 elsif ($_[$i] eq 'downgrade')
1070 # this causes downgrading
1071 $downgrade = $_[$i+1]; # or undef to disable
1074 elsif ($_[$i] eq 'lib')
1076 $lib = $_[$i+1] || ''; # default Calc
1079 elsif ($_[$i] eq 'with')
1081 $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
1089 # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
1090 my $mbilib = eval { Math::BigInt->config()->{lib} };
1091 if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
1093 # MBI already loaded
1094 $MBI->import('lib',"$lib,$mbilib", 'objectify');
1098 # MBI not loaded, or not with "Math::BigInt"
1099 $lib .= ",$mbilib" if defined $mbilib;
1103 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1104 # used in the same script, or eval inside import().
1105 my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
1106 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
1107 $file = File::Spec->catfile (@parts, $file);
1108 eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
1112 my $rc = "use $MBI lib => '$lib', 'objectify';";
1116 die ("Couldn't load $MBI: $! $@") if $@;
1118 # any non :constant stuff is handled by our parent, Exporter
1119 # even if @_ is empty, to give it a chance
1120 $self->SUPER::import(@a); # for subclasses
1121 $self->export_to_level(1,$self,@a); # need this, too
1130 Math::BigRat - arbitrarily big rationales
1136 $x = Math::BigRat->new('3/7'); $x += '5/9';
1138 print $x->bstr(),"\n";
1143 Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1144 for arbitrarily big rationales.
1148 Math with the numbers is done (by default) by a module called
1149 Math::BigInt::Calc. This is equivalent to saying:
1151 use Math::BigRat lib => 'Calc';
1153 You can change this by using:
1155 use Math::BigRat lib => 'BitVect';
1157 The following would first try to find Math::BigInt::Foo, then
1158 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1160 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1162 Calc.pm uses as internal format an array of elements of some decimal base
1163 (usually 1e7, but this might be different for some systems) with the least
1164 significant digit first, while BitVect.pm uses a bit vector of base 2, most
1165 significant bit first. Other modules might use even different means of
1166 representing the numbers. See the respective module documentation for further
1169 Currently the following replacement libraries exist, search for them at CPAN:
1171 Math::BigInt::BitVect
1174 Math::BigInt::FastCalc
1178 Any methods not listed here are dervied from Math::BigFloat (or
1179 Math::BigInt), so make sure you check these two modules for further
1184 $x = Math::BigRat->new('1/3');
1186 Create a new Math::BigRat object. Input can come in various forms:
1188 $x = Math::BigRat->new(123); # scalars
1189 $x = Math::BigRat->new('123.3'); # float
1190 $x = Math::BigRat->new('1/3'); # simple string
1191 $x = Math::BigRat->new('1 / 3'); # spaced
1192 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1193 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1194 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
1195 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
1199 $n = $x->numerator();
1201 Returns a copy of the numerator (the part above the line) as signed BigInt.
1203 =head2 denominator()
1205 $d = $x->denominator();
1207 Returns a copy of the denominator (the part under the line) as positive BigInt.
1211 ($n,$d) = $x->parts();
1213 Return a list consisting of (signed) numerator and (unsigned) denominator as
1218 $x = Math::BigRat->new('13/7');
1219 print $x->as_number(),"\n"; # '1'
1221 Returns a copy of the object as BigInt trunced it to integer.
1227 Calculates the factorial of $x. For instance:
1229 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1230 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
1232 Works currently only for integers.
1236 Is not yet implemented.
1238 =head2 bround()/round()/bfround()
1240 Are not yet implemented.
1245 my $x = Math::BigRat->new('7/4');
1246 my $y = Math::BigRat->new('4/3');
1249 Set $x to the remainder of the division of $x by $y.
1253 print "$x is 1\n" if $x->is_one();
1255 Return true if $x is exactly one, otherwise false.
1259 print "$x is 0\n" if $x->is_zero();
1261 Return true if $x is exactly zero, otherwise false.
1263 =head2 is_positive()
1265 print "$x is >= 0\n" if $x->is_positive();
1267 Return true if $x is positive (greater than or equal to zero), otherwise
1268 false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1270 =head2 is_negative()
1272 print "$x is < 0\n" if $x->is_negative();
1274 Return true if $x is negative (smaller than zero), otherwise false. Please
1275 note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1279 print "$x is an integer\n" if $x->is_int();
1281 Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1282 false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1286 print "$x is odd\n" if $x->is_odd();
1288 Return true if $x is odd, otherwise false.
1292 print "$x is even\n" if $x->is_even();
1294 Return true if $x is even, otherwise false.
1300 Set $x to the next bigger integer value (e.g. truncate the number to integer
1301 and then increment it by one).
1307 Truncate $x to an integer value.
1313 print Dumper ( Math::BigRat->config() );
1314 print Math::BigRat->config()->{lib},"\n";
1316 Returns a hash containing the configuration, e.g. the version number, lib
1317 loaded etc. The following hash keys are currently filled in with the
1318 appropriate information.
1320 key RO/RW Description
1322 ============================================================
1323 lib RO Name of the Math library
1325 lib_version RO Version of 'lib'
1327 class RO The class of config you just called
1329 version RO version number of the class you used
1331 upgrade RW To which class numbers are upgraded
1333 downgrade RW To which class numbers are downgraded
1335 precision RW Global precision
1337 accuracy RW Global accuracy
1339 round_mode RW Global round mode
1341 div_scale RW Fallback acccuracy for div
1343 trap_nan RW Trap creation of NaN (undef = no)
1345 trap_inf RW Trap creation of +inf/-inf (undef = no)
1348 By passing a reference to a hash you may set the configuration values. This
1349 works only for values that a marked with a C<RW> above, anything else is
1354 Some things are not yet implemented, or only implemented half-way:
1358 =item inf handling (partial)
1360 =item NaN handling (partial)
1362 =item rounding (not implemented except for bceil/bfloor)
1364 =item $x ** $y where $y is not an integer
1370 This program is free software; you may redistribute it and/or modify it under
1371 the same terms as Perl itself.
1375 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1376 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1378 See L<http://search.cpan.org/search?dist=bignum> for a way to use
1381 The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1382 may contain more documentation and examples as well as testcases.
1386 (C) by Tels L<http://bloodgate.com/> 2001-2002.