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 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
50 # turn a single float input into a rationale (like '0.1')
53 return $self->bnan() if $f->is_nan();
54 return $self->binf('-inf') if $f->{sign} eq '-inf';
55 return $self->binf('+inf') if $f->{sign} eq '+inf';
57 #print "f $f caller", join(' ',caller()),"\n";
58 $self->{_n} = $f->{_m}->copy(); # mantissa
59 $self->{_d} = Math::BigInt->bone();
60 $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
61 if ($f->{_e}->{sign} eq '-')
63 # something like Math::BigRat->new('0.1');
64 $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10
68 # something like Math::BigRat->new('10');
70 $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
72 # print "float new $self->{_n} / $self->{_d}\n";
78 # create a Math::BigRat
83 my $self = { }; bless $self,$class;
85 # print "ref ",ref($d),"\n";
88 # print "isa float ",$d->isa('Math::BigFloat'),"\n";
89 # print "isa int ",$d->isa('Math::BigInt'),"\n";
90 # print "isa rat ",$d->isa('Math::BigRat'),"\n";
93 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
95 if ((ref $n) && (!$n->isa('Math::BigRat')))
97 # print "is ref, but not rat\n";
98 if ($n->isa('Math::BigFloat'))
100 # print "is ref, and float\n";
101 return $self->_new_from_float($n)->bnorm();
103 if ($n->isa('Math::BigInt'))
105 # print "is ref, and int\n";
106 $self->{_n} = $n->copy(); # "mantissa" = $n
107 $self->{_d} = Math::BigInt->bone();
108 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
109 return $self->bnorm();
111 if ($n->isa('Math::BigInt::Lite'))
113 # print "is ref, and lite\n";
114 $self->{_n} = Math::BigInt->new($$n); # "mantissa" = $n
115 $self->{_d} = Math::BigInt->bone();
116 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
117 return $self->bnorm();
120 return $n->copy() if ref $n;
122 # print "is string\n";
126 $self->{_n} = Math::BigInt->bzero(); # undef => 0
127 $self->{_d} = Math::BigInt->bone();
129 return $self->bnorm();
131 # string input with / delimiter
132 if ($n =~ /\s*\/\s*/)
134 return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
135 return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
136 ($n,$d) = split (/\//,$n);
137 # try as BigFloats first
138 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
140 # one of them looks like a float
141 $self->_new_from_float(Math::BigFloat->new($n));
142 # now correct $self->{_n} due to $n
143 my $f = Math::BigFloat->new($d);
144 if ($f->{_e}->{sign} eq '-')
147 $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
151 $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1
156 $self->{_n} = Math::BigInt->new($n);
157 $self->{_d} = Math::BigInt->new($d);
158 return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
159 # inf handling is missing here
161 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
162 # if $d is negative, flip sign
163 $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
164 $self->{_d}->{sign} = '+'; # normalize
166 return $self->bnorm();
169 # simple string input
170 if (($n =~ /[\.eE]/))
173 # print "float-like string $d\n";
174 $self->_new_from_float(Math::BigFloat->new($n));
178 $self->{_n} = Math::BigInt->new($n);
179 $self->{_d} = Math::BigInt->bone();
180 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
185 ###############################################################################
189 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
191 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
193 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
197 # print "bstr $x->{sign} $x->{_n} $x->{_d}\n";
198 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
200 return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
201 return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr();
206 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
208 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
210 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
214 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
215 return $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
220 # reduce the number to the shortest form and remember this (so that we
221 # don't reduce again)
222 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
224 # this is to prevent automatically rounding when MBI's globals are set
225 $x->{_d}->{_f} = MB_NEVER_ROUND;
226 $x->{_n}->{_f} = MB_NEVER_ROUND;
227 # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
228 $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
229 $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
231 # normalize zeros to 0/1
232 if (($x->{sign} =~ /^[+-]$/) &&
233 ($x->{_n}->is_zero()))
235 $x->{sign} = '+'; # never -0
236 $x->{_d} = Math::BigInt->bone() unless $x->{_d}->is_one();
240 # print "$x->{_n} / $x->{_d} => ";
241 # reduce other numbers
242 # print "bgcd $x->{_n} (",ref($x->{_n}),") $x->{_d} (",ref($x->{_d}),")\n";
243 # disable upgrade in BigInt, otherwise deep recursion
244 local $Math::BigInt::upgrade = undef;
245 my $gcd = $x->{_n}->bgcd($x->{_d});
249 $x->{_n}->bdiv($gcd);
250 $x->{_d}->bdiv($gcd);
252 # print "$x->{_n} / $x->{_d}\n";
256 ##############################################################################
261 # used by parent class bone() to initialize number to 1
263 $self->{_n} = Math::BigInt->bzero();
264 $self->{_d} = Math::BigInt->bzero();
269 # used by parent class bone() to initialize number to 1
271 $self->{_n} = Math::BigInt->bzero();
272 $self->{_d} = Math::BigInt->bzero();
277 # used by parent class bone() to initialize number to 1
279 $self->{_n} = Math::BigInt->bone();
280 $self->{_d} = Math::BigInt->bone();
285 # used by parent class bone() to initialize number to 1
287 $self->{_n} = Math::BigInt->bzero();
288 $self->{_d} = Math::BigInt->bone();
291 ##############################################################################
297 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
299 $x = $class->new($x) unless $x->isa($class);
300 $y = $class->new($y) unless $y->isa($class);
302 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
304 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
305 # - + - = --------- = --
308 my $gcd = $x->{_d}->bgcd($y->{_d});
310 my $aa = $x->{_d}->copy();
311 my $bb = $y->{_d}->copy();
314 $bb->bdiv($gcd); $aa->bdiv($gcd);
316 $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
317 my $m = $y->{_n}->copy()->bmul($aa);
318 $m->{sign} = $y->{sign}; # 2/1 - 2/1
321 $x->{_d}->bmul($y->{_d});
324 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
326 $x->bnorm()->round($a,$p,$r);
331 # subtract two rationales
332 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
334 $x = $class->new($x) unless $x->isa($class);
335 $y = $class->new($y) unless $y->isa($class);
337 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
340 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
341 # - + - = --------- = --
344 my $gcd = $x->{_d}->bgcd($y->{_d});
346 my $aa = $x->{_d}->copy();
347 my $bb = $y->{_d}->copy();
350 $bb->bdiv($gcd); $aa->bdiv($gcd);
352 $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
353 my $m = $y->{_n}->copy()->bmul($aa);
354 $m->{sign} = $y->{sign}; # 2/1 - 2/1
357 $x->{_d}->bmul($y->{_d});
360 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
362 $x->bnorm()->round($a,$p,$r);
367 # multiply two rationales
368 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
370 $x = $class->new($x) unless $x->isa($class);
371 $y = $class->new($y) unless $y->isa($class);
373 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
376 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
378 return $x->bnan() if $x->is_zero() || $y->is_zero();
379 # result will always be +-inf:
380 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
381 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
382 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
383 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
384 return $x->binf('-');
387 # x== 0 # also: or y == 1 or y == -1
388 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
390 # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
391 # and reducing in one step)
396 $x->{_n}->bmul($y->{_n});
397 $x->{_d}->bmul($y->{_d});
400 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
402 $x->bnorm()->round($a,$p,$r);
407 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
408 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
409 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
411 $x = $class->new($x) unless $x->isa($class);
412 $y = $class->new($y) unless $y->isa($class);
414 return $self->_div_inf($x,$y)
415 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
417 # x== 0 # also: or y == 1 or y == -1
418 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
420 # TODO: list context, upgrade
425 $x->{_n}->bmul($y->{_d});
426 $x->{_d}->bmul($y->{_n});
429 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
431 $x->bnorm()->round($a,$p,$r);
434 ##############################################################################
435 # is_foo methods (the rest is inherited)
439 # return true if arg (BRAT or num_str) is an integer
440 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
442 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
443 $x->{_d}->is_one(); # 1e-1 => no integer
449 # return true if arg (BRAT or num_str) is zero
450 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
452 return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
458 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
459 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
461 my $sign = shift || ''; $sign = '+' if $sign ne '-';
463 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
469 # return true if arg (BFLOAT or num_str) is odd or false if even
470 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
472 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
473 ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
479 # return true if arg (BINT or num_str) is even or false if odd
480 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
482 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
483 return 1 if ($x->{_d}->is_one() # x/3 is never
484 && $x->{_n}->is_even()); # but 4/1 is
490 *objectify = \&Math::BigInt::objectify;
493 ##############################################################################
494 # parts() and friends
498 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
500 my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
506 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
513 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
515 my $n = $x->{_n}->copy();
516 $n->{sign} = $x->{sign};
517 return ($x->{_n}->copy(),$x->{_d}->copy());
530 ##############################################################################
531 # special calc routines
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 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
550 return $x unless $x->{sign} =~ /^[+-]$/;
551 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
553 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1
555 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
561 return Math::BigRat->bnan();
566 my ($self,$x,$y,@r) = objectify(2,@_);
568 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
569 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
570 return $x->bone(@r) if $y->is_zero();
571 return $x->round(@r) if $x->is_one() || $y->is_one();
572 if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
574 # if $x == -1 and odd/even y => +1/-1
575 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
576 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
578 # 1 ** -y => 1 / (1 ** |y|)
579 # so do test for negative $y after above's clause
580 # return $x->bnan() if $y->{sign} eq '-';
581 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
583 my $pow2 = $self->__one();
584 my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs();
585 my $two = Math::BigInt->new(2);
586 while (!$y1->is_one())
588 print "at $y1 (= $x)\n";
589 $pow2->bmul($x) if $y1->is_odd();
593 $x->bmul($pow2) unless $pow2->is_one();
594 # n ** -x => 1/n ** x
595 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
602 return Math::BigRat->bnan();
607 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
609 return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc
610 $x->{_d}->bsqrt($a,$p,$r);
611 $x->{_n}->bsqrt($a,$p,$r);
617 my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
619 $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
625 my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
627 $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
631 ##############################################################################
649 ##############################################################################
654 my ($self,$x,$y) = objectify(2,@_);
656 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
658 # handle +-inf and NaN
659 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
660 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
661 return +1 if $x->{sign} eq '+inf';
662 return -1 if $x->{sign} eq '-inf';
663 return -1 if $y->{sign} eq '+inf';
666 # check sign for speed first
667 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
668 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
671 my $xz = $x->{_n}->is_zero();
672 my $yz = $y->{_n}->is_zero();
673 return 0 if $xz && $yz; # 0 <=> 0
674 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
675 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
677 my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
678 my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
684 my ($self,$x,$y) = objectify(2,@_);
686 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
688 # handle +-inf and NaN
689 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
690 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
691 return +1; # inf is always bigger
694 my $t = $x->{_n} * $y->{_d};
695 my $u = $y->{_n} * $x->{_d};
699 ##############################################################################
700 # output conversation
704 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
706 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
707 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
708 $t->{sign} = $x->{sign};
715 # Math::BigInt->import(@_);
716 # $self->SUPER::import(@_); # need it for subclasses
717 # #$self->export_to_level(1,$self,@_); # need this ?
726 Math::BigRat - arbitrarily big rationales
732 $x = Math::BigRat->new('3/7');
734 print $x->bstr(),"\n";
738 This is just a placeholder until the real thing is up and running. Watch this
743 Math with the numbers is done (by default) by a module called
744 Math::BigInt::Calc. This is equivalent to saying:
746 use Math::BigRat lib => 'Calc';
748 You can change this by using:
750 use Math::BigRat lib => 'BitVect';
752 The following would first try to find Math::BigInt::Foo, then
753 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
755 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
757 Calc.pm uses as internal format an array of elements of some decimal base
758 (usually 1e7, but this might be differen for some systems) with the least
759 significant digit first, while BitVect.pm uses a bit vector of base 2, most
760 significant bit first. Other modules might use even different means of
761 representing the numbers. See the respective module documentation for further
768 $x = Math::BigRat->new('1/3');
770 Create a new Math::BigRat object. Input can come in various forms:
772 $x = Math::BigRat->new('1/3'); # simple string
773 $x = Math::BigRat->new('1 / 3'); # spaced
774 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
775 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
776 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
780 $n = $x->numerator();
782 Returns a copy of the numerator (the part above the line) as signed BigInt.
786 $d = $x->denominator();
788 Returns a copy of the denominator (the part under the line) as positive BigInt.
792 ($n,$d) = $x->parts();
794 Return a list consisting of (signed) numerator and (unsigned) denominator as
799 None know yet. Please see also L<Math::BigInt>.
803 This program is free software; you may redistribute it and/or modify it under
804 the same terms as Perl itself.
808 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
809 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
812 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigRat> may
813 contain more documentation and examples as well as testcases.
817 (C) by Tels L<http://bloodgate.com/> 2001-2002.