lib/Math/BigRat.pm

   1 #!/usr/bin/perl -w
   2
   3 # The following hash values are used:
   4 #   sign : +,-,NaN,+inf,-inf
   5 #   _d   : denominator
   6 #   _n   : numeraotr (value = _n/_d)
   7 #   _a   : accuracy
   8 #   _p   : precision
   9 #   _f   : flags, used by MBR to flag parts of a rationale as untouchable
  10
  11 package Math::BigRat;
  12
  13 require 5.005_02;
  14 use strict;
  15
  16 use Exporter;
  17 use Math::BigFloat;
  18 use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
  19             $accuracy $precision $round_mode $div_scale);
  20
  21 @ISA = qw(Exporter Math::BigFloat);
  22 @EXPORT_OK = qw();
  23
  24 $VERSION = '0.04';
  25
  26 use overload;                           # inherit from Math::BigFloat
  27
  28 ##############################################################################
  29 # global constants, flags and accessory
  30
  31 use constant MB_NEVER_ROUND => 0x0001;
  32
  33 $accuracy = $precision = undef;
  34 $round_mode = 'even';
  35 $div_scale = 40;
  36 $upgrade = undef;
  37 $downgrade = undef;
  38
  39 my $nan = 'NaN';
  40 my $class = 'Math::BigRat';
  41
  42 sub _new_from_float
  43   {
  44   # turn a single float input into a rationale (like '0.1')
  45   my ($self,$f) = @_;
  46
  47   return $self->bnan() if $f->is_nan();
  48   return $self->binf('-inf') if $f->{sign} eq '-inf';
  49   return $self->binf('+inf') if $f->{sign} eq '+inf';
  50
  51   #print "f $f caller", join(' ',caller()),"\n";
  52   $self->{_n} = $f->{_m}->copy();                       # mantissa
  53   $self->{_d} = Math::BigInt->bone();
  54   $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
  55   if ($f->{_e}->{sign} eq '-')
  56     {
  57     # something like Math::BigRat->new('0.1');
  58     $self->{_d}->blsft($f->{_e}->copy()->babs(),10);    # 1 / 1 => 1/10
  59     }
  60   else
  61     {
  62     # something like Math::BigRat->new('10');
  63     # 1 / 1 => 10/1
  64     $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
  65     }
  66 #  print "float new $self->{_n} / $self->{_d}\n";
  67   $self;
  68   }
  69
  70 sub new
  71   {
  72   # create a Math::BigRat
  73   my $class = shift;
  74
  75   my ($n,$d) = shift;
  76
  77   my $self = { }; bless $self,$class;
  78
  79 #  print "ref ",ref($d),"\n";
  80 #  if (ref($d))
  81 #    {
  82 #  print "isa float ",$d->isa('Math::BigFloat'),"\n";
  83 #  print "isa int ",$d->isa('Math::BigInt'),"\n";
  84 #  print "isa rat ",$d->isa('Math::BigRat'),"\n";
  85 #    }
  86
  87   # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
  88
  89   if ((ref $n) && (!$n->isa('Math::BigRat')))
  90     {
  91 #    print "is ref, but not rat\n";
  92     if ($n->isa('Math::BigFloat'))
  93       {
  94 #      print "is ref, and float\n";
  95       return $self->_new_from_float($n)->bnorm();
  96       }
  97     if ($n->isa('Math::BigInt'))
  98       {
  99 #      print "is ref, and int\n";
 100       $self->{_n} = $n->copy();                         # "mantissa" = $d
 101       $self->{_d} = Math::BigInt->bone();
 102       $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
 103       return $self->bnorm();
 104       }
 105     }
 106   return $n->copy() if ref $n;
 107
 108 #  print "is string\n";
 109
 110   if (!defined $n)
 111     {
 112     $self->{_n} = Math::BigInt->bzero();        # undef => 0
 113     $self->{_d} = Math::BigInt->bone();
 114     $self->{sign} = '+';
 115     return $self->bnorm();
 116     }
 117   # string input with / delimiter
 118   if ($n =~ /\s*\/\s*/)
 119     {
 120     return Math::BigRat->bnan() if $n =~ /\/.*\//;      # 1/2/3 isn't valid
 121     return Math::BigRat->bnan() if $n =~ /\/\s*$/;      # 1/ isn't valid
 122     ($n,$d) = split (/\//,$n);
 123     # try as BigFloats first
 124     if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
 125       {
 126       # one of them looks like a float
 127       $self->_new_from_float(Math::BigFloat->new($n));
 128       # now correct $self->{_n} due to $n
 129       my $f = Math::BigFloat->new($d);
 130       if ($f->{_e}->{sign} eq '-')
 131         {
 132         # 10 / 0.1 => 100/1
 133         $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
 134         }
 135       else
 136         {
 137         $self->{_d}->blsft($f->{_e},10);                # 1 / 1 => 10/1
 138          }
 139       }
 140     else
 141       {
 142       $self->{_n} = Math::BigInt->new($n);
 143       $self->{_d} = Math::BigInt->new($d);
 144       return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
 145       # inf handling is missing here
 146
 147       $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
 148       # if $d is negative, flip sign
 149       $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
 150       $self->{_d}->{sign} = '+';        # normalize
 151       }
 152     return $self->bnorm();
 153     }
 154
 155   # simple string input
 156   if (($n =~ /[\.eE]/))
 157     {
 158     # looks like a float
 159 #    print "float-like string $d\n";
 160     $self->_new_from_float(Math::BigFloat->new($n));
 161     }
 162   else
 163     {
 164     $self->{_n} = Math::BigInt->new($n);
 165     $self->{_d} = Math::BigInt->bone();
 166     $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
 167     }
 168   $self->bnorm();
 169   }
 170
 171 sub bstr
 172   {
 173   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 174
 175   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
 176     {
 177     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
 178     return $s;
 179     }
 180
 181 #  print "bstr $x->{sign} $x->{_n} $x->{_d}\n";
 182   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # +3 vs 3
 183
 184   return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
 185   return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr();
 186   }
 187
 188 sub bsstr
 189   {
 190   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 191
 192   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
 193     {
 194     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
 195     return $s;
 196     }
 197
 198   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # +3 vs 3
 199   return $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
 200   }
 201
 202 sub bnorm
 203   {
 204   # reduce the number to the shortest form and remember this (so that we
 205   # don't reduce again)
 206   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 207
 208   # this is to prevent automatically rounding when MBI's globals are set
 209   $x->{_d}->{_f} = MB_NEVER_ROUND;
 210   $x->{_n}->{_f} = MB_NEVER_ROUND;
 211   # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
 212   $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
 213   $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
 214
 215   # normalize zeros to 0/1
 216   if (($x->{sign} =~ /^[+-]$/) &&
 217       ($x->{_n}->is_zero()))
 218     {
 219     $x->{sign} = '+';                                           # never -0
 220     $x->{_d} = Math::BigInt->bone() unless $x->{_d}->is_one();
 221     return $x;
 222     }
 223
 224 #  print "$x->{_n} / $x->{_d} => ";
 225   # reduce other numbers
 226   my $gcd = $x->{_n}->bgcd($x->{_d});
 227
 228   if (!$gcd->is_one())
 229     {
 230     $x->{_n}->bdiv($gcd);
 231     $x->{_d}->bdiv($gcd);
 232     }
 233 #  print "$x->{_n} / $x->{_d}\n";
 234   $x;
 235   }
 236
 237 ##############################################################################
 238 # special values
 239
 240 sub _bnan
 241   {
 242   # used by parent class bone() to initialize number to 1
 243   my $self = shift;
 244   $self->{_n} = Math::BigInt->bzero();
 245   $self->{_d} = Math::BigInt->bzero();
 246   }
 247
 248 sub _binf
 249   {
 250   # used by parent class bone() to initialize number to 1
 251   my $self = shift;
 252   $self->{_n} = Math::BigInt->bzero();
 253   $self->{_d} = Math::BigInt->bzero();
 254   }
 255
 256 sub _bone
 257   {
 258   # used by parent class bone() to initialize number to 1
 259   my $self = shift;
 260   $self->{_n} = Math::BigInt->bone();
 261   $self->{_d} = Math::BigInt->bone();
 262   }
 263
 264 sub _bzero
 265   {
 266   # used by parent class bone() to initialize number to 1
 267   my $self = shift;
 268   $self->{_n} = Math::BigInt->bzero();
 269   $self->{_d} = Math::BigInt->bone();
 270   }
 271
 272 ##############################################################################
 273 # mul/add/div etc
 274
 275 sub badd
 276   {
 277   # add two rationales
 278   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 279
 280   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
 281
 282   # TODO: upgrade
 283
 284 #  # upgrade
 285 #  return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
 286
 287   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
 288   #  - + -                  = --------- = --
 289   #  4   3                      4*3       12
 290
 291   my $gcd = $x->{_d}->bgcd($y->{_d});
 292
 293   my $aa = $x->{_d}->copy();
 294   my $bb = $y->{_d}->copy();
 295   if ($gcd->is_one())
 296     {
 297     $bb->bdiv($gcd); $aa->bdiv($gcd);
 298     }
 299   $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
 300   my $m = $y->{_n}->copy()->bmul($aa);
 301   $m->{sign} = $y->{sign};                      # 2/1 - 2/1
 302   $x->{_n}->badd($m);
 303
 304   $x->{_d}->bmul($y->{_d});
 305
 306   # calculate new sign
 307   $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
 308
 309   $x->bnorm()->round($a,$p,$r);
 310   }
 311
 312 sub bsub
 313   {
 314   # subtract two rationales
 315   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 316
 317   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
 318   # TODO: inf handling
 319
 320   # TODO: upgrade
 321
 322 #  # upgrade
 323 #  return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
 324
 325   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
 326   #  - + -                  = --------- = --
 327   #  4   3                      4*3       12
 328
 329   my $gcd = $x->{_d}->bgcd($y->{_d});
 330
 331   my $aa = $x->{_d}->copy();
 332   my $bb = $y->{_d}->copy();
 333   if ($gcd->is_one())
 334     {
 335     $bb->bdiv($gcd); $aa->bdiv($gcd);
 336     }
 337   $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
 338   my $m = $y->{_n}->copy()->bmul($aa);
 339   $m->{sign} = $y->{sign};                      # 2/1 - 2/1
 340   $x->{_n}->bsub($m);
 341
 342   $x->{_d}->bmul($y->{_d});
 343
 344   # calculate new sign
 345   $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
 346
 347   $x->bnorm()->round($a,$p,$r);
 348   }
 349
 350 sub bmul
 351   {
 352   # multiply two rationales
 353   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 354
 355   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
 356
 357   # inf handling
 358   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
 359     {
 360     return $x->bnan() if $x->is_zero() || $y->is_zero();
 361     # result will always be +-inf:
 362     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
 363     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
 364     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
 365     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
 366     return $x->binf('-');
 367     }
 368
 369   # x== 0 # also: or y == 1 or y == -1
 370   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
 371
 372   # TODO: upgrade
 373
 374 #  # upgrade
 375 #  return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
 376
 377   # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
 378   # and reducing in one step)
 379
 380   #  1   1    2    1
 381   #  - * - =  -  = -
 382   #  4   3    12   6
 383   $x->{_n}->bmul($y->{_n});
 384   $x->{_d}->bmul($y->{_d});
 385
 386   # compute new sign
 387   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
 388
 389   $x->bnorm()->round($a,$p,$r);
 390   }
 391
 392 sub bdiv
 393   {
 394   # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
 395   # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
 396   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 397
 398   return $self->_div_inf($x,$y)
 399    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
 400
 401   # x== 0 # also: or y == 1 or y == -1
 402   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
 403
 404   # TODO: list context, upgrade
 405
 406 #  # upgrade
 407 #  return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
 408
 409   # 1     1    1   3
 410   # -  /  - == - * -
 411   # 4     3    4   1
 412   $x->{_n}->bmul($y->{_d});
 413   $x->{_d}->bmul($y->{_n});
 414
 415   # compute new sign
 416   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
 417
 418   $x->bnorm()->round($a,$p,$r);
 419   }
 420
 421 ##############################################################################
 422 # is_foo methods (the rest is inherited)
 423
 424 sub is_int
 425   {
 426   # return true if arg (BRAT or num_str) is an integer
 427   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 428
 429   return 1 if ($x->{sign} =~ /^[+-]$/) &&       # NaN and +-inf aren't
 430     $x->{_d}->is_one();                         # 1e-1 => no integer
 431   0;
 432   }
 433
 434 sub is_zero
 435   {
 436   # return true if arg (BRAT or num_str) is zero
 437   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 438
 439   return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
 440   0;
 441   }
 442
 443 sub is_one
 444   {
 445   # return true if arg (BRAT or num_str) is +1 or -1 if signis given
 446   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 447
 448   my $sign = shift || ''; $sign = '+' if $sign ne '-';
 449   return 1
 450    if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
 451   0;
 452   }
 453
 454 sub is_odd
 455   {
 456   # return true if arg (BFLOAT or num_str) is odd or false if even
 457   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 458
 459   return 1 if ($x->{sign} =~ /^[+-]$/) &&               # NaN & +-inf aren't
 460     ($x->{_d}->is_one() && $x->{_n}->is_odd());         # x/2 is not, but 3/1
 461   0;
 462   }
 463
 464 sub is_even
 465   {
 466   # return true if arg (BINT or num_str) is even or false if odd
 467   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 468
 469   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
 470   return 1 if ($x->{_d}->is_one()                       # x/3 is never
 471      && $x->{_n}->is_even());                           # but 4/1 is
 472   0;
 473   }
 474
 475 BEGIN
 476   {
 477   *objectify = \&Math::BigInt::objectify;
 478   }
 479
 480 ##############################################################################
 481 # parts() and friends
 482
 483 sub numerator
 484   {
 485   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 486
 487   my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
 488   $n;
 489   }
 490
 491 sub denominator
 492   {
 493   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 494
 495   $x->{_d}->copy();
 496   }
 497
 498 sub parts
 499   {
 500   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 501
 502   my $n = $x->{_n}->copy();
 503   $n->{sign} = $x->{sign};
 504   return ($x->{_n}->copy(),$x->{_d}->copy());
 505   }
 506
 507 sub length
 508   {
 509   return 0;
 510   }
 511
 512 sub digit
 513   {
 514   return 0;
 515   }
 516
 517 ##############################################################################
 518 # special calc routines
 519
 520 sub bceil
 521   {
 522   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 523
 524   return $x unless $x->{sign} =~ /^[+-]$/;
 525   return $x if $x->{_d}->is_one();              # 22/1 => 22, 0/1 => 0
 526
 527   $x->{_n}->bdiv($x->{_d});                     # 22/7 => 3/1
 528   $x->{_d}->bone();
 529   $x->{_n}->binc() if $x->{sign} eq '+';        # +22/7 => 4/1
 530   $x;
 531   }
 532
 533 sub bfloor
 534   {
 535   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 536
 537   return $x unless $x->{sign} =~ /^[+-]$/;
 538   return $x if $x->{_d}->is_one();              # 22/1 => 22, 0/1 => 0
 539
 540   $x->{_n}->bdiv($x->{_d});                     # 22/7 => 3/1
 541   $x->{_d}->bone();
 542   $x->{_n}->binc() if $x->{sign} eq '-';        # -22/7 => -4/1
 543   $x;
 544   }
 545
 546 sub bfac
 547   {
 548   return Math::BigRat->bnan();
 549   }
 550
 551 sub bpow
 552   {
 553   my ($self,$x,$y,@r) = objectify(2,@_);
 554
 555   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
 556   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
 557   return $x->bone(@r) if $y->is_zero();
 558   return $x->round(@r) if $x->is_one() || $y->is_one();
 559   if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
 560     {
 561     # if $x == -1 and odd/even y => +1/-1
 562     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
 563     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
 564     }
 565   # 1 ** -y => 1 / (1 ** |y|)
 566   # so do test for negative $y after above's clause
 567  #  return $x->bnan() if $y->{sign} eq '-';
 568   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 569
 570   my $pow2 = $self->__one();
 571   my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs();
 572   my $two = Math::BigInt->new(2);
 573   while (!$y1->is_one())
 574     {
 575     print "at $y1 (= $x)\n";
 576     $pow2->bmul($x) if $y1->is_odd();
 577     $y1->bdiv($two);
 578     $x->bmul($x);
 579     }
 580   $x->bmul($pow2) unless $pow2->is_one();
 581   # n ** -x => 1/n ** x
 582   ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
 583   $x;
 584   #$x->round(@r);
 585   }
 586
 587 sub blog
 588   {
 589   return Math::BigRat->bnan();
 590   }
 591
 592 sub bsqrt
 593   {
 594   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 595
 596   return $x->bnan() if $x->{sign} ne '+';       # inf, NaN, -1 etc
 597   $x->{_d}->bsqrt($a,$p,$r);
 598   $x->{_n}->bsqrt($a,$p,$r);
 599   $x->bnorm();
 600   }
 601
 602 sub blsft
 603   {
 604   my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
 605
 606   $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
 607   $x;
 608   }
 609
 610 sub brsft
 611   {
 612   my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
 613
 614   $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
 615   $x;
 616   }
 617
 618 ##############################################################################
 619 # round
 620
 621 sub round
 622   {
 623   $_[0];
 624   }
 625
 626 sub bround
 627   {
 628   $_[0];
 629   }
 630
 631 sub bfround
 632   {
 633   $_[0];
 634   }
 635
 636 ##############################################################################
 637 # comparing
 638
 639 sub bcmp
 640   {
 641   my ($self,$x,$y) = objectify(2,@_);
 642
 643   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 644     {
 645     # handle +-inf and NaN
 646     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 647     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
 648     return +1 if $x->{sign} eq '+inf';
 649     return -1 if $x->{sign} eq '-inf';
 650     return -1 if $y->{sign} eq '+inf';
 651     return +1;
 652     }
 653   # check sign for speed first
 654   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
 655   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
 656
 657   # shortcut
 658   my $xz = $x->{_n}->is_zero();
 659   my $yz = $y->{_n}->is_zero();
 660   return 0 if $xz && $yz;                               # 0 <=> 0
 661   return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
 662   return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
 663
 664   my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
 665   my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
 666   $t->bcmp($u);
 667   }
 668
 669 sub bacmp
 670   {
 671   my ($self,$x,$y) = objectify(2,@_);
 672
 673   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
 674     {
 675     # handle +-inf and NaN
 676     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
 677     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
 678     return +1;  # inf is always bigger
 679     }
 680
 681   my $t = $x->{_n} * $y->{_d};
 682   my $u = $y->{_n} * $x->{_d};
 683   $t->bacmp($u);
 684   }
 685
 686 ##############################################################################
 687 # output conversation
 688
 689 sub as_number
 690   {
 691   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 692
 693   return $x if $x->{sign} !~ /^[+-]$/;                  # NaN, inf etc
 694   my $t = $x->{_n}->copy()->bdiv($x->{_d});             # 22/7 => 3
 695   $t->{sign} = $x->{sign};
 696   $t;
 697   }
 698
 699 #sub import
 700 #  {
 701 #  my $self = shift;
 702 #  Math::BigInt->import(@_);
 703 #  $self->SUPER::import(@_);                     # need it for subclasses
 704 #  #$self->export_to_level(1,$self,@_);          # need this ?
 705 #  }
 706
 707 1;
 708
 709 __END__
 710
 711 =head1 NAME
 712
 713 Math::BigRat - arbitrarily big rationales
 714
 715 =head1 SYNOPSIS
 716
 717   use Math::BigRat;
 718
 719   $x = Math::BigRat->new('3/7');
 720
 721   print $x->bstr(),"\n";
 722
 723 =head1 DESCRIPTION
 724
 725 This is just a placeholder until the real thing is up and running. Watch this
 726 space...
 727
 728 =head2 MATH LIBRARY
 729
 730 Math with the numbers is done (by default) by a module called
 731 Math::BigInt::Calc. This is equivalent to saying:
 732
 733         use Math::BigRat lib => 'Calc';
 734
 735 You can change this by using:
 736
 737         use Math::BigRat lib => 'BitVect';
 738
 739 The following would first try to find Math::BigInt::Foo, then
 740 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
 741
 742         use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
 743
 744 Calc.pm uses as internal format an array of elements of some decimal base
 745 (usually 1e7, but this might be differen for some systems) with the least
 746 significant digit first, while BitVect.pm uses a bit vector of base 2, most
 747 significant bit first. Other modules might use even different means of
 748 representing the numbers. See the respective module documentation for further
 749 details.
 750
 751 =head1 METHODS
 752
 753 =head2 new
 754
 755         $x = Math::BigRat->new('1/3');
 756
 757 Create a new Math::BigRat object. Input can come in various forms:
 758
 759         $x = Math::BigRat->new('1/3');                          # simple string
 760         $x = Math::BigRat->new('1 / 3');                        # spaced
 761         $x = Math::BigRat->new('1 / 0.1');                      # w/ floats
 762         $x = Math::BigRat->new(Math::BigInt->new(3));           # BigInt
 763         $x = Math::BigRat->new(Math::BigFloat->new('3.1'));     # BigFloat
 764
 765 =head2 numerator
 766
 767         $n = $x->numerator();
 768
 769 Returns a copy of the numerator (the part above the line) as signed BigInt.
 770
 771 =head2 denominator
 772
 773         $d = $x->denominator();
 774
 775 Returns a copy of the denominator (the part under the line) as positive BigInt.
 776
 777 =head2 parts
 778
 779         ($n,$d) = $x->parts();
 780
 781 Return a list consisting of (signed) numerator and (unsigned) denominator as
 782 BigInts.
 783
 784 =head1 BUGS
 785
 786 None know yet. Please see also L<Math::BigInt>.
 787
 788 =head1 LICENSE
 789
 790 This program is free software; you may redistribute it and/or modify it under
 791 the same terms as Perl itself.
 792
 793 =head1 SEE ALSO
 794
 795 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
 796 L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
 797
 798 The package at
 799 L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigRat> may
 800 contain more documentation and examples as well as testcases.
 801
 802 =head1 AUTHORS
 803
 804 (C) by Tels L<http://bloodgate.com/> 2001-2002.
 805
 806 =cut