3 # The following hash values are used:
4 # sign : +,-,NaN,+inf,-inf
6 # _n : numeraotr (value = _n/_d)
9 # _f : flags, used by MBR to flag parts of a rationale as untouchable
18 use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
19 $accuracy $precision $round_mode $div_scale);
21 @ISA = qw(Exporter Math::BigFloat);
26 use overload; # inherit from Math::BigFloat
28 ##############################################################################
29 # global constants, flags and accessory
31 use constant MB_NEVER_ROUND => 0x0001;
33 $accuracy = $precision = undef;
40 my $class = 'Math::BigRat';
44 # turn a single float input into a rationale (like '0.1')
47 return $self->bnan() if $f->is_nan();
48 return $self->binf('-inf') if $f->{sign} eq '-inf';
49 return $self->binf('+inf') if $f->{sign} eq '+inf';
51 #print "f $f caller", join(' ',caller()),"\n";
52 $self->{_n} = $f->{_m}->copy(); # mantissa
53 $self->{_d} = Math::BigInt->bone();
54 $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
55 if ($f->{_e}->{sign} eq '-')
57 # something like Math::BigRat->new('0.1');
58 $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10
62 # something like Math::BigRat->new('10');
64 $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
66 # print "float new $self->{_n} / $self->{_d}\n";
72 # create a Math::BigRat
77 my $self = { }; bless $self,$class;
79 # print "ref ",ref($d),"\n";
82 # print "isa float ",$d->isa('Math::BigFloat'),"\n";
83 # print "isa int ",$d->isa('Math::BigInt'),"\n";
84 # print "isa rat ",$d->isa('Math::BigRat'),"\n";
87 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
89 if ((ref $n) && (!$n->isa('Math::BigRat')))
91 # print "is ref, but not rat\n";
92 if ($n->isa('Math::BigFloat'))
94 # print "is ref, and float\n";
95 return $self->_new_from_float($n)->bnorm();
97 if ($n->isa('Math::BigInt'))
99 # print "is ref, and int\n";
100 $self->{_n} = $n->copy(); # "mantissa" = $d
101 $self->{_d} = Math::BigInt->bone();
102 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
103 return $self->bnorm();
106 return $n->copy() if ref $n;
108 # print "is string\n";
112 $self->{_n} = Math::BigInt->bzero(); # undef => 0
113 $self->{_d} = Math::BigInt->bone();
115 return $self->bnorm();
117 # string input with / delimiter
118 if ($n =~ /\s*\/\s*/)
120 return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
121 return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
122 ($n,$d) = split (/\//,$n);
123 # try as BigFloats first
124 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
126 # one of them looks like a float
127 $self->_new_from_float(Math::BigFloat->new($n));
128 # now correct $self->{_n} due to $n
129 my $f = Math::BigFloat->new($d);
130 if ($f->{_e}->{sign} eq '-')
133 $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
137 $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1
142 $self->{_n} = Math::BigInt->new($n);
143 $self->{_d} = Math::BigInt->new($d);
144 return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
145 # inf handling is missing here
147 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
148 # if $d is negative, flip sign
149 $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
150 $self->{_d}->{sign} = '+'; # normalize
152 return $self->bnorm();
155 # simple string input
156 if (($n =~ /[\.eE]/))
159 # print "float-like string $d\n";
160 $self->_new_from_float(Math::BigFloat->new($n));
164 $self->{_n} = Math::BigInt->new($n);
165 $self->{_d} = Math::BigInt->bone();
166 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
173 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
175 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
177 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
181 # print "bstr $x->{sign} $x->{_n} $x->{_d}\n";
182 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
184 return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
185 return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr();
190 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
192 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
194 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
198 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
199 return $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
204 # reduce the number to the shortest form and remember this (so that we
205 # don't reduce again)
206 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
208 # this is to prevent automatically rounding when MBI's globals are set
209 $x->{_d}->{_f} = MB_NEVER_ROUND;
210 $x->{_n}->{_f} = MB_NEVER_ROUND;
211 # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
212 $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
213 $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
215 # normalize zeros to 0/1
216 if (($x->{sign} =~ /^[+-]$/) &&
217 ($x->{_n}->is_zero()))
219 $x->{sign} = '+'; # never -0
220 $x->{_d} = Math::BigInt->bone() unless $x->{_d}->is_one();
224 # print "$x->{_n} / $x->{_d} => ";
225 # reduce other numbers
226 my $gcd = $x->{_n}->bgcd($x->{_d});
230 $x->{_n}->bdiv($gcd);
231 $x->{_d}->bdiv($gcd);
233 # print "$x->{_n} / $x->{_d}\n";
237 ##############################################################################
242 # used by parent class bone() to initialize number to 1
244 $self->{_n} = Math::BigInt->bzero();
245 $self->{_d} = Math::BigInt->bzero();
250 # used by parent class bone() to initialize number to 1
252 $self->{_n} = Math::BigInt->bzero();
253 $self->{_d} = Math::BigInt->bzero();
258 # used by parent class bone() to initialize number to 1
260 $self->{_n} = Math::BigInt->bone();
261 $self->{_d} = Math::BigInt->bone();
266 # used by parent class bone() to initialize number to 1
268 $self->{_n} = Math::BigInt->bzero();
269 $self->{_d} = Math::BigInt->bone();
272 ##############################################################################
278 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
280 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
285 # return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
287 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
288 # - + - = --------- = --
291 my $gcd = $x->{_d}->bgcd($y->{_d});
293 my $aa = $x->{_d}->copy();
294 my $bb = $y->{_d}->copy();
297 $bb->bdiv($gcd); $aa->bdiv($gcd);
299 $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
300 my $m = $y->{_n}->copy()->bmul($aa);
301 $m->{sign} = $y->{sign}; # 2/1 - 2/1
304 $x->{_d}->bmul($y->{_d});
307 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
309 $x->bnorm()->round($a,$p,$r);
314 # subtract two rationales
315 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
317 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
323 # return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
325 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
326 # - + - = --------- = --
329 my $gcd = $x->{_d}->bgcd($y->{_d});
331 my $aa = $x->{_d}->copy();
332 my $bb = $y->{_d}->copy();
335 $bb->bdiv($gcd); $aa->bdiv($gcd);
337 $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
338 my $m = $y->{_n}->copy()->bmul($aa);
339 $m->{sign} = $y->{sign}; # 2/1 - 2/1
342 $x->{_d}->bmul($y->{_d});
345 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
347 $x->bnorm()->round($a,$p,$r);
352 # multiply two rationales
353 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
355 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
358 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
360 return $x->bnan() if $x->is_zero() || $y->is_zero();
361 # result will always be +-inf:
362 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
363 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
364 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
365 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
366 return $x->binf('-');
369 # x== 0 # also: or y == 1 or y == -1
370 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
375 # return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
377 # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
378 # and reducing in one step)
383 $x->{_n}->bmul($y->{_n});
384 $x->{_d}->bmul($y->{_d});
387 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
389 $x->bnorm()->round($a,$p,$r);
394 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
395 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
396 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
398 return $self->_div_inf($x,$y)
399 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
401 # x== 0 # also: or y == 1 or y == -1
402 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
404 # TODO: list context, upgrade
407 # return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
412 $x->{_n}->bmul($y->{_d});
413 $x->{_d}->bmul($y->{_n});
416 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
418 $x->bnorm()->round($a,$p,$r);
421 ##############################################################################
422 # is_foo methods (the rest is inherited)
426 # return true if arg (BRAT or num_str) is an integer
427 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
429 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
430 $x->{_d}->is_one(); # 1e-1 => no integer
436 # return true if arg (BRAT or num_str) is zero
437 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
439 return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
445 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
446 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
448 my $sign = shift || ''; $sign = '+' if $sign ne '-';
450 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
456 # return true if arg (BFLOAT or num_str) is odd or false if even
457 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
459 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
460 ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
466 # return true if arg (BINT or num_str) is even or false if odd
467 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
469 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
470 return 1 if ($x->{_d}->is_one() # x/3 is never
471 && $x->{_n}->is_even()); # but 4/1 is
477 *objectify = \&Math::BigInt::objectify;
480 ##############################################################################
481 # parts() and friends
485 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
487 my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
493 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
500 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
502 my $n = $x->{_n}->copy();
503 $n->{sign} = $x->{sign};
504 return ($x->{_n}->copy(),$x->{_d}->copy());
517 ##############################################################################
518 # special calc routines
522 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
524 return $x unless $x->{sign} =~ /^[+-]$/;
525 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
527 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1
529 $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
535 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
537 return $x unless $x->{sign} =~ /^[+-]$/;
538 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
540 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1
542 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
548 return Math::BigRat->bnan();
553 my ($self,$x,$y,@r) = objectify(2,@_);
555 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
556 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
557 return $x->bone(@r) if $y->is_zero();
558 return $x->round(@r) if $x->is_one() || $y->is_one();
559 if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
561 # if $x == -1 and odd/even y => +1/-1
562 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
563 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
565 # 1 ** -y => 1 / (1 ** |y|)
566 # so do test for negative $y after above's clause
567 # return $x->bnan() if $y->{sign} eq '-';
568 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
570 my $pow2 = $self->__one();
571 my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs();
572 my $two = Math::BigInt->new(2);
573 while (!$y1->is_one())
575 print "at $y1 (= $x)\n";
576 $pow2->bmul($x) if $y1->is_odd();
580 $x->bmul($pow2) unless $pow2->is_one();
581 # n ** -x => 1/n ** x
582 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
589 return Math::BigRat->bnan();
594 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
596 return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc
597 $x->{_d}->bsqrt($a,$p,$r);
598 $x->{_n}->bsqrt($a,$p,$r);
604 my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
606 $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
612 my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
614 $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
618 ##############################################################################
636 ##############################################################################
641 my ($self,$x,$y) = objectify(2,@_);
643 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
645 # handle +-inf and NaN
646 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
647 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
648 return +1 if $x->{sign} eq '+inf';
649 return -1 if $x->{sign} eq '-inf';
650 return -1 if $y->{sign} eq '+inf';
653 # check sign for speed first
654 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
655 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
658 my $xz = $x->{_n}->is_zero();
659 my $yz = $y->{_n}->is_zero();
660 return 0 if $xz && $yz; # 0 <=> 0
661 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
662 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
664 my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
665 my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
671 my ($self,$x,$y) = objectify(2,@_);
673 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
675 # handle +-inf and NaN
676 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
677 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
678 return +1; # inf is always bigger
681 my $t = $x->{_n} * $y->{_d};
682 my $u = $y->{_n} * $x->{_d};
686 ##############################################################################
687 # output conversation
691 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
693 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
694 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
695 $t->{sign} = $x->{sign};
702 # Math::BigInt->import(@_);
703 # $self->SUPER::import(@_); # need it for subclasses
704 # #$self->export_to_level(1,$self,@_); # need this ?
713 Math::BigRat - arbitrarily big rationales
719 $x = Math::BigRat->new('3/7');
721 print $x->bstr(),"\n";
725 This is just a placeholder until the real thing is up and running. Watch this
730 Math with the numbers is done (by default) by a module called
731 Math::BigInt::Calc. This is equivalent to saying:
733 use Math::BigRat lib => 'Calc';
735 You can change this by using:
737 use Math::BigRat lib => 'BitVect';
739 The following would first try to find Math::BigInt::Foo, then
740 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
742 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
744 Calc.pm uses as internal format an array of elements of some decimal base
745 (usually 1e7, but this might be differen for some systems) with the least
746 significant digit first, while BitVect.pm uses a bit vector of base 2, most
747 significant bit first. Other modules might use even different means of
748 representing the numbers. See the respective module documentation for further
755 $x = Math::BigRat->new('1/3');
757 Create a new Math::BigRat object. Input can come in various forms:
759 $x = Math::BigRat->new('1/3'); # simple string
760 $x = Math::BigRat->new('1 / 3'); # spaced
761 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
762 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
763 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
767 $n = $x->numerator();
769 Returns a copy of the numerator (the part above the line) as signed BigInt.
773 $d = $x->denominator();
775 Returns a copy of the denominator (the part under the line) as positive BigInt.
779 ($n,$d) = $x->parts();
781 Return a list consisting of (signed) numerator and (unsigned) denominator as
786 None know yet. Please see also L<Math::BigInt>.
790 This program is free software; you may redistribute it and/or modify it under
791 the same terms as Perl itself.
795 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
796 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
799 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigRat> may
800 contain more documentation and examples as well as testcases.
804 (C) by Tels L<http://bloodgate.com/> 2001-2002.