lib/Math/BigRat.pm

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