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