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 rational as untouchable
13 # You should not look at the innards of a BigRat - use the methods for this.
22 use vars qw($VERSION @ISA $upgrade $downgrade
23 $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
25 @ISA = qw(Exporter Math::BigFloat);
29 use overload; # inherit overload from Math::BigFloat
33 *objectify = \&Math::BigInt::objectify; # inherit this from BigInt
34 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
35 # we inherit these from BigFloat because currently it is not possible
36 # that MBF has a different $MBI variable than we, because MBF also uses
37 # Math::BigInt::config->('lib'); (there is always only one library loaded)
38 *_e_add = \&Math::BigFloat::_e_add;
39 *_e_sub = \&Math::BigFloat::_e_sub;
42 ##############################################################################
43 # Global constants and flags. Access these only via the accessor methods!
45 $accuracy = $precision = undef;
51 # These are internally, and not to be used from the outside at all!
53 $_trap_nan = 0; # are NaNs ok? set w/ config()
54 $_trap_inf = 0; # are infs ok? set w/ config()
56 # the package we are using for our private parts, defaults to:
57 # Math::BigInt->config()->{lib}
58 my $MBI = 'Math::BigInt::Calc';
61 my $class = 'Math::BigRat';
66 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
70 ##############################################################################
74 # turn a single float input into a rational number (like '0.1')
77 return $self->bnan() if $f->is_nan();
78 return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
80 $self->{_n} = $MBI->_copy( $f->{_m} ); # mantissa
81 $self->{_d} = $MBI->_one();
82 $self->{sign} = $f->{sign} || '+';
85 # something like Math::BigRat->new('0.1');
87 $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);
91 # something like Math::BigRat->new('10');
93 $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless
94 $MBI->_is_zero($f->{_e});
101 # create a Math::BigRat
106 my $self = { }; bless $self,$class;
108 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
110 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
112 if ($n->isa('Math::BigFloat'))
114 $self->_new_from_float($n);
116 if ($n->isa('Math::BigInt'))
118 # TODO: trap NaN, inf
119 $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = $n
120 $self->{_d} = $MBI->_one(); # d => 1
121 $self->{sign} = $n->{sign};
123 if ($n->isa('Math::BigInt::Lite'))
125 # TODO: trap NaN, inf
126 $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
127 $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n
128 $self->{_d} = $MBI->_one(); # d => 1
130 return $self->bnorm(); # normalize (120/1 => 12/10)
132 return $n->copy() if ref $n; # already a BigRat
136 $self->{_n} = $MBI->_zero(); # undef => 0
137 $self->{_d} = $MBI->_one();
142 # string input with / delimiter
143 if ($n =~ /\s*\/\s*/)
145 return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
146 return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
147 ($n,$d) = split (/\//,$n);
148 # try as BigFloats first
149 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
151 local $Math::BigFloat::accuracy = undef;
152 local $Math::BigFloat::precision = undef;
154 # one of them looks like a float
155 my $nf = Math::BigFloat->new($n,undef,undef);
157 return $self->bnan() if $nf->is_nan();
158 $self->{_n} = $MBI->_copy( $nf->{_m} ); # get mantissa
160 # now correct $self->{_n} due to $n
161 my $f = Math::BigFloat->new($d,undef,undef);
162 return $self->bnan() if $f->is_nan();
163 $self->{_d} = $MBI->_copy( $f->{_m} );
165 # calculate the difference between nE and dE
166 # XXX TODO: check that exponent() makes a copy to avoid copy()
167 my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
168 if ($diff_e->is_negative())
171 $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
173 elsif (!$diff_e->is_zero())
176 $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
181 # both d and n look like (big)ints
183 $self->{sign} = '+'; # no sign => '+'
186 if ($n =~ /^([+-]?)0*(\d+)\z/) # first part ok?
188 $self->{sign} = $1 || '+'; # no sign => '+'
189 $self->{_n} = $MBI->_new($2 || 0);
192 if ($d =~ /^([+-]?)0*(\d+)\z/) # second part ok?
194 $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg.
195 $self->{_d} = $MBI->_new($2 || 0);
198 if (!defined $self->{_n} || !defined $self->{_d})
200 $d = Math::BigInt->new($d,undef,undef) unless ref $d;
201 $n = Math::BigInt->new($n,undef,undef) unless ref $n;
203 if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
205 # both parts are ok as integers (wierd things like ' 1e0'
206 $self->{_n} = $MBI->_copy($n->{value});
207 $self->{_d} = $MBI->_copy($d->{value});
208 $self->{sign} = $n->{sign};
209 $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2
210 return $self->bnorm();
213 $self->{sign} = '+'; # a default sign
214 return $self->bnan() if $n->is_nan() || $d->is_nan();
217 if ($n->is_inf() || $d->is_inf())
221 return $self->bnan() if $d->is_inf(); # both are inf => NaN
222 my $s = '+'; # '+inf/+123' or '-inf/-123'
223 $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
225 return $self->binf($s);
228 return $self->bzero();
233 return $self->bnorm();
236 # simple string input
237 if (($n =~ /[\.eE]/))
239 # looks like a float, quacks like a float, so probably is a float
240 $self->{sign} = 'NaN';
241 local $Math::BigFloat::accuracy = undef;
242 local $Math::BigFloat::precision = undef;
243 $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
247 # for simple forms, use $MBI directly
248 if ($n =~ /^([+-]?)0*(\d+)\z/)
250 $self->{sign} = $1 || '+';
251 $self->{_n} = $MBI->_new($2 || 0);
252 $self->{_d} = $MBI->_one();
256 my $n = Math::BigInt->new($n,undef,undef);
257 $self->{_n} = $MBI->_copy($n->{value});
258 $self->{_d} = $MBI->_one();
259 $self->{sign} = $n->{sign};
260 return $self->bnan() if $self->{sign} eq 'NaN';
261 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
272 # if two arguments, the first one is the class to "swallow" subclasses
280 return unless ref($x); # only for objects
282 my $self = bless {}, $c;
284 $self->{sign} = $x->{sign};
285 $self->{_d} = $MBI->_copy($x->{_d});
286 $self->{_n} = $MBI->_copy($x->{_n});
287 $self->{_a} = $x->{_a} if defined $x->{_a};
288 $self->{_p} = $x->{_p} if defined $x->{_p};
292 ##############################################################################
296 # return (later set?) configuration data as hash ref
297 my $class = shift || 'Math::BigFloat';
299 my $cfg = $class->SUPER::config(@_);
301 # now we need only to override the ones that are different from our parent
302 $cfg->{class} = $class;
307 ##############################################################################
311 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
313 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
315 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
319 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
321 return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
322 $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
327 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
329 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
331 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
335 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
336 $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
341 # reduce the number to the shortest form
342 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
344 # Both parts must be objects of whatever we are using today.
345 # Second check because Calc.pm has ARRAY res as unblessed objects.
346 if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
348 require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
350 if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
352 require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
355 # no normalize for NaN, inf etc.
356 return $x if $x->{sign} !~ /^[+-]$/;
358 # normalize zeros to 0/1
359 if ($MBI->_is_zero($x->{_n}))
361 $x->{sign} = '+'; # never leave a -0
362 $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
366 return $x if $MBI->_is_one($x->{_d}); # no need to reduce
368 # reduce other numbers
369 my $gcd = $MBI->_copy($x->{_n});
370 $gcd = $MBI->_gcd($gcd,$x->{_d});
372 if (!$MBI->_is_one($gcd))
374 $x->{_n} = $MBI->_div($x->{_n},$gcd);
375 $x->{_d} = $MBI->_div($x->{_d},$gcd);
380 ##############################################################################
385 # used by parent class bnan() to initialize number to NaN
391 my $class = ref($self);
392 Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
394 $self->{_n} = $MBI->_zero();
395 $self->{_d} = $MBI->_zero();
400 # used by parent class bone() to initialize number to +inf/-inf
406 my $class = ref($self);
407 Carp::croak ("Tried to set $self to inf in $class\::_binf()");
409 $self->{_n} = $MBI->_zero();
410 $self->{_d} = $MBI->_zero();
415 # used by parent class bone() to initialize number to +1/-1
417 $self->{_n} = $MBI->_one();
418 $self->{_d} = $MBI->_one();
423 # used by parent class bzero() to initialize number to 0
425 $self->{_n} = $MBI->_zero();
426 $self->{_d} = $MBI->_one();
429 ##############################################################################
434 # add two rational numbers
437 my ($self,$x,$y,@r) = (ref($_[0]),@_);
438 # objectify is costly, so avoid it
439 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
441 ($self,$x,$y,@r) = objectify(2,@_);
444 # +inf + +inf => +inf, -inf + -inf => -inf
445 return $x->binf(substr($x->{sign},0,1))
446 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
448 # +inf + -inf or -inf + +inf => NaN
449 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
451 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
452 # - + - = --------- = --
455 # we do not compute the gcd() here, but simple do:
457 # - + - = --------- = --
460 # and bnorm() will then take care of the rest
462 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
464 my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} );
466 ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign});
468 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
470 # normalize and round
471 $x->bnorm()->round(@r);
476 # subtract two rational numbers
479 my ($self,$x,$y,@r) = (ref($_[0]),@_);
480 # objectify is costly, so avoid it
481 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
483 ($self,$x,$y,@r) = objectify(2,@_);
486 # flip sign of $x, call badd(), then flip sign of result
487 $x->{sign} =~ tr/+-/-+/
488 unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
489 $x->badd($y,@r); # does norm and round
490 $x->{sign} =~ tr/+-/-+/
491 unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
497 # multiply two rational numbers
500 my ($self,$x,$y,@r) = (ref($_[0]),@_);
501 # objectify is costly, so avoid it
502 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
504 ($self,$x,$y,@r) = objectify(2,@_);
507 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
510 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
512 return $x->bnan() if $x->is_zero() || $y->is_zero();
513 # result will always be +-inf:
514 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
515 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
516 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
517 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
518 return $x->binf('-');
521 # x== 0 # also: or y == 1 or y == -1
522 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
525 # According to Knuth, this can be optimized by doing gcd twice (for d and n)
526 # and reducing in one step. This would save us the bnorm() at the end.
529 # - * - = ----- = - = -
532 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n});
533 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
536 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
538 $x->bnorm()->round(@r);
543 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
544 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
547 my ($self,$x,$y,@r) = (ref($_[0]),@_);
548 # objectify is costly, so avoid it
549 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
551 ($self,$x,$y,@r) = objectify(2,@_);
554 return $self->_div_inf($x,$y)
555 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
557 # x== 0 # also: or y == 1 or y == -1
558 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
560 # XXX TODO: list context, upgrade
561 # According to Knuth, this can be optimized by doing gcd twice (for d and n)
562 # and reducing in one step. This would save us the bnorm() at the end.
568 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
569 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n});
572 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
574 $x->bnorm()->round(@r);
580 # compute "remainder" (in Perl way) of $x / $y
583 my ($self,$x,$y,@r) = (ref($_[0]),@_);
584 # objectify is costly, so avoid it
585 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
587 ($self,$x,$y,@r) = objectify(2,@_);
590 return $self->_div_inf($x,$y)
591 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
593 return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
595 # compute $x - $y * floor($x/$y), keeping the sign of $x
597 # copy x to u, make it positive and then do a normal division ($u/$y)
598 my $u = bless { sign => '+' }, $self;
599 $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
600 $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
603 if (! $MBI->_is_one($u->{_d}))
605 $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate
606 # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
609 # now compute $y * $u
610 $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above
611 $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
613 my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive
616 $x->{sign} = $xsign; # put sign back
618 $x->bnorm()->round(@r);
621 ##############################################################################
626 # decrement value (subtract 1)
627 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
629 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
631 if ($x->{sign} eq '-')
633 $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d}); # -5/2 => -7/2
637 if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d?
640 $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
645 $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
648 $x->bnorm()->round(@r);
653 # increment value (add 1)
654 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
656 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
658 if ($x->{sign} eq '-')
660 if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)
662 # -1/3 ++ => 2/3 (overflow at 0)
663 $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
668 $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
673 $x->{_n} = $MBI->_add($x->{_n},$x->{_d}); # 5/2 => 7/2
675 $x->bnorm()->round(@r);
678 ##############################################################################
679 # is_foo methods (the rest is inherited)
683 # return true if arg (BRAT or num_str) is an integer
684 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
686 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
687 $MBI->_is_one($x->{_d}); # x/y && y != 1 => no integer
693 # return true if arg (BRAT or num_str) is zero
694 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
696 return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});
702 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
703 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
705 my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
707 if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}));
713 # return true if arg (BFLOAT or num_str) is odd or false if even
714 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
716 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
717 ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1
723 # return true if arg (BINT or num_str) is even or false if odd
724 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
726 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
727 return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never
728 && $MBI->_is_even($x->{_n})); # but 4/1 is
732 ##############################################################################
733 # parts() and friends
737 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
740 return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
742 my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign};
748 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
751 return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
753 return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
755 Math::BigInt->new($MBI->_str($x->{_d}));
760 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
762 my $c = 'Math::BigInt';
764 return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN';
765 return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf';
766 return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf';
768 my $n = $c->new( $MBI->_str($x->{_n}));
769 $n->{sign} = $x->{sign};
770 my $d = $c->new( $MBI->_str($x->{_d}));
776 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
778 return $nan unless $x->is_int();
779 $MBI->_len($x->{_n}); # length(-123/1) => length(123)
784 my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_);
786 return $nan unless $x->is_int();
787 $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2)
790 ##############################################################################
791 # special calc routines
795 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
797 return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
798 $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
800 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
801 $x->{_d} = $MBI->_one(); # d => 1
802 $x->{_n} = $MBI->_inc($x->{_n})
803 if $x->{sign} eq '+'; # +22/7 => 4/1
804 $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0
810 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
812 return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
813 $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
815 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
816 $x->{_d} = $MBI->_one(); # d => 1
817 $x->{_n} = $MBI->_inc($x->{_n})
818 if $x->{sign} eq '-'; # -22/7 => -4/1
824 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
826 # if $x is not an integer
827 if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d})))
832 $x->{_n} = $MBI->_fac($x->{_n});
833 # since _d is 1, we don't need to reduce/norm the result
842 my ($self,$x,$y,@r) = (ref($_[0]),@_);
843 # objectify is costly, so avoid it
844 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
846 ($self,$x,$y,@r) = objectify(2,@_);
849 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
850 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
851 return $x->bone(@r) if $y->is_zero();
852 return $x->round(@r) if $x->is_one() || $y->is_one();
854 if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}))
856 # if $x == -1 and odd/even y => +1/-1
857 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
858 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
860 # 1 ** -y => 1 / (1 ** |y|)
861 # so do test for negative $y after above's clause
863 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
865 # shortcut y/1 (and/or x/1)
866 if ($MBI->_is_one($y->{_d}))
868 # shortcut for x/1 and y/1
869 if ($MBI->_is_one($x->{_d}))
871 $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1
872 if ($y->{sign} eq '-')
874 # 0.2 ** -3 => 1/(0.2 ** 3)
875 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
877 # correct sign; + ** + => +
878 if ($x->{sign} eq '-')
880 # - * - => +, - * - * - => -
881 $x->{sign} = '+' if $MBI->_is_even($y->{_n});
883 return $x->round(@r);
886 $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
887 $x->{_d} = $MBI->_pow($x->{_d},$y->{_n});
888 if ($y->{sign} eq '-')
890 # 0.2 ** -3 => 1/(0.2 ** 3)
891 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
893 # correct sign; + ** + => +
894 if ($x->{sign} eq '-')
896 # - * - => +, - * - * - => -
897 $x->{sign} = '+' if $MBI->_is_even($y->{_n});
899 return $x->round(@r);
902 # regular calculation (this is wrong for d/e ** f/g)
903 my $pow2 = $self->bone();
904 my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
905 my $two = $MBI->_two();
907 while (!$MBI->_is_one($y1))
909 $pow2->bmul($x) if $MBI->_is_odd($y1);
910 $MBI->_div($y1, $two);
913 $x->bmul($pow2) unless $pow2->is_one();
914 # n ** -x => 1/n ** x
915 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
916 $x->bnorm()->round(@r);
922 my ($self,$x,$y,@r) = (ref($_[0]),@_);
924 # objectify is costly, so avoid it
925 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
927 ($self,$x,$y,@r) = objectify(2,$class,@_);
931 return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
934 return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
936 if ($x->is_int() && $y->is_int())
938 return $self->new($x->as_number()->blog($y->as_number(),@r));
942 $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
949 my $f = Math::BigFloat->bzero();
950 $f->{_m} = $MBI->_copy($x);
951 $f->{_e} = $MBI->_zero();
960 local $Math::BigFloat::upgrade = undef;
961 local $Math::BigFloat::accuracy = undef;
962 local $Math::BigFloat::precision = undef;
963 # 22/7 => 3.142857143..
965 my $a = $x->accuracy() || 0;
966 if ($a != 0 || !$MBI->_is_one($x->{_d}))
969 return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
972 Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
978 my ($self,$x,$y,@r) = (ref($_[0]),@_);
979 # objectify is costly, so avoid it
980 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
982 ($self,$x,$y,@r) = objectify(2,@_);
985 if ($x->is_int() && $y->is_int())
987 return $self->new($x->as_number()->broot($y->as_number(),@r));
991 $x->_new_from_float( $x->_as_float()->broot($y,@r) );
997 my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
998 # objectify is costly, so avoid it
999 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1001 ($self,$x,$y,$m,@r) = objectify(3,@_);
1004 # $x or $y or $m are NaN or +-inf => NaN
1006 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
1007 $m->{sign} !~ /^[+-]$/;
1009 if ($x->is_int() && $y->is_int() && $m->is_int())
1011 return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
1014 warn ("bmodpow() not fully implemented");
1021 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1022 # objectify is costly, so avoid it
1023 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1025 ($self,$x,$y,@r) = objectify(2,@_);
1028 # $x or $y are NaN or +-inf => NaN
1030 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
1032 if ($x->is_int() && $y->is_int())
1034 return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
1037 warn ("bmodinv() not fully implemented");
1043 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1045 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1046 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1047 return $x->round(@r) if $x->is_zero() || $x->is_one();
1049 local $Math::BigFloat::upgrade = undef;
1050 local $Math::BigFloat::downgrade = undef;
1051 local $Math::BigFloat::precision = undef;
1052 local $Math::BigFloat::accuracy = undef;
1053 local $Math::BigInt::upgrade = undef;
1054 local $Math::BigInt::precision = undef;
1055 local $Math::BigInt::accuracy = undef;
1057 $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
1058 $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();
1060 # XXX TODO: we probably can optimze this:
1062 # if sqrt(D) was not integer
1063 if ($x->{_d}->{_es} ne '+')
1065 $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1
1066 $x->{_d} = $MBI->_copy( $x->{_d}->{_m} ); # 7.1/45.1 => 71/45.1
1068 # if sqrt(N) was not integer
1069 if ($x->{_n}->{_es} ne '+')
1071 $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1
1072 $x->{_n} = $MBI->_copy( $x->{_n}->{_m} ); # 710/45.1 => 710/451
1075 # convert parts to $MBI again
1076 $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
1077 if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
1078 $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
1079 if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';
1081 $x->bnorm()->round(@r);
1086 my ($self,$x,$y,$b,@r) = objectify(3,@_);
1088 $b = 2 unless defined $b;
1089 $b = $self->new($b) unless ref ($b);
1090 $x->bmul( $b->copy()->bpow($y), @r);
1096 my ($self,$x,$y,$b,@r) = objectify(3,@_);
1098 $b = 2 unless defined $b;
1099 $b = $self->new($b) unless ref ($b);
1100 $x->bdiv( $b->copy()->bpow($y), @r);
1104 ##############################################################################
1122 ##############################################################################
1127 # compare two signed numbers
1130 my ($self,$x,$y) = (ref($_[0]),@_);
1131 # objectify is costly, so avoid it
1132 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1134 ($self,$x,$y) = objectify(2,@_);
1137 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1139 # handle +-inf and NaN
1140 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1141 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1142 return +1 if $x->{sign} eq '+inf';
1143 return -1 if $x->{sign} eq '-inf';
1144 return -1 if $y->{sign} eq '+inf';
1147 # check sign for speed first
1148 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1149 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1152 my $xz = $MBI->_is_zero($x->{_n});
1153 my $yz = $MBI->_is_zero($y->{_n});
1154 return 0 if $xz && $yz; # 0 <=> 0
1155 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1156 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1158 my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1159 my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1161 my $cmp = $MBI->_acmp($t,$u); # signs are equal
1162 $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
1168 # compare two numbers (as unsigned)
1171 my ($self,$x,$y) = (ref($_[0]),@_);
1172 # objectify is costly, so avoid it
1173 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1175 ($self,$x,$y) = objectify(2,$class,@_);
1178 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1180 # handle +-inf and NaN
1181 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1182 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1183 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1187 my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1188 my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1189 $MBI->_acmp($t,$u); # ignore signs
1192 ##############################################################################
1193 # output conversation
1197 # convert 17/8 => float (aka 2.125)
1198 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
1200 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
1203 return $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
1206 my $neg = 1; $neg = -1 if $x->{sign} ne '+';
1207 $neg * $MBI->_num($x->{_n}) / $MBI->_num($x->{_d}); # return sign * N/D
1212 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1214 return Math::BigInt->new($x) if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1216 my $u = Math::BigInt->bzero();
1217 $u->{sign} = $x->{sign};
1218 $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
1224 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1226 return $x unless $x->is_int();
1228 my $s = $x->{sign}; $s = '' if $s eq '+';
1229 $s . $MBI->_as_bin($x->{_n});
1234 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1236 return $x unless $x->is_int();
1238 my $s = $x->{sign}; $s = '' if $s eq '+';
1239 $s . $MBI->_as_hex($x->{_n});
1246 my $lib = ''; my @a;
1249 for ( my $i = 0; $i < $l ; $i++)
1251 # print "at $_[$i] (",$_[$i+1]||'undef',")\n";
1252 if ( $_[$i] eq ':constant' )
1254 # this rest causes overlord er load to step in
1255 # print "overload @_\n";
1256 overload::constant float => sub { $self->new(shift); };
1258 # elsif ($_[$i] eq 'upgrade')
1260 # # this causes upgrading
1261 # $upgrade = $_[$i+1]; # or undef to disable
1264 elsif ($_[$i] eq 'downgrade')
1266 # this causes downgrading
1267 $downgrade = $_[$i+1]; # or undef to disable
1270 elsif ($_[$i] eq 'lib')
1272 $lib = $_[$i+1] || ''; # default Calc
1275 elsif ($_[$i] eq 'with')
1277 $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
1285 # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still work
1286 my $mbilib = eval { Math::BigInt->config()->{lib} };
1287 if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
1289 # MBI already loaded
1290 $MBI->import('lib',"$lib,$mbilib", 'objectify');
1294 # MBI not loaded, or not with "Math::BigInt"
1295 $lib .= ",$mbilib" if defined $mbilib;
1299 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
1300 # used in the same script, or eval inside import().
1301 my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
1302 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
1303 $file = File::Spec->catfile (@parts, $file);
1304 eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
1308 my $rc = "use $MBI lib => '$lib', 'objectify';";
1314 require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
1317 $MBI = Math::BigFloat->config()->{lib};
1319 # any non :constant stuff is handled by our parent, Exporter
1320 # even if @_ is empty, to give it a chance
1321 $self->SUPER::import(@a); # for subclasses
1322 $self->export_to_level(1,$self,@a); # need this, too
1331 Math::BigRat - arbitrarily big rational numbers
1337 my $x = Math::BigRat->new('3/7'); $x += '5/9';
1339 print $x->bstr(),"\n";
1342 my $y = Math::BigRat->new('inf');
1343 print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
1345 my $z = Math::BigRat->new(144); $z->bsqrt();
1349 Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1350 for arbitrarily big rational numbers.
1354 Math with the numbers is done (by default) by a module called
1355 Math::BigInt::Calc. This is equivalent to saying:
1357 use Math::BigRat lib => 'Calc';
1359 You can change this by using:
1361 use Math::BigRat lib => 'BitVect';
1363 The following would first try to find Math::BigInt::Foo, then
1364 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1366 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1368 Calc.pm uses as internal format an array of elements of some decimal base
1369 (usually 1e7, but this might be different for some systems) with the least
1370 significant digit first, while BitVect.pm uses a bit vector of base 2, most
1371 significant bit first. Other modules might use even different means of
1372 representing the numbers. See the respective module documentation for further
1375 Currently the following replacement libraries exist, search for them at CPAN:
1377 Math::BigInt::BitVect
1380 Math::BigInt::FastCalc
1384 Any methods not listed here are dervied from Math::BigFloat (or
1385 Math::BigInt), so make sure you check these two modules for further
1390 $x = Math::BigRat->new('1/3');
1392 Create a new Math::BigRat object. Input can come in various forms:
1394 $x = Math::BigRat->new(123); # scalars
1395 $x = Math::BigRat->new('inf'); # infinity
1396 $x = Math::BigRat->new('123.3'); # float
1397 $x = Math::BigRat->new('1/3'); # simple string
1398 $x = Math::BigRat->new('1 / 3'); # spaced
1399 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1400 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1401 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
1402 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
1406 $n = $x->numerator();
1408 Returns a copy of the numerator (the part above the line) as signed BigInt.
1410 =head2 denominator()
1412 $d = $x->denominator();
1414 Returns a copy of the denominator (the part under the line) as positive BigInt.
1418 ($n,$d) = $x->parts();
1420 Return a list consisting of (signed) numerator and (unsigned) denominator as
1425 $x = Math::BigRat->new('13/7');
1426 print $x->as_number(),"\n"; # '1'
1428 Returns a copy of the object as BigInt trunced it to integer.
1434 Calculates the factorial of $x. For instance:
1436 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1437 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
1439 Works currently only for integers.
1443 Is not yet implemented.
1445 =head2 bround()/round()/bfround()
1447 Are not yet implemented.
1452 my $x = Math::BigRat->new('7/4');
1453 my $y = Math::BigRat->new('4/3');
1456 Set $x to the remainder of the division of $x by $y.
1460 print "$x is 1\n" if $x->is_one();
1462 Return true if $x is exactly one, otherwise false.
1466 print "$x is 0\n" if $x->is_zero();
1468 Return true if $x is exactly zero, otherwise false.
1470 =head2 is_positive()
1472 print "$x is >= 0\n" if $x->is_positive();
1474 Return true if $x is positive (greater than or equal to zero), otherwise
1475 false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1477 =head2 is_negative()
1479 print "$x is < 0\n" if $x->is_negative();
1481 Return true if $x is negative (smaller than zero), otherwise false. Please
1482 note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1486 print "$x is an integer\n" if $x->is_int();
1488 Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1489 false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1493 print "$x is odd\n" if $x->is_odd();
1495 Return true if $x is odd, otherwise false.
1499 print "$x is even\n" if $x->is_even();
1501 Return true if $x is even, otherwise false.
1507 Set $x to the next bigger integer value (e.g. truncate the number to integer
1508 and then increment it by one).
1514 Truncate $x to an integer value.
1520 Calculate the square root of $x.
1526 print Dumper ( Math::BigRat->config() );
1527 print Math::BigRat->config()->{lib},"\n";
1529 Returns a hash containing the configuration, e.g. the version number, lib
1530 loaded etc. The following hash keys are currently filled in with the
1531 appropriate information.
1533 key RO/RW Description
1535 ============================================================
1536 lib RO Name of the Math library
1538 lib_version RO Version of 'lib'
1540 class RO The class of config you just called
1542 version RO version number of the class you used
1544 upgrade RW To which class numbers are upgraded
1546 downgrade RW To which class numbers are downgraded
1548 precision RW Global precision
1550 accuracy RW Global accuracy
1552 round_mode RW Global round mode
1554 div_scale RW Fallback acccuracy for div
1556 trap_nan RW Trap creation of NaN (undef = no)
1558 trap_inf RW Trap creation of +inf/-inf (undef = no)
1561 By passing a reference to a hash you may set the configuration values. This
1562 works only for values that a marked with a C<RW> above, anything else is
1567 Some things are not yet implemented, or only implemented half-way:
1571 =item inf handling (partial)
1573 =item NaN handling (partial)
1575 =item rounding (not implemented except for bceil/bfloor)
1577 =item $x ** $y where $y is not an integer
1579 =item bmod(), blog(), bmodinv() and bmodpow() (partial)
1585 This program is free software; you may redistribute it and/or modify it under
1586 the same terms as Perl itself.
1590 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1591 L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1593 See L<http://search.cpan.org/search?dist=bignum> for a way to use
1596 The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1597 may contain more documentation and examples as well as testcases.
1601 (C) by Tels L<http://bloodgate.com/> 2001, 2002, 2003, 2004.