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