lib/Math/BigRat.pm

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