ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/lib/Math/BigRat.pm
Revision: 1.1
Committed: Thu Jun 30 14:27:13 2005 UTC (21 years, 4 months ago) by root
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1
2     #
3     # "Tax the rat farms." - Lord Vetinari
4     #
5    
6     # The following hash values are used:
7     # sign : +,-,NaN,+inf,-inf
8     # _d : denominator
9     # _n : numeraotr (value = _n/_d)
10     # _a : accuracy
11     # _p : precision
12     # You should not look at the innards of a BigRat - use the methods for this.
13    
14     package Math::BigRat;
15    
16     require 5.005_03;
17     use strict;
18    
19     use Math::BigFloat;
20     use vars qw($VERSION @ISA $upgrade $downgrade
21     $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
22    
23     @ISA = qw(Math::BigFloat);
24    
25     $VERSION = '0.15';
26    
27     use overload; # inherit overload from Math::BigFloat
28    
29     BEGIN
30     {
31     *objectify = \&Math::BigInt::objectify; # inherit this from BigInt
32     *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
33     # we inherit these from BigFloat because currently it is not possible
34     # that MBF has a different $MBI variable than we, because MBF also uses
35     # Math::BigInt::config->('lib'); (there is always only one library loaded)
36     *_e_add = \&Math::BigFloat::_e_add;
37     *_e_sub = \&Math::BigFloat::_e_sub;
38     *as_int = \&as_number;
39     *is_pos = \&is_positive;
40     *is_neg = \&is_negative;
41     }
42    
43     ##############################################################################
44     # Global constants and flags. Access these only via the accessor methods!
45    
46     $accuracy = $precision = undef;
47     $round_mode = 'even';
48     $div_scale = 40;
49     $upgrade = undef;
50     $downgrade = undef;
51    
52     # These are internally, and not to be used from the outside at all!
53    
54     $_trap_nan = 0; # are NaNs ok? set w/ config()
55     $_trap_inf = 0; # are infs ok? set w/ config()
56    
57     # the package we are using for our private parts, defaults to:
58     # Math::BigInt->config()->{lib}
59     my $MBI = 'Math::BigInt::Calc';
60    
61     my $nan = 'NaN';
62     my $class = 'Math::BigRat';
63    
64     sub isa
65     {
66     return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
67     UNIVERSAL::isa(@_);
68     }
69    
70     ##############################################################################
71    
72     sub _new_from_float
73     {
74     # turn a single float input into a rational number (like '0.1')
75     my ($self,$f) = @_;
76    
77     return $self->bnan() if $f->is_nan();
78     return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
79    
80     $self->{_n} = $MBI->_copy( $f->{_m} ); # mantissa
81     $self->{_d} = $MBI->_one();
82     $self->{sign} = $f->{sign} || '+';
83     if ($f->{_es} eq '-')
84     {
85     # something like Math::BigRat->new('0.1');
86     # 1 / 1 => 1/10
87     $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);
88     }
89     else
90     {
91     # something like Math::BigRat->new('10');
92     # 1 / 1 => 10/1
93     $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless
94     $MBI->_is_zero($f->{_e});
95     }
96     $self;
97     }
98    
99     sub new
100     {
101     # create a Math::BigRat
102     my $class = shift;
103    
104     my ($n,$d) = @_;
105    
106     my $self = { }; bless $self,$class;
107    
108     # input like (BigInt) or (BigFloat):
109     if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
110     {
111     if ($n->isa('Math::BigFloat'))
112     {
113     $self->_new_from_float($n);
114     }
115     if ($n->isa('Math::BigInt'))
116     {
117     # TODO: trap NaN, inf
118     $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
119     $self->{_d} = $MBI->_one(); # d => 1
120     $self->{sign} = $n->{sign};
121     }
122     if ($n->isa('Math::BigInt::Lite'))
123     {
124     # TODO: trap NaN, inf
125     $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
126     $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N
127     $self->{_d} = $MBI->_one(); # d => 1
128     }
129     return $self->bnorm(); # normalize (120/1 => 12/10)
130     }
131    
132     # input like (BigInt,BigInt) or (BigLite,BigLite):
133     if (ref($d) && ref($n))
134     {
135     # do N first (for $self->{sign}):
136     if ($n->isa('Math::BigInt'))
137     {
138     # TODO: trap NaN, inf
139     $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
140     $self->{sign} = $n->{sign};
141     }
142     elsif ($n->isa('Math::BigInt::Lite'))
143     {
144     # TODO: trap NaN, inf
145     $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
146     $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n
147     }
148     else
149     {
150     require Carp;
151     Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
152     }
153     # now D:
154     if ($d->isa('Math::BigInt'))
155     {
156     # TODO: trap NaN, inf
157     $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D
158     # +/+ or -/- => +, +/- or -/+ => -
159     $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
160     }
161     elsif ($d->isa('Math::BigInt::Lite'))
162     {
163     # TODO: trap NaN, inf
164     $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D
165     my $ds = '+'; $ds = '-' if $$d < 0;
166     # +/+ or -/- => +, +/- or -/+ => -
167     $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
168     }
169     else
170     {
171     require Carp;
172     Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
173     }
174     return $self->bnorm(); # normalize (120/1 => 12/10)
175     }
176     return $n->copy() if ref $n; # already a BigRat
177    
178     if (!defined $n)
179     {
180     $self->{_n} = $MBI->_zero(); # undef => 0
181     $self->{_d} = $MBI->_one();
182     $self->{sign} = '+';
183     return $self;
184     }
185    
186     # string input with / delimiter
187     if ($n =~ /\s*\/\s*/)
188     {
189     return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
190     return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
191     ($n,$d) = split (/\//,$n);
192     # try as BigFloats first
193     if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
194     {
195     local $Math::BigFloat::accuracy = undef;
196     local $Math::BigFloat::precision = undef;
197    
198     # one of them looks like a float
199     my $nf = Math::BigFloat->new($n,undef,undef);
200     $self->{sign} = '+';
201     return $self->bnan() if $nf->is_nan();
202    
203     $self->{_n} = $MBI->_copy( $nf->{_m} ); # get mantissa
204    
205     # now correct $self->{_n} due to $n
206     my $f = Math::BigFloat->new($d,undef,undef);
207     return $self->bnan() if $f->is_nan();
208     $self->{_d} = $MBI->_copy( $f->{_m} );
209    
210     # calculate the difference between nE and dE
211     # XXX TODO: check that exponent() makes a copy to avoid copy()
212     my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
213     if ($diff_e->is_negative())
214     {
215     # < 0: mul d with it
216     $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
217     }
218     elsif (!$diff_e->is_zero())
219     {
220     # > 0: mul n with it
221     $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
222     }
223     }
224     else
225     {
226     # both d and n look like (big)ints
227    
228     $self->{sign} = '+'; # no sign => '+'
229     $self->{_n} = undef;
230     $self->{_d} = undef;
231     if ($n =~ /^([+-]?)0*(\d+)\z/) # first part ok?
232     {
233     $self->{sign} = $1 || '+'; # no sign => '+'
234     $self->{_n} = $MBI->_new($2 || 0);
235     }
236    
237     if ($d =~ /^([+-]?)0*(\d+)\z/) # second part ok?
238     {
239     $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg.
240     $self->{_d} = $MBI->_new($2 || 0);
241     }
242    
243     if (!defined $self->{_n} || !defined $self->{_d})
244     {
245     $d = Math::BigInt->new($d,undef,undef) unless ref $d;
246     $n = Math::BigInt->new($n,undef,undef) unless ref $n;
247    
248     if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
249     {
250     # both parts are ok as integers (wierd things like ' 1e0'
251     $self->{_n} = $MBI->_copy($n->{value});
252     $self->{_d} = $MBI->_copy($d->{value});
253     $self->{sign} = $n->{sign};
254     $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2
255     return $self->bnorm();
256     }
257    
258     $self->{sign} = '+'; # a default sign
259     return $self->bnan() if $n->is_nan() || $d->is_nan();
260    
261     # handle inf cases:
262     if ($n->is_inf() || $d->is_inf())
263     {
264     if ($n->is_inf())
265     {
266     return $self->bnan() if $d->is_inf(); # both are inf => NaN
267     my $s = '+'; # '+inf/+123' or '-inf/-123'
268     $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
269     # +-inf/123 => +-inf
270     return $self->binf($s);
271     }
272     # 123/inf => 0
273     return $self->bzero();
274     }
275     }
276     }
277    
278     return $self->bnorm();
279     }
280    
281     # simple string input
282     if (($n =~ /[\.eE]/))
283     {
284     # looks like a float, quacks like a float, so probably is a float
285     $self->{sign} = 'NaN';
286     local $Math::BigFloat::accuracy = undef;
287     local $Math::BigFloat::precision = undef;
288     $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
289     }
290     else
291     {
292     # for simple forms, use $MBI directly
293     if ($n =~ /^([+-]?)0*(\d+)\z/)
294     {
295     $self->{sign} = $1 || '+';
296     $self->{_n} = $MBI->_new($2 || 0);
297     $self->{_d} = $MBI->_one();
298     }
299     else
300     {
301     my $n = Math::BigInt->new($n,undef,undef);
302     $self->{_n} = $MBI->_copy($n->{value});
303     $self->{_d} = $MBI->_one();
304     $self->{sign} = $n->{sign};
305     return $self->bnan() if $self->{sign} eq 'NaN';
306     return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
307     }
308     }
309     $self->bnorm();
310     }
311    
312     sub copy
313     {
314     # if two arguments, the first one is the class to "swallow" subclasses
315     my ($c,$x) = @_;
316    
317     if (scalar @_ == 1)
318     {
319     $x = $_[0];
320     $c = ref($x);
321     }
322     return unless ref($x); # only for objects
323    
324     my $self = bless {}, $c;
325    
326     $self->{sign} = $x->{sign};
327     $self->{_d} = $MBI->_copy($x->{_d});
328     $self->{_n} = $MBI->_copy($x->{_n});
329     $self->{_a} = $x->{_a} if defined $x->{_a};
330     $self->{_p} = $x->{_p} if defined $x->{_p};
331     $self;
332     }
333    
334     ##############################################################################
335    
336     sub config
337     {
338     # return (later set?) configuration data as hash ref
339     my $class = shift || 'Math::BigRat';
340    
341     my $cfg = $class->SUPER::config(@_);
342    
343     # now we need only to override the ones that are different from our parent
344     $cfg->{class} = $class;
345     $cfg->{with} = $MBI;
346     $cfg;
347     }
348    
349     ##############################################################################
350    
351     sub bstr
352     {
353     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
354    
355     if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
356     {
357     my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
358     return $s;
359     }
360    
361     my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
362    
363     return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
364     $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
365     }
366    
367     sub bsstr
368     {
369     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
370    
371     if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
372     {
373     my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
374     return $s;
375     }
376    
377     my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
378     $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
379     }
380    
381     sub bnorm
382     {
383     # reduce the number to the shortest form
384     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
385    
386     # Both parts must be objects of whatever we are using today.
387     # Second check because Calc.pm has ARRAY res as unblessed objects.
388     if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
389     {
390     require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
391     }
392     if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
393     {
394     require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
395     }
396    
397     # no normalize for NaN, inf etc.
398     return $x if $x->{sign} !~ /^[+-]$/;
399    
400     # normalize zeros to 0/1
401     if ($MBI->_is_zero($x->{_n}))
402     {
403     $x->{sign} = '+'; # never leave a -0
404     $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
405     return $x;
406     }
407    
408     return $x if $MBI->_is_one($x->{_d}); # no need to reduce
409    
410     # reduce other numbers
411     my $gcd = $MBI->_copy($x->{_n});
412     $gcd = $MBI->_gcd($gcd,$x->{_d});
413    
414     if (!$MBI->_is_one($gcd))
415     {
416     $x->{_n} = $MBI->_div($x->{_n},$gcd);
417     $x->{_d} = $MBI->_div($x->{_d},$gcd);
418     }
419     $x;
420     }
421    
422     ##############################################################################
423     # sign manipulation
424    
425     sub bneg
426     {
427     # (BRAT or num_str) return BRAT
428     # negate number or make a negated number from string
429     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
430    
431     return $x if $x->modify('bneg');
432    
433     # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
434     $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
435     $x;
436     }
437    
438     ##############################################################################
439     # special values
440    
441     sub _bnan
442     {
443     # used by parent class bnan() to initialize number to NaN
444     my $self = shift;
445    
446     if ($_trap_nan)
447     {
448     require Carp;
449     my $class = ref($self);
450     # "$self" below will stringify the object, this blows up if $self is a
451     # partial object (happens under trap_nan), so fix it beforehand
452     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
453     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
454     Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
455     }
456     $self->{_n} = $MBI->_zero();
457     $self->{_d} = $MBI->_zero();
458     }
459    
460     sub _binf
461     {
462     # used by parent class bone() to initialize number to +inf/-inf
463     my $self = shift;
464    
465     if ($_trap_inf)
466     {
467     require Carp;
468     my $class = ref($self);
469     # "$self" below will stringify the object, this blows up if $self is a
470     # partial object (happens under trap_nan), so fix it beforehand
471     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
472     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
473     Carp::croak ("Tried to set $self to inf in $class\::_binf()");
474     }
475     $self->{_n} = $MBI->_zero();
476     $self->{_d} = $MBI->_zero();
477     }
478    
479     sub _bone
480     {
481     # used by parent class bone() to initialize number to +1/-1
482     my $self = shift;
483     $self->{_n} = $MBI->_one();
484     $self->{_d} = $MBI->_one();
485     }
486    
487     sub _bzero
488     {
489     # used by parent class bzero() to initialize number to 0
490     my $self = shift;
491     $self->{_n} = $MBI->_zero();
492     $self->{_d} = $MBI->_one();
493     }
494    
495     ##############################################################################
496     # mul/add/div etc
497    
498     sub badd
499     {
500     # add two rational numbers
501    
502     # set up parameters
503     my ($self,$x,$y,@r) = (ref($_[0]),@_);
504     # objectify is costly, so avoid it
505     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
506     {
507     ($self,$x,$y,@r) = objectify(2,@_);
508     }
509    
510     # +inf + +inf => +inf, -inf + -inf => -inf
511     return $x->binf(substr($x->{sign},0,1))
512     if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
513    
514     # +inf + -inf or -inf + +inf => NaN
515     return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
516    
517     # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
518     # - + - = --------- = --
519     # 4 3 4*3 12
520    
521     # we do not compute the gcd() here, but simple do:
522     # 5 7 5*3 + 7*4 43
523     # - + - = --------- = --
524     # 4 3 4*3 12
525    
526     # and bnorm() will then take care of the rest
527    
528     # 5 * 3
529     $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
530    
531     # 7 * 4
532     my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} );
533    
534     # 5 * 3 + 7 * 4
535     ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign});
536    
537     # 4 * 3
538     $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
539    
540     # normalize result, and possible round
541     $x->bnorm()->round(@r);
542     }
543    
544     sub bsub
545     {
546     # subtract two rational numbers
547    
548     # set up parameters
549     my ($self,$x,$y,@r) = (ref($_[0]),@_);
550     # objectify is costly, so avoid it
551     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
552     {
553     ($self,$x,$y,@r) = objectify(2,@_);
554     }
555    
556     # flip sign of $x, call badd(), then flip sign of result
557     $x->{sign} =~ tr/+-/-+/
558     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
559     $x->badd($y,@r); # does norm and round
560     $x->{sign} =~ tr/+-/-+/
561     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
562     $x;
563     }
564    
565     sub bmul
566     {
567     # multiply two rational numbers
568    
569     # set up parameters
570     my ($self,$x,$y,@r) = (ref($_[0]),@_);
571     # objectify is costly, so avoid it
572     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
573     {
574     ($self,$x,$y,@r) = objectify(2,@_);
575     }
576    
577     return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
578    
579     # inf handling
580     if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
581     {
582     return $x->bnan() if $x->is_zero() || $y->is_zero();
583     # result will always be +-inf:
584     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
585     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
586     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
587     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
588     return $x->binf('-');
589     }
590    
591     # x== 0 # also: or y == 1 or y == -1
592     return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
593    
594     # XXX TODO:
595     # According to Knuth, this can be optimized by doing gcd twice (for d and n)
596     # and reducing in one step. This would save us the bnorm() at the end.
597    
598     # 1 2 1 * 2 2 1
599     # - * - = ----- = - = -
600     # 4 3 4 * 3 12 6
601    
602     $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n});
603     $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
604    
605     # compute new sign
606     $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
607    
608     $x->bnorm()->round(@r);
609     }
610    
611     sub bdiv
612     {
613     # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
614     # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
615    
616     # set up parameters
617     my ($self,$x,$y,@r) = (ref($_[0]),@_);
618     # objectify is costly, so avoid it
619     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
620     {
621     ($self,$x,$y,@r) = objectify(2,@_);
622     }
623    
624     return $self->_div_inf($x,$y)
625     if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
626    
627     # x== 0 # also: or y == 1 or y == -1
628     return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
629    
630     # XXX TODO: list context, upgrade
631     # According to Knuth, this can be optimized by doing gcd twice (for d and n)
632     # and reducing in one step. This would save us the bnorm() at the end.
633    
634     # 1 1 1 3
635     # - / - == - * -
636     # 4 3 4 1
637    
638     $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
639     $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n});
640    
641     # compute new sign
642     $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
643    
644     $x->bnorm()->round(@r);
645     $x;
646     }
647    
648     sub bmod
649     {
650     # compute "remainder" (in Perl way) of $x / $y
651    
652     # set up parameters
653     my ($self,$x,$y,@r) = (ref($_[0]),@_);
654     # objectify is costly, so avoid it
655     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
656     {
657     ($self,$x,$y,@r) = objectify(2,@_);
658     }
659    
660     return $self->_div_inf($x,$y)
661     if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
662    
663     return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
664    
665     # compute $x - $y * floor($x/$y), keeping the sign of $x
666    
667     # copy x to u, make it positive and then do a normal division ($u/$y)
668     my $u = bless { sign => '+' }, $self;
669     $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
670     $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
671    
672     # compute floor(u)
673     if (! $MBI->_is_one($u->{_d}))
674     {
675     $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate
676     # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
677     }
678    
679     # now compute $y * $u
680     $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above
681     $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
682    
683     my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive
684     # compute $x - $u
685     $x->bsub($u);
686     $x->{sign} = $xsign; # put sign back
687    
688     $x->bnorm()->round(@r);
689     }
690    
691     ##############################################################################
692     # bdec/binc
693    
694     sub bdec
695     {
696     # decrement value (subtract 1)
697     my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
698    
699     return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
700    
701     if ($x->{sign} eq '-')
702     {
703     $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d}); # -5/2 => -7/2
704     }
705     else
706     {
707     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d?
708     {
709     # 1/3 -- => -2/3
710     $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
711     $x->{sign} = '-';
712     }
713     else
714     {
715     $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
716     }
717     }
718     $x->bnorm()->round(@r);
719     }
720    
721     sub binc
722     {
723     # increment value (add 1)
724     my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
725    
726     return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
727    
728     if ($x->{sign} eq '-')
729     {
730     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)
731     {
732     # -1/3 ++ => 2/3 (overflow at 0)
733     $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
734     $x->{sign} = '+';
735     }
736     else
737     {
738     $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
739     }
740     }
741     else
742     {
743     $x->{_n} = $MBI->_add($x->{_n},$x->{_d}); # 5/2 => 7/2
744     }
745     $x->bnorm()->round(@r);
746     }
747    
748     ##############################################################################
749     # is_foo methods (the rest is inherited)
750    
751     sub is_int
752     {
753     # return true if arg (BRAT or num_str) is an integer
754     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
755    
756     return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
757     $MBI->_is_one($x->{_d}); # x/y && y != 1 => no integer
758     0;
759     }
760    
761     sub is_zero
762     {
763     # return true if arg (BRAT or num_str) is zero
764     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
765    
766     return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});
767     0;
768     }
769    
770     sub is_one
771     {
772     # return true if arg (BRAT or num_str) is +1 or -1 if signis given
773     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
774    
775     my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
776     return 1
777     if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}));
778     0;
779     }
780    
781     sub is_odd
782     {
783     # return true if arg (BFLOAT or num_str) is odd or false if even
784     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
785    
786     return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
787     ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1
788     0;
789     }
790    
791     sub is_even
792     {
793     # return true if arg (BINT or num_str) is even or false if odd
794     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
795    
796     return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
797     return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never
798     && $MBI->_is_even($x->{_n})); # but 4/1 is
799     0;
800     }
801    
802     ##############################################################################
803     # parts() and friends
804    
805     sub numerator
806     {
807     my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
808    
809     # NaN, inf, -inf
810     return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
811    
812     my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign};
813     $n;
814     }
815    
816     sub denominator
817     {
818     my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
819    
820     # NaN
821     return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
822     # inf, -inf
823     return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
824    
825     Math::BigInt->new($MBI->_str($x->{_d}));
826     }
827    
828     sub parts
829     {
830     my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
831    
832     my $c = 'Math::BigInt';
833    
834     return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN';
835     return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf';
836     return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf';
837    
838     my $n = $c->new( $MBI->_str($x->{_n}));
839     $n->{sign} = $x->{sign};
840     my $d = $c->new( $MBI->_str($x->{_d}));
841     ($n,$d);
842     }
843    
844     sub length
845     {
846     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
847    
848     return $nan unless $x->is_int();
849     $MBI->_len($x->{_n}); # length(-123/1) => length(123)
850     }
851    
852     sub digit
853     {
854     my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_);
855    
856     return $nan unless $x->is_int();
857     $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2)
858     }
859    
860     ##############################################################################
861     # special calc routines
862    
863     sub bceil
864     {
865     my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
866    
867     return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
868     $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
869    
870     $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
871     $x->{_d} = $MBI->_one(); # d => 1
872     $x->{_n} = $MBI->_inc($x->{_n})
873     if $x->{sign} eq '+'; # +22/7 => 4/1
874     $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0
875     $x;
876     }
877    
878     sub bfloor
879     {
880     my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
881    
882     return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
883     $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
884    
885     $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
886     $x->{_d} = $MBI->_one(); # d => 1
887     $x->{_n} = $MBI->_inc($x->{_n})
888     if $x->{sign} eq '-'; # -22/7 => -4/1
889     $x;
890     }
891    
892     sub bfac
893     {
894     my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
895    
896     # if $x is not an integer
897     if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d})))
898     {
899     return $x->bnan();
900     }
901    
902     $x->{_n} = $MBI->_fac($x->{_n});
903     # since _d is 1, we don't need to reduce/norm the result
904     $x->round(@r);
905     }
906    
907     sub bpow
908     {
909     # power ($x ** $y)
910    
911     # set up parameters
912     my ($self,$x,$y,@r) = (ref($_[0]),@_);
913     # objectify is costly, so avoid it
914     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
915     {
916     ($self,$x,$y,@r) = objectify(2,@_);
917     }
918    
919     return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
920     return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
921     return $x->bone(@r) if $y->is_zero();
922     return $x->round(@r) if $x->is_one() || $y->is_one();
923    
924     if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}))
925     {
926     # if $x == -1 and odd/even y => +1/-1
927     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
928     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
929     }
930     # 1 ** -y => 1 / (1 ** |y|)
931     # so do test for negative $y after above's clause
932    
933     return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
934    
935     # shortcut y/1 (and/or x/1)
936     if ($MBI->_is_one($y->{_d}))
937     {
938     # shortcut for x/1 and y/1
939     if ($MBI->_is_one($x->{_d}))
940     {
941     $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1
942     if ($y->{sign} eq '-')
943     {
944     # 0.2 ** -3 => 1/(0.2 ** 3)
945     ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
946     }
947     # correct sign; + ** + => +
948     if ($x->{sign} eq '-')
949     {
950     # - * - => +, - * - * - => -
951     $x->{sign} = '+' if $MBI->_is_even($y->{_n});
952     }
953     return $x->round(@r);
954     }
955     # x/z ** y/1
956     $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
957     $x->{_d} = $MBI->_pow($x->{_d},$y->{_n});
958     if ($y->{sign} eq '-')
959     {
960     # 0.2 ** -3 => 1/(0.2 ** 3)
961     ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
962     }
963     # correct sign; + ** + => +
964     if ($x->{sign} eq '-')
965     {
966     # - * - => +, - * - * - => -
967     $x->{sign} = '+' if $MBI->_is_even($y->{_n});
968     }
969     return $x->round(@r);
970     }
971    
972     # regular calculation (this is wrong for d/e ** f/g)
973     my $pow2 = $self->bone();
974     my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
975     my $two = $MBI->_two();
976    
977     while (!$MBI->_is_one($y1))
978     {
979     $pow2->bmul($x) if $MBI->_is_odd($y1);
980     $MBI->_div($y1, $two);
981     $x->bmul($x);
982     }
983     $x->bmul($pow2) unless $pow2->is_one();
984     # n ** -x => 1/n ** x
985     ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
986     $x->bnorm()->round(@r);
987     }
988    
989     sub blog
990     {
991     # set up parameters
992     my ($self,$x,$y,@r) = (ref($_[0]),@_);
993    
994     # objectify is costly, so avoid it
995     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
996     {
997     ($self,$x,$y,@r) = objectify(2,$class,@_);
998     }
999    
1000     # blog(1,Y) => 0
1001     return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
1002    
1003     # $x <= 0 => NaN
1004     return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
1005    
1006     if ($x->is_int() && $y->is_int())
1007     {
1008     return $self->new($x->as_number()->blog($y->as_number(),@r));
1009     }
1010    
1011     # do it with floats
1012     $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
1013     }
1014    
1015     sub _float_from_part
1016     {
1017     my $x = shift;
1018    
1019     my $f = Math::BigFloat->bzero();
1020     $f->{_m} = $MBI->_copy($x);
1021     $f->{_e} = $MBI->_zero();
1022    
1023     $f;
1024     }
1025    
1026     sub _as_float
1027     {
1028     my $x = shift;
1029    
1030     local $Math::BigFloat::upgrade = undef;
1031     local $Math::BigFloat::accuracy = undef;
1032     local $Math::BigFloat::precision = undef;
1033     # 22/7 => 3.142857143..
1034    
1035     my $a = $x->accuracy() || 0;
1036     if ($a != 0 || !$MBI->_is_one($x->{_d}))
1037     {
1038     # n/d
1039     return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
1040     }
1041     # just n
1042     Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
1043     }
1044    
1045     sub broot
1046     {
1047     # set up parameters
1048     my ($self,$x,$y,@r) = (ref($_[0]),@_);
1049     # objectify is costly, so avoid it
1050     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1051     {
1052     ($self,$x,$y,@r) = objectify(2,@_);
1053     }
1054    
1055     if ($x->is_int() && $y->is_int())
1056     {
1057     return $self->new($x->as_number()->broot($y->as_number(),@r));
1058     }
1059    
1060     # do it with floats
1061     $x->_new_from_float( $x->_as_float()->broot($y,@r) );
1062     }
1063    
1064     sub bmodpow
1065     {
1066     # set up parameters
1067     my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
1068     # objectify is costly, so avoid it
1069     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1070     {
1071     ($self,$x,$y,$m,@r) = objectify(3,@_);
1072     }
1073    
1074     # $x or $y or $m are NaN or +-inf => NaN
1075     return $x->bnan()
1076     if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
1077     $m->{sign} !~ /^[+-]$/;
1078    
1079     if ($x->is_int() && $y->is_int() && $m->is_int())
1080     {
1081     return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
1082     }
1083    
1084     warn ("bmodpow() not fully implemented");
1085     $x->bnan();
1086     }
1087    
1088     sub bmodinv
1089     {
1090     # set up parameters
1091     my ($self,$x,$y,@r) = (ref($_[0]),@_);
1092     # objectify is costly, so avoid it
1093     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1094     {
1095     ($self,$x,$y,@r) = objectify(2,@_);
1096     }
1097    
1098     # $x or $y are NaN or +-inf => NaN
1099     return $x->bnan()
1100     if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
1101    
1102     if ($x->is_int() && $y->is_int())
1103     {
1104     return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
1105     }
1106    
1107     warn ("bmodinv() not fully implemented");
1108     $x->bnan();
1109     }
1110    
1111     sub bsqrt
1112     {
1113     my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1114    
1115     return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1116     return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1117     return $x->round(@r) if $x->is_zero() || $x->is_one();
1118    
1119     local $Math::BigFloat::upgrade = undef;
1120     local $Math::BigFloat::downgrade = undef;
1121     local $Math::BigFloat::precision = undef;
1122     local $Math::BigFloat::accuracy = undef;
1123     local $Math::BigInt::upgrade = undef;
1124     local $Math::BigInt::precision = undef;
1125     local $Math::BigInt::accuracy = undef;
1126    
1127     $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
1128     $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();
1129    
1130     # XXX TODO: we probably can optimze this:
1131    
1132     # if sqrt(D) was not integer
1133     if ($x->{_d}->{_es} ne '+')
1134     {
1135     $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1
1136     $x->{_d} = $MBI->_copy( $x->{_d}->{_m} ); # 7.1/45.1 => 71/45.1
1137     }
1138     # if sqrt(N) was not integer
1139     if ($x->{_n}->{_es} ne '+')
1140     {
1141     $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1
1142     $x->{_n} = $MBI->_copy( $x->{_n}->{_m} ); # 710/45.1 => 710/451
1143     }
1144    
1145     # convert parts to $MBI again
1146     $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
1147     if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
1148     $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
1149     if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';
1150    
1151     $x->bnorm()->round(@r);
1152     }
1153    
1154     sub blsft
1155     {
1156     my ($self,$x,$y,$b,@r) = objectify(3,@_);
1157    
1158     $b = 2 unless defined $b;
1159     $b = $self->new($b) unless ref ($b);
1160     $x->bmul( $b->copy()->bpow($y), @r);
1161     $x;
1162     }
1163    
1164     sub brsft
1165     {
1166     my ($self,$x,$y,$b,@r) = objectify(3,@_);
1167    
1168     $b = 2 unless defined $b;
1169     $b = $self->new($b) unless ref ($b);
1170     $x->bdiv( $b->copy()->bpow($y), @r);
1171     $x;
1172     }
1173    
1174     ##############################################################################
1175     # round
1176    
1177     sub round
1178     {
1179     $_[0];
1180     }
1181    
1182     sub bround
1183     {
1184     $_[0];
1185     }
1186    
1187     sub bfround
1188     {
1189     $_[0];
1190     }
1191    
1192     ##############################################################################
1193     # comparing
1194    
1195     sub bcmp
1196     {
1197     # compare two signed numbers
1198    
1199     # set up parameters
1200     my ($self,$x,$y) = (ref($_[0]),@_);
1201     # objectify is costly, so avoid it
1202     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1203     {
1204     ($self,$x,$y) = objectify(2,@_);
1205     }
1206    
1207     if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1208     {
1209     # handle +-inf and NaN
1210     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1211     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1212     return +1 if $x->{sign} eq '+inf';
1213     return -1 if $x->{sign} eq '-inf';
1214     return -1 if $y->{sign} eq '+inf';
1215     return +1;
1216     }
1217     # check sign for speed first
1218     return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1219     return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1220    
1221     # shortcut
1222     my $xz = $MBI->_is_zero($x->{_n});
1223     my $yz = $MBI->_is_zero($y->{_n});
1224     return 0 if $xz && $yz; # 0 <=> 0
1225     return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1226     return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1227    
1228     my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1229     my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1230    
1231     my $cmp = $MBI->_acmp($t,$u); # signs are equal
1232     $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
1233     $cmp;
1234     }
1235    
1236     sub bacmp
1237     {
1238     # compare two numbers (as unsigned)
1239    
1240     # set up parameters
1241     my ($self,$x,$y) = (ref($_[0]),@_);
1242     # objectify is costly, so avoid it
1243     if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1244     {
1245     ($self,$x,$y) = objectify(2,$class,@_);
1246     }
1247    
1248     if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1249     {
1250     # handle +-inf and NaN
1251     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1252     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1253     return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1254     return -1;
1255     }
1256    
1257     my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1258     my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1259     $MBI->_acmp($t,$u); # ignore signs
1260     }
1261    
1262     ##############################################################################
1263     # output conversation
1264    
1265     sub numify
1266     {
1267     # convert 17/8 => float (aka 2.125)
1268     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1269    
1270     return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
1271    
1272     # N/1 => N
1273     my $neg = ''; $neg = '-' if $x->{sign} eq '-';
1274     return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
1275    
1276     $x->_as_float()->numify() + 0.0;
1277     }
1278    
1279     sub as_number
1280     {
1281     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1282    
1283     return Math::BigInt->new($x) if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1284    
1285     my $u = Math::BigInt->bzero();
1286     $u->{sign} = $x->{sign};
1287     $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
1288     $u;
1289     }
1290    
1291     sub as_bin
1292     {
1293     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1294    
1295     return $x unless $x->is_int();
1296    
1297     my $s = $x->{sign}; $s = '' if $s eq '+';
1298     $s . $MBI->_as_bin($x->{_n});
1299     }
1300    
1301     sub as_hex
1302     {
1303     my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1304    
1305     return $x unless $x->is_int();
1306    
1307     my $s = $x->{sign}; $s = '' if $s eq '+';
1308     $s . $MBI->_as_hex($x->{_n});
1309     }
1310    
1311     ##############################################################################
1312     # import
1313    
1314     sub import
1315     {
1316     my $self = shift;
1317     my $l = scalar @_;
1318     my $lib = ''; my @a;
1319    
1320     for ( my $i = 0; $i < $l ; $i++)
1321     {
1322     if ( $_[$i] eq ':constant' )
1323     {
1324     # this rest causes overlord er load to step in
1325     overload::constant float => sub { $self->new(shift); };
1326     }
1327     # elsif ($_[$i] eq 'upgrade')
1328     # {
1329     # # this causes upgrading
1330     # $upgrade = $_[$i+1]; # or undef to disable
1331     # $i++;
1332     # }
1333     elsif ($_[$i] eq 'downgrade')
1334     {
1335     # this causes downgrading
1336     $downgrade = $_[$i+1]; # or undef to disable
1337     $i++;
1338     }
1339     elsif ($_[$i] eq 'lib')
1340     {
1341     $lib = $_[$i+1] || ''; # default Calc
1342     $i++;
1343     }
1344     elsif ($_[$i] eq 'with')
1345     {
1346     # this argument is no longer used
1347     #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
1348     $i++;
1349     }
1350     else
1351     {
1352     push @a, $_[$i];
1353     }
1354     }
1355     require Math::BigInt;
1356    
1357     # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
1358     if ($lib ne '')
1359     {
1360     my @c = split /\s*,\s*/, $lib;
1361     foreach (@c)
1362     {
1363     $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
1364     }
1365     $lib = join(",", @c);
1366     }
1367     my @import = ('objectify');
1368     push @import, lib => $lib if $lib ne '';
1369    
1370     # MBI already loaded, so feed it our lib arguments
1371     Math::BigInt->import( @import );
1372    
1373     $MBI = Math::BigFloat->config()->{lib};
1374    
1375     # register us with MBI to get notified of future lib changes
1376     Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
1377    
1378     # any non :constant stuff is handled by our parent, Exporter (loaded
1379     # by Math::BigFloat, even if @_ is empty, to give it a chance
1380     $self->SUPER::import(@a); # for subclasses
1381     $self->export_to_level(1,$self,@a); # need this, too
1382     }
1383    
1384     1;
1385    
1386     __END__
1387    
1388     =head1 NAME
1389    
1390     Math::BigRat - Arbitrary big rational numbers
1391    
1392     =head1 SYNOPSIS
1393    
1394     use Math::BigRat;
1395    
1396     my $x = Math::BigRat->new('3/7'); $x += '5/9';
1397    
1398     print $x->bstr(),"\n";
1399     print $x ** 2,"\n";
1400    
1401     my $y = Math::BigRat->new('inf');
1402     print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
1403    
1404     my $z = Math::BigRat->new(144); $z->bsqrt();
1405    
1406     =head1 DESCRIPTION
1407    
1408     Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1409     for arbitrary big rational numbers.
1410    
1411     =head2 MATH LIBRARY
1412    
1413     Math with the numbers is done (by default) by a module called
1414     Math::BigInt::Calc. This is equivalent to saying:
1415    
1416     use Math::BigRat lib => 'Calc';
1417    
1418     You can change this by using:
1419    
1420     use Math::BigRat lib => 'BitVect';
1421    
1422     The following would first try to find Math::BigInt::Foo, then
1423     Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1424    
1425     use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1426    
1427     Calc.pm uses as internal format an array of elements of some decimal base
1428     (usually 1e7, but this might be different for some systems) with the least
1429     significant digit first, while BitVect.pm uses a bit vector of base 2, most
1430     significant bit first. Other modules might use even different means of
1431     representing the numbers. See the respective module documentation for further
1432     details.
1433    
1434     Currently the following replacement libraries exist, search for them at CPAN:
1435    
1436     Math::BigInt::BitVect
1437     Math::BigInt::GMP
1438     Math::BigInt::Pari
1439     Math::BigInt::FastCalc
1440    
1441     =head1 METHODS
1442    
1443     Any methods not listed here are dervied from Math::BigFloat (or
1444     Math::BigInt), so make sure you check these two modules for further
1445     information.
1446    
1447     =head2 new()
1448    
1449     $x = Math::BigRat->new('1/3');
1450    
1451     Create a new Math::BigRat object. Input can come in various forms:
1452    
1453     $x = Math::BigRat->new(123); # scalars
1454     $x = Math::BigRat->new('inf'); # infinity
1455     $x = Math::BigRat->new('123.3'); # float
1456     $x = Math::BigRat->new('1/3'); # simple string
1457     $x = Math::BigRat->new('1 / 3'); # spaced
1458     $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1459     $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1460     $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
1461     $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
1462    
1463     # You can also give D and N as different objects:
1464     $x = Math::BigRat->new(
1465     Math::BigInt->new(-123),
1466     Math::BigInt->new(7),
1467     ); # => -123/7
1468    
1469     =head2 numerator()
1470    
1471     $n = $x->numerator();
1472    
1473     Returns a copy of the numerator (the part above the line) as signed BigInt.
1474    
1475     =head2 denominator()
1476    
1477     $d = $x->denominator();
1478    
1479     Returns a copy of the denominator (the part under the line) as positive BigInt.
1480    
1481     =head2 parts()
1482    
1483     ($n,$d) = $x->parts();
1484    
1485     Return a list consisting of (signed) numerator and (unsigned) denominator as
1486     BigInts.
1487    
1488     =head2 as_int()
1489    
1490     $x = Math::BigRat->new('13/7');
1491     print $x->as_int(),"\n"; # '1'
1492    
1493     Returns a copy of the object as BigInt, truncated to an integer.
1494    
1495     C<as_number()> is an alias for C<as_int()>.
1496    
1497     =head2 as_hex()
1498    
1499     $x = Math::BigRat->new('13');
1500     print $x->as_hex(),"\n"; # '0xd'
1501    
1502     Returns the BigRat as hexadecimal string. Works only for integers.
1503    
1504     =head2 as_bin()
1505    
1506     $x = Math::BigRat->new('13');
1507     print $x->as_bin(),"\n"; # '0x1101'
1508    
1509     Returns the BigRat as binary string. Works only for integers.
1510    
1511     =head2 bfac()
1512    
1513     $x->bfac();
1514    
1515     Calculates the factorial of $x. For instance:
1516    
1517     print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1518     print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
1519    
1520     Works currently only for integers.
1521    
1522     =head2 blog()
1523    
1524     Is not yet implemented.
1525    
1526     =head2 bround()/round()/bfround()
1527    
1528     Are not yet implemented.
1529    
1530     =head2 bmod()
1531    
1532     use Math::BigRat;
1533     my $x = Math::BigRat->new('7/4');
1534     my $y = Math::BigRat->new('4/3');
1535     print $x->bmod($y);
1536    
1537     Set $x to the remainder of the division of $x by $y.
1538    
1539     =head2 is_one()
1540    
1541     print "$x is 1\n" if $x->is_one();
1542    
1543     Return true if $x is exactly one, otherwise false.
1544    
1545     =head2 is_zero()
1546    
1547     print "$x is 0\n" if $x->is_zero();
1548    
1549     Return true if $x is exactly zero, otherwise false.
1550    
1551     =head2 is_pos()
1552    
1553     print "$x is >= 0\n" if $x->is_positive();
1554    
1555     Return true if $x is positive (greater than or equal to zero), otherwise
1556     false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1557    
1558     C<is_positive()> is an alias for C<is_pos()>.
1559    
1560     =head2 is_neg()
1561    
1562     print "$x is < 0\n" if $x->is_negative();
1563    
1564     Return true if $x is negative (smaller than zero), otherwise false. Please
1565     note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1566    
1567     C<is_negative()> is an alias for C<is_neg()>.
1568    
1569     =head2 is_int()
1570    
1571     print "$x is an integer\n" if $x->is_int();
1572    
1573     Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1574     false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1575    
1576     =head2 is_odd()
1577    
1578     print "$x is odd\n" if $x->is_odd();
1579    
1580     Return true if $x is odd, otherwise false.
1581    
1582     =head2 is_even()
1583    
1584     print "$x is even\n" if $x->is_even();
1585    
1586     Return true if $x is even, otherwise false.
1587    
1588     =head2 bceil()
1589    
1590     $x->bceil();
1591    
1592     Set $x to the next bigger integer value (e.g. truncate the number to integer
1593     and then increment it by one).
1594    
1595     =head2 bfloor()
1596    
1597     $x->bfloor();
1598    
1599     Truncate $x to an integer value.
1600    
1601     =head2 bsqrt()
1602    
1603     $x->bsqrt();
1604    
1605     Calculate the square root of $x.
1606    
1607     =head2 config
1608    
1609     use Data::Dumper;
1610    
1611     print Dumper ( Math::BigRat->config() );
1612     print Math::BigRat->config()->{lib},"\n";
1613    
1614     Returns a hash containing the configuration, e.g. the version number, lib
1615     loaded etc. The following hash keys are currently filled in with the
1616     appropriate information.
1617    
1618     key RO/RW Description
1619     Example
1620     ============================================================
1621     lib RO Name of the Math library
1622     Math::BigInt::Calc
1623     lib_version RO Version of 'lib'
1624     0.30
1625     class RO The class of config you just called
1626     Math::BigRat
1627     version RO version number of the class you used
1628     0.10
1629     upgrade RW To which class numbers are upgraded
1630     undef
1631     downgrade RW To which class numbers are downgraded
1632     undef
1633     precision RW Global precision
1634     undef
1635     accuracy RW Global accuracy
1636     undef
1637     round_mode RW Global round mode
1638     even
1639     div_scale RW Fallback acccuracy for div
1640     40
1641     trap_nan RW Trap creation of NaN (undef = no)
1642     undef
1643     trap_inf RW Trap creation of +inf/-inf (undef = no)
1644     undef
1645    
1646     By passing a reference to a hash you may set the configuration values. This
1647     works only for values that a marked with a C<RW> above, anything else is
1648     read-only.
1649    
1650     =head1 BUGS
1651    
1652     Some things are not yet implemented, or only implemented half-way:
1653    
1654     =over 2
1655    
1656     =item inf handling (partial)
1657    
1658     =item NaN handling (partial)
1659    
1660     =item rounding (not implemented except for bceil/bfloor)
1661    
1662     =item $x ** $y where $y is not an integer
1663    
1664     =item bmod(), blog(), bmodinv() and bmodpow() (partial)
1665    
1666     =back
1667    
1668     =head1 LICENSE
1669    
1670     This program is free software; you may redistribute it and/or modify it under
1671     the same terms as Perl itself.
1672    
1673     =head1 SEE ALSO
1674    
1675     L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1676     L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1677    
1678     See L<http://search.cpan.org/search?dist=bignum> for a way to use
1679     Math::BigRat.
1680    
1681     The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1682     may contain more documentation and examples as well as testcases.
1683    
1684     =head1 AUTHORS
1685    
1686     (C) by Tels L<http://bloodgate.com/> 2001 - 2005.
1687    
1688     =cut