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
14package Math::BigRat;
15
16require 5.005_03;
17use strict;
18
19use Math::BigFloat;
20use 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
27use overload;			# inherit overload from Math::BigFloat
28
29BEGIN
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}
59my $MBI = 'Math::BigInt::Calc';
60
61my $nan = 'NaN';
62my $class = 'Math::BigRat';
63
64sub isa
65  {
66  return 0 if $_[1] =~ /^Math::Big(Int|Float)/;		# we aren't
67  UNIVERSAL::isa(@_);
68  }
69
70##############################################################################
71
72sub _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
99sub 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
312sub 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
336sub 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
351sub 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
367sub 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
381sub 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
425sub 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
441sub _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
460sub _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
479sub _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
487sub _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
498sub 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
544sub 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
565sub 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
611sub 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
648sub 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
694sub 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
721sub 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
751sub 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
761sub 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
770sub 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
781sub 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
791sub 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
805sub 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
816sub 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
828sub 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
844sub 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
852sub 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
863sub 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
878sub 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
892sub 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
907sub 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
989sub 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
1015sub _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
1026sub _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
1045sub 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
1064sub 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
1088sub 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
1111sub 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
1154sub 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
1164sub 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
1177sub round
1178  {
1179  $_[0];
1180  }
1181
1182sub bround
1183  {
1184  $_[0];
1185  }
1186
1187sub bfround
1188  {
1189  $_[0];
1190  }
1191
1192##############################################################################
1193# comparing
1194
1195sub 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
1236sub 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
1265sub 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
1279sub 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
1291sub 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
1301sub 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
1314sub 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
13841;
1385
1386__END__
1387
1388=head1 NAME
1389
1390Math::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
1408Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1409for arbitrary big rational numbers.
1410
1411=head2 MATH LIBRARY
1412
1413Math with the numbers is done (by default) by a module called
1414Math::BigInt::Calc. This is equivalent to saying:
1415
1416	use Math::BigRat lib => 'Calc';
1417
1418You can change this by using:
1419
1420	use Math::BigRat lib => 'BitVect';
1421
1422The following would first try to find Math::BigInt::Foo, then
1423Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1424
1425	use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1426
1427Calc.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
1429significant digit first, while BitVect.pm uses a bit vector of base 2, most
1430significant bit first. Other modules might use even different means of
1431representing the numbers. See the respective module documentation for further
1432details.
1433
1434Currently 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
1443Any methods not listed here are dervied from Math::BigFloat (or
1444Math::BigInt), so make sure you check these two modules for further
1445information.
1446
1447=head2 new()
1448
1449	$x = Math::BigRat->new('1/3');
1450
1451Create 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
1473Returns a copy of the numerator (the part above the line) as signed BigInt.
1474
1475=head2 denominator()
1476
1477	$d = $x->denominator();
1478
1479Returns a copy of the denominator (the part under the line) as positive BigInt.
1480
1481=head2 parts()
1482
1483	($n,$d) = $x->parts();
1484
1485Return a list consisting of (signed) numerator and (unsigned) denominator as
1486BigInts.
1487
1488=head2 as_int()
1489
1490	$x = Math::BigRat->new('13/7');
1491	print $x->as_int(),"\n";		# '1'
1492
1493Returns a copy of the object as BigInt, truncated to an integer.
1494
1495C<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
1502Returns 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
1509Returns the BigRat as binary string. Works only for integers.
1510
1511=head2 bfac()
1512
1513	$x->bfac();
1514
1515Calculates 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
1520Works currently only for integers.
1521
1522=head2 blog()
1523
1524Is not yet implemented.
1525
1526=head2 bround()/round()/bfround()
1527
1528Are 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
1537Set $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
1543Return 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
1549Return 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
1555Return true if $x is positive (greater than or equal to zero), otherwise
1556false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1557
1558C<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
1564Return true if $x is negative (smaller than zero), otherwise false. Please
1565note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1566
1567C<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
1573Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1574false. 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
1580Return true if $x is odd, otherwise false.
1581
1582=head2 is_even()
1583
1584	print "$x is even\n" if $x->is_even();
1585
1586Return true if $x is even, otherwise false.
1587
1588=head2 bceil()
1589
1590	$x->bceil();
1591
1592Set $x to the next bigger integer value (e.g. truncate the number to integer
1593and then increment it by one).
1594
1595=head2 bfloor()
1596
1597	$x->bfloor();
1598
1599Truncate $x to an integer value.
1600
1601=head2 bsqrt()
1602
1603	$x->bsqrt();
1604
1605Calculate 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
1614Returns a hash containing the configuration, e.g. the version number, lib
1615loaded etc. The following hash keys are currently filled in with the
1616appropriate 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
1646By passing a reference to a hash you may set the configuration values. This
1647works only for values that a marked with a C<RW> above, anything else is
1648read-only.
1649
1650=head1 BUGS
1651
1652Some 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
1670This program is free software; you may redistribute it and/or modify it under
1671the same terms as Perl itself.
1672
1673=head1 SEE ALSO
1674
1675L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1676L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
1677
1678See L<http://search.cpan.org/search?dist=bignum> for a way to use
1679Math::BigRat.
1680
1681The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1682may 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
1689