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 # You should not look at the innards of a BigRat - use the methods for this.
  13
  14 package Math::BigRat;
  15
  16 require 5.005_03;
  17 use strict;
  18
  19 use Math::BigFloat;
  20 use vars qw($VERSION @ISA $upgrade $downgrade
  21             $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
  22
  23 @ISA = qw(Math::BigFloat);
  24
  25 $VERSION = '0.15';
  26
  27 use overload;                   # inherit overload from Math::BigFloat
  28
  29 BEGIN
  30   {
  31   *objectify = \&Math::BigInt::objectify;       # inherit this from BigInt
  32   *AUTOLOAD = \&Math::BigFloat::AUTOLOAD;       # can't inherit AUTOLOAD
  33   # we inherit these from BigFloat because currently it is not possible
  34   # that MBF has a different $MBI variable than we, because MBF also uses
  35   # Math::BigInt::config->('lib'); (there is always only one library loaded)
  36   *_e_add = \&Math::BigFloat::_e_add;
  37   *_e_sub = \&Math::BigFloat::_e_sub;
  38   *as_int = \&as_number;
  39   *is_pos = \&is_positive;
  40   *is_neg = \&is_negative;
  41   }
  42
  43 ##############################################################################
  44 # Global constants and flags. Access these only via the accessor methods!
  45
  46 $accuracy = $precision = undef;
  47 $round_mode = 'even';
  48 $div_scale = 40;
  49 $upgrade = undef;
  50 $downgrade = undef;
  51
  52 # These are internally, and not to be used from the outside at all!
  53
  54 $_trap_nan = 0;                         # are NaNs ok? set w/ config()
  55 $_trap_inf = 0;                         # are infs ok? set w/ config()
  56
  57 # the package we are using for our private parts, defaults to:
  58 # Math::BigInt->config()->{lib}
  59 my $MBI = 'Math::BigInt::Calc';
  60
  61 my $nan = 'NaN';
  62 my $class = 'Math::BigRat';
  63
  64 sub isa
  65   {
  66   return 0 if $_[1] =~ /^Math::Big(Int|Float)/;         # we aren't
  67   UNIVERSAL::isa(@_);
  68   }
  69
  70 ##############################################################################
  71
  72 sub _new_from_float
  73   {
  74   # turn a single float input into a rational number (like '0.1')
  75   my ($self,$f) = @_;
  76
  77   return $self->bnan() if $f->is_nan();
  78   return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
  79
  80   $self->{_n} = $MBI->_copy( $f->{_m} );        # mantissa
  81   $self->{_d} = $MBI->_one();
  82   $self->{sign} = $f->{sign} || '+';
  83   if ($f->{_es} eq '-')
  84     {
  85     # something like Math::BigRat->new('0.1');
  86     # 1 / 1 => 1/10
  87     $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);
  88     }
  89   else
  90     {
  91     # something like Math::BigRat->new('10');
  92     # 1 / 1 => 10/1
  93     $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless
  94       $MBI->_is_zero($f->{_e});
  95     }
  96   $self;
  97   }
  98
  99 sub new
 100   {
 101   # create a Math::BigRat
 102   my $class = shift;
 103
 104   my ($n,$d) = @_;
 105
 106   my $self = { }; bless $self,$class;
 107
 108   # input like (BigInt) or (BigFloat):
 109   if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
 110     {
 111     if ($n->isa('Math::BigFloat'))
 112       {
 113       $self->_new_from_float($n);
 114       }
 115     if ($n->isa('Math::BigInt'))
 116       {
 117       # TODO: trap NaN, inf
 118       $self->{_n} = $MBI->_copy($n->{value});           # "mantissa" = N
 119       $self->{_d} = $MBI->_one();                       # d => 1
 120       $self->{sign} = $n->{sign};
 121       }
 122     if ($n->isa('Math::BigInt::Lite'))
 123       {
 124       # TODO: trap NaN, inf
 125       $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
 126       $self->{_n} = $MBI->_new(abs($$n));               # "mantissa" = N
 127       $self->{_d} = $MBI->_one();                       # d => 1
 128       }
 129     return $self->bnorm();                              # normalize (120/1 => 12/10)
 130     }
 131
 132   # input like (BigInt,BigInt) or (BigLite,BigLite):
 133   if (ref($d) && ref($n))
 134     {
 135     # do N first (for $self->{sign}):
 136     if ($n->isa('Math::BigInt'))
 137       {
 138       # TODO: trap NaN, inf
 139       $self->{_n} = $MBI->_copy($n->{value});           # "mantissa" = N
 140       $self->{sign} = $n->{sign};
 141       }
 142     elsif ($n->isa('Math::BigInt::Lite'))
 143       {
 144       # TODO: trap NaN, inf
 145       $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
 146       $self->{_n} = $MBI->_new(abs($$n));               # "mantissa" = $n
 147       }
 148     else
 149       {
 150       require Carp;
 151       Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
 152       }
 153     # now D:
 154     if ($d->isa('Math::BigInt'))
 155       {
 156       # TODO: trap NaN, inf
 157       $self->{_d} = $MBI->_copy($d->{value});           # "mantissa" = D
 158       # +/+ or -/- => +, +/- or -/+ => -
 159       $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
 160       }
 161     elsif ($d->isa('Math::BigInt::Lite'))
 162       {
 163       # TODO: trap NaN, inf
 164       $self->{_d} = $MBI->_new(abs($$d));               # "mantissa" = D
 165       my $ds = '+'; $ds = '-' if $$d < 0;
 166       # +/+ or -/- => +, +/- or -/+ => -
 167       $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
 168       }
 169     else
 170       {
 171       require Carp;
 172       Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
 173       }
 174     return $self->bnorm();                              # normalize (120/1 => 12/10)
 175     }
 176   return $n->copy() if ref $n;                          # already a BigRat
 177
 178   if (!defined $n)
 179     {
 180     $self->{_n} = $MBI->_zero();                        # undef => 0
 181     $self->{_d} = $MBI->_one();
 182     $self->{sign} = '+';
 183     return $self;
 184     }
 185
 186   # string input with / delimiter
 187   if ($n =~ /\s*\/\s*/)
 188     {
 189     return $class->bnan() if $n =~ /\/.*\//;    # 1/2/3 isn't valid
 190     return $class->bnan() if $n =~ /\/\s*$/;    # 1/ isn't valid
 191     ($n,$d) = split (/\//,$n);
 192     # try as BigFloats first
 193     if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
 194       {
 195       local $Math::BigFloat::accuracy = undef;
 196       local $Math::BigFloat::precision = undef;
 197
 198       # one of them looks like a float
 199       my $nf = Math::BigFloat->new($n,undef,undef);
 200       $self->{sign} = '+';
 201       return $self->bnan() if $nf->is_nan();
 202
 203       $self->{_n} = $MBI->_copy( $nf->{_m} );   # get mantissa
 204
 205       # now correct $self->{_n} due to $n
 206       my $f = Math::BigFloat->new($d,undef,undef);
 207       return $self->bnan() if $f->is_nan();
 208       $self->{_d} = $MBI->_copy( $f->{_m} );
 209
 210       # calculate the difference between nE and dE
 211       # XXX TODO: check that exponent() makes a copy to avoid copy()
 212       my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
 213       if ($diff_e->is_negative())
 214         {
 215         # < 0: mul d with it
 216         $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
 217         }
 218       elsif (!$diff_e->is_zero())
 219         {
 220         # > 0: mul n with it
 221         $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
 222         }
 223       }
 224     else
 225       {
 226       # both d and n look like (big)ints
 227
 228       $self->{sign} = '+';                                      # no sign => '+'
 229       $self->{_n} = undef;
 230       $self->{_d} = undef;
 231       if ($n =~ /^([+-]?)0*(\d+)\z/)                            # first part ok?
 232         {
 233         $self->{sign} = $1 || '+';                              # no sign => '+'
 234         $self->{_n} = $MBI->_new($2 || 0);
 235         }
 236
 237       if ($d =~ /^([+-]?)0*(\d+)\z/)                            # second part ok?
 238         {
 239         $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-';        # negate if second part neg.
 240         $self->{_d} = $MBI->_new($2 || 0);
 241         }
 242
 243       if (!defined $self->{_n} || !defined $self->{_d})
 244         {
 245         $d = Math::BigInt->new($d,undef,undef) unless ref $d;
 246         $n = Math::BigInt->new($n,undef,undef) unless ref $n;
 247
 248         if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
 249           {
 250           # both parts are ok as integers (wierd things like ' 1e0'
 251           $self->{_n} = $MBI->_copy($n->{value});
 252           $self->{_d} = $MBI->_copy($d->{value});
 253           $self->{sign} = $n->{sign};
 254           $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-';      # -1/-2 => 1/2
 255           return $self->bnorm();
 256           }
 257
 258         $self->{sign} = '+';                                    # a default sign
 259         return $self->bnan() if $n->is_nan() || $d->is_nan();
 260
 261         # handle inf cases:
 262         if ($n->is_inf() || $d->is_inf())
 263           {
 264           if ($n->is_inf())
 265             {
 266             return $self->bnan() if $d->is_inf();               # both are inf => NaN
 267             my $s = '+';                # '+inf/+123' or '-inf/-123'
 268             $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
 269             # +-inf/123 => +-inf
 270             return $self->binf($s);
 271             }
 272           # 123/inf => 0
 273           return $self->bzero();
 274           }
 275         }
 276       }
 277
 278     return $self->bnorm();
 279     }
 280
 281   # simple string input
 282   if (($n =~ /[\.eE]/))
 283     {
 284     # looks like a float, quacks like a float, so probably is a float
 285     $self->{sign} = 'NaN';
 286     local $Math::BigFloat::accuracy = undef;
 287     local $Math::BigFloat::precision = undef;
 288     $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
 289     }
 290   else
 291     {
 292     # for simple forms, use $MBI directly
 293     if ($n =~ /^([+-]?)0*(\d+)\z/)
 294       {
 295       $self->{sign} = $1 || '+';
 296       $self->{_n} = $MBI->_new($2 || 0);
 297       $self->{_d} = $MBI->_one();
 298       }
 299     else
 300       {
 301       my $n = Math::BigInt->new($n,undef,undef);
 302       $self->{_n} = $MBI->_copy($n->{value});
 303       $self->{_d} = $MBI->_one();
 304       $self->{sign} = $n->{sign};
 305       return $self->bnan() if $self->{sign} eq 'NaN';
 306       return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
 307       }
 308     }
 309   $self->bnorm();
 310   }
 311
 312 sub copy
 313   {
 314   # if two arguments, the first one is the class to "swallow" subclasses
 315   my ($c,$x) = @_;
 316
 317   if (scalar @_ == 1)
 318     {
 319     $x = $_[0];
 320     $c = ref($x);
 321     }
 322   return unless ref($x); # only for objects
 323
 324   my $self = bless {}, $c;
 325
 326   $self->{sign} = $x->{sign};
 327   $self->{_d} = $MBI->_copy($x->{_d});
 328   $self->{_n} = $MBI->_copy($x->{_n});
 329   $self->{_a} = $x->{_a} if defined $x->{_a};
 330   $self->{_p} = $x->{_p} if defined $x->{_p};
 331   $self;
 332   }
 333
 334 ##############################################################################
 335
 336 sub config
 337   {
 338   # return (later set?) configuration data as hash ref
 339   my $class = shift || 'Math::BigRat';
 340
 341   my $cfg = $class->SUPER::config(@_);
 342
 343   # now we need only to override the ones that are different from our parent
 344   $cfg->{class} = $class;
 345   $cfg->{with} = $MBI;
 346   $cfg;
 347   }
 348
 349 ##############################################################################
 350
 351 sub bstr
 352   {
 353   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 354
 355   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
 356     {
 357     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
 358     return $s;
 359     }
 360
 361   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # '+3/2' => '3/2'
 362
 363   return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
 364   $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
 365   }
 366
 367 sub bsstr
 368   {
 369   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 370
 371   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
 372     {
 373     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
 374     return $s;
 375     }
 376
 377   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # +3 vs 3
 378   $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
 379   }
 380
 381 sub bnorm
 382   {
 383   # reduce the number to the shortest form
 384   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 385
 386   # Both parts must be objects of whatever we are using today.
 387   # Second check because Calc.pm has ARRAY res as unblessed objects.
 388   if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
 389     {
 390     require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
 391     }
 392   if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
 393     {
 394     require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
 395     }
 396
 397   # no normalize for NaN, inf etc.
 398   return $x if $x->{sign} !~ /^[+-]$/;
 399
 400   # normalize zeros to 0/1
 401   if ($MBI->_is_zero($x->{_n}))
 402     {
 403     $x->{sign} = '+';                                   # never leave a -0
 404     $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
 405     return $x;
 406     }
 407
 408   return $x if $MBI->_is_one($x->{_d});                 # no need to reduce
 409
 410   # reduce other numbers
 411   my $gcd = $MBI->_copy($x->{_n});
 412   $gcd = $MBI->_gcd($gcd,$x->{_d});
 413
 414   if (!$MBI->_is_one($gcd))
 415     {
 416     $x->{_n} = $MBI->_div($x->{_n},$gcd);
 417     $x->{_d} = $MBI->_div($x->{_d},$gcd);
 418     }
 419   $x;
 420   }
 421
 422 ##############################################################################
 423 # sign manipulation
 424
 425 sub bneg
 426   {
 427   # (BRAT or num_str) return BRAT
 428   # negate number or make a negated number from string
 429   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 430
 431   return $x if $x->modify('bneg');
 432
 433   # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
 434   $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
 435   $x;
 436   }
 437
 438 ##############################################################################
 439 # special values
 440
 441 sub _bnan
 442   {
 443   # used by parent class bnan() to initialize number to NaN
 444   my $self = shift;
 445
 446   if ($_trap_nan)
 447     {
 448     require Carp;
 449     my $class = ref($self);
 450     # "$self" below will stringify the object, this blows up if $self is a
 451     # partial object (happens under trap_nan), so fix it beforehand
 452     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
 453     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
 454     Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
 455     }
 456   $self->{_n} = $MBI->_zero();
 457   $self->{_d} = $MBI->_zero();
 458   }
 459
 460 sub _binf
 461   {
 462   # used by parent class bone() to initialize number to +inf/-inf
 463   my $self = shift;
 464
 465   if ($_trap_inf)
 466     {
 467     require Carp;
 468     my $class = ref($self);
 469     # "$self" below will stringify the object, this blows up if $self is a
 470     # partial object (happens under trap_nan), so fix it beforehand
 471     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
 472     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
 473     Carp::croak ("Tried to set $self to inf in $class\::_binf()");
 474     }
 475   $self->{_n} = $MBI->_zero();
 476   $self->{_d} = $MBI->_zero();
 477   }
 478
 479 sub _bone
 480   {
 481   # used by parent class bone() to initialize number to +1/-1
 482   my $self = shift;
 483   $self->{_n} = $MBI->_one();
 484   $self->{_d} = $MBI->_one();
 485   }
 486
 487 sub _bzero
 488   {
 489   # used by parent class bzero() to initialize number to 0
 490   my $self = shift;
 491   $self->{_n} = $MBI->_zero();
 492   $self->{_d} = $MBI->_one();
 493   }
 494
 495 ##############################################################################
 496 # mul/add/div etc
 497
 498 sub badd
 499   {
 500   # add two rational numbers
 501
 502   # set up parameters
 503   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 504   # objectify is costly, so avoid it
 505   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 506     {
 507     ($self,$x,$y,@r) = objectify(2,@_);
 508     }
 509
 510   # +inf + +inf => +inf,  -inf + -inf => -inf
 511   return $x->binf(substr($x->{sign},0,1))
 512     if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
 513
 514   # +inf + -inf or -inf + +inf => NaN
 515   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
 516
 517   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
 518   #  - + -                  = --------- = --
 519   #  4   3                      4*3       12
 520
 521   # we do not compute the gcd() here, but simple do:
 522   #  5   7    5*3 + 7*4   43
 523   #  - + -  = --------- = --
 524   #  4   3       4*3      12
 525
 526   # and bnorm() will then take care of the rest
 527
 528   # 5 * 3
 529   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
 530
 531   # 7 * 4
 532   my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} );
 533
 534   # 5 * 3 + 7 * 4
 535   ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign});
 536
 537   # 4 * 3
 538   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
 539
 540   # normalize result, and possible round
 541   $x->bnorm()->round(@r);
 542   }
 543
 544 sub bsub
 545   {
 546   # subtract two rational numbers
 547
 548   # set up parameters
 549   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 550   # objectify is costly, so avoid it
 551   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 552     {
 553     ($self,$x,$y,@r) = objectify(2,@_);
 554     }
 555
 556   # flip sign of $x, call badd(), then flip sign of result
 557   $x->{sign} =~ tr/+-/-+/
 558     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});       # not -0
 559   $x->badd($y,@r);                              # does norm and round
 560   $x->{sign} =~ tr/+-/-+/
 561     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});       # not -0
 562   $x;
 563   }
 564
 565 sub bmul
 566   {
 567   # multiply two rational numbers
 568
 569   # set up parameters
 570   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 571   # objectify is costly, so avoid it
 572   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 573     {
 574     ($self,$x,$y,@r) = objectify(2,@_);
 575     }
 576
 577   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
 578
 579   # inf handling
 580   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
 581     {
 582     return $x->bnan() if $x->is_zero() || $y->is_zero();
 583     # result will always be +-inf:
 584     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
 585     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
 586     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
 587     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
 588     return $x->binf('-');
 589     }
 590
 591   # x== 0 # also: or y == 1 or y == -1
 592   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
 593
 594   # XXX TODO:
 595   # According to Knuth, this can be optimized by doing gcd twice (for d and n)
 596   # and reducing in one step. This would save us the bnorm() at the end.
 597
 598   #  1   2    1 * 2    2    1
 599   #  - * - =  -----  = -  = -
 600   #  4   3    4 * 3    12   6
 601
 602   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n});
 603   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
 604
 605   # compute new sign
 606   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
 607
 608   $x->bnorm()->round(@r);
 609   }
 610
 611 sub bdiv
 612   {
 613   # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
 614   # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
 615
 616   # set up parameters
 617   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 618   # objectify is costly, so avoid it
 619   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 620     {
 621     ($self,$x,$y,@r) = objectify(2,@_);
 622     }
 623
 624   return $self->_div_inf($x,$y)
 625    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
 626
 627   # x== 0 # also: or y == 1 or y == -1
 628   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
 629
 630   # XXX TODO: list context, upgrade
 631   # According to Knuth, this can be optimized by doing gcd twice (for d and n)
 632   # and reducing in one step. This would save us the bnorm() at the end.
 633
 634   # 1     1    1   3
 635   # -  /  - == - * -
 636   # 4     3    4   1
 637
 638   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
 639   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n});
 640
 641   # compute new sign
 642   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
 643
 644   $x->bnorm()->round(@r);
 645   $x;
 646   }
 647
 648 sub bmod
 649   {
 650   # compute "remainder" (in Perl way) of $x / $y
 651
 652   # set up parameters
 653   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 654   # objectify is costly, so avoid it
 655   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 656     {
 657     ($self,$x,$y,@r) = objectify(2,@_);
 658     }
 659
 660   return $self->_div_inf($x,$y)
 661    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
 662
 663   return $x if $x->is_zero();           # 0 / 7 = 0, mod 0
 664
 665   # compute $x - $y * floor($x/$y), keeping the sign of $x
 666
 667   # copy x to u, make it positive and then do a normal division ($u/$y)
 668   my $u = bless { sign => '+' }, $self;
 669   $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
 670   $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
 671
 672   # compute floor(u)
 673   if (! $MBI->_is_one($u->{_d}))
 674     {
 675     $u->{_n} = $MBI->_div($u->{_n},$u->{_d});   # 22/7 => 3/1 w/ truncate
 676     # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
 677     }
 678
 679   # now compute $y * $u
 680   $u->{_d} = $MBI->_copy($y->{_d});             # 1 * $y->{_d}, see floor above
 681   $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
 682
 683   my $xsign = $x->{sign}; $x->{sign} = '+';     # remember sign and make x positive
 684   # compute $x - $u
 685   $x->bsub($u);
 686   $x->{sign} = $xsign;                          # put sign back
 687
 688   $x->bnorm()->round(@r);
 689   }
 690
 691 ##############################################################################
 692 # bdec/binc
 693
 694 sub bdec
 695   {
 696   # decrement value (subtract 1)
 697   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 698
 699   return $x if $x->{sign} !~ /^[+-]$/;  # NaN, inf, -inf
 700
 701   if ($x->{sign} eq '-')
 702     {
 703     $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d});         # -5/2 => -7/2
 704     }
 705   else
 706     {
 707     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)             # n < d?
 708       {
 709       # 1/3 -- => -2/3
 710       $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
 711       $x->{sign} = '-';
 712       }
 713     else
 714       {
 715       $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d});        # 5/2 => 3/2
 716       }
 717     }
 718   $x->bnorm()->round(@r);
 719   }
 720
 721 sub binc
 722   {
 723   # increment value (add 1)
 724   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 725
 726   return $x if $x->{sign} !~ /^[+-]$/;  # NaN, inf, -inf
 727
 728   if ($x->{sign} eq '-')
 729     {
 730     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)
 731       {
 732       # -1/3 ++ => 2/3 (overflow at 0)
 733       $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
 734       $x->{sign} = '+';
 735       }
 736     else
 737       {
 738       $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d});        # -5/2 => -3/2
 739       }
 740     }
 741   else
 742     {
 743     $x->{_n} = $MBI->_add($x->{_n},$x->{_d});           # 5/2 => 7/2
 744     }
 745   $x->bnorm()->round(@r);
 746   }
 747
 748 ##############################################################################
 749 # is_foo methods (the rest is inherited)
 750
 751 sub is_int
 752   {
 753   # return true if arg (BRAT or num_str) is an integer
 754   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 755
 756   return 1 if ($x->{sign} =~ /^[+-]$/) &&       # NaN and +-inf aren't
 757     $MBI->_is_one($x->{_d});                    # x/y && y != 1 => no integer
 758   0;
 759   }
 760
 761 sub is_zero
 762   {
 763   # return true if arg (BRAT or num_str) is zero
 764   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 765
 766   return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});
 767   0;
 768   }
 769
 770 sub is_one
 771   {
 772   # return true if arg (BRAT or num_str) is +1 or -1 if signis given
 773   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 774
 775   my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
 776   return 1
 777    if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}));
 778   0;
 779   }
 780
 781 sub is_odd
 782   {
 783   # return true if arg (BFLOAT or num_str) is odd or false if even
 784   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 785
 786   return 1 if ($x->{sign} =~ /^[+-]$/) &&               # NaN & +-inf aren't
 787     ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1
 788   0;
 789   }
 790
 791 sub is_even
 792   {
 793   # return true if arg (BINT or num_str) is even or false if odd
 794   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 795
 796   return 0 if $x->{sign} !~ /^[+-]$/;                   # NaN & +-inf aren't
 797   return 1 if ($MBI->_is_one($x->{_d})                  # x/3 is never
 798      && $MBI->_is_even($x->{_n}));                      # but 4/1 is
 799   0;
 800   }
 801
 802 ##############################################################################
 803 # parts() and friends
 804
 805 sub numerator
 806   {
 807   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 808
 809   # NaN, inf, -inf
 810   return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
 811
 812   my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign};
 813   $n;
 814   }
 815
 816 sub denominator
 817   {
 818   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 819
 820   # NaN
 821   return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
 822   # inf, -inf
 823   return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
 824
 825   Math::BigInt->new($MBI->_str($x->{_d}));
 826   }
 827
 828 sub parts
 829   {
 830   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 831
 832   my $c = 'Math::BigInt';
 833
 834   return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN';
 835   return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf';
 836   return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf';
 837
 838   my $n = $c->new( $MBI->_str($x->{_n}));
 839   $n->{sign} = $x->{sign};
 840   my $d = $c->new( $MBI->_str($x->{_d}));
 841   ($n,$d);
 842   }
 843
 844 sub length
 845   {
 846   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
 847
 848   return $nan unless $x->is_int();
 849   $MBI->_len($x->{_n});                         # length(-123/1) => length(123)
 850   }
 851
 852 sub digit
 853   {
 854   my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_);
 855
 856   return $nan unless $x->is_int();
 857   $MBI->_digit($x->{_n},$n || 0);               # digit(-123/1,2) => digit(123,2)
 858   }
 859
 860 ##############################################################################
 861 # special calc routines
 862
 863 sub bceil
 864   {
 865   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 866
 867   return $x if $x->{sign} !~ /^[+-]$/ ||        # not for NaN, inf
 868             $MBI->_is_one($x->{_d});            # 22/1 => 22, 0/1 => 0
 869
 870   $x->{_n} = $MBI->_div($x->{_n},$x->{_d});     # 22/7 => 3/1 w/ truncate
 871   $x->{_d} = $MBI->_one();                      # d => 1
 872   $x->{_n} = $MBI->_inc($x->{_n})
 873     if $x->{sign} eq '+';                       # +22/7 => 4/1
 874   $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0
 875   $x;
 876   }
 877
 878 sub bfloor
 879   {
 880   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
 881
 882   return $x if $x->{sign} !~ /^[+-]$/ ||        # not for NaN, inf
 883             $MBI->_is_one($x->{_d});            # 22/1 => 22, 0/1 => 0
 884
 885   $x->{_n} = $MBI->_div($x->{_n},$x->{_d});     # 22/7 => 3/1 w/ truncate
 886   $x->{_d} = $MBI->_one();                      # d => 1
 887   $x->{_n} = $MBI->_inc($x->{_n})
 888     if $x->{sign} eq '-';                       # -22/7 => -4/1
 889   $x;
 890   }
 891
 892 sub bfac
 893   {
 894   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
 895
 896   # if $x is not an integer
 897   if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d})))
 898     {
 899     return $x->bnan();
 900     }
 901
 902   $x->{_n} = $MBI->_fac($x->{_n});
 903   # since _d is 1, we don't need to reduce/norm the result
 904   $x->round(@r);
 905   }
 906
 907 sub bpow
 908   {
 909   # power ($x ** $y)
 910
 911   # set up parameters
 912   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 913   # objectify is costly, so avoid it
 914   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 915     {
 916     ($self,$x,$y,@r) = objectify(2,@_);
 917     }
 918
 919   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
 920   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
 921   return $x->bone(@r) if $y->is_zero();
 922   return $x->round(@r) if $x->is_one() || $y->is_one();
 923
 924   if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}))
 925     {
 926     # if $x == -1 and odd/even y => +1/-1
 927     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
 928     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
 929     }
 930   # 1 ** -y => 1 / (1 ** |y|)
 931   # so do test for negative $y after above's clause
 932
 933   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 934
 935   # shortcut y/1 (and/or x/1)
 936   if ($MBI->_is_one($y->{_d}))
 937     {
 938     # shortcut for x/1 and y/1
 939     if ($MBI->_is_one($x->{_d}))
 940       {
 941       $x->{_n} = $MBI->_pow($x->{_n},$y->{_n});         # x/1 ** y/1 => (x ** y)/1
 942       if ($y->{sign} eq '-')
 943         {
 944         # 0.2 ** -3 => 1/(0.2 ** 3)
 945         ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});      # swap
 946         }
 947       # correct sign; + ** + => +
 948       if ($x->{sign} eq '-')
 949         {
 950         # - * - => +, - * - * - => -
 951         $x->{sign} = '+' if $MBI->_is_even($y->{_n});
 952         }
 953       return $x->round(@r);
 954       }
 955     # x/z ** y/1
 956     $x->{_n} = $MBI->_pow($x->{_n},$y->{_n});           # 5/2 ** y/1 => 5 ** y / 2 ** y
 957     $x->{_d} = $MBI->_pow($x->{_d},$y->{_n});
 958     if ($y->{sign} eq '-')
 959       {
 960       # 0.2 ** -3 => 1/(0.2 ** 3)
 961       ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});        # swap
 962       }
 963     # correct sign; + ** + => +
 964     if ($x->{sign} eq '-')
 965       {
 966       # - * - => +, - * - * - => -
 967       $x->{sign} = '+' if $MBI->_is_even($y->{_n});
 968       }
 969     return $x->round(@r);
 970     }
 971
 972   # regular calculation (this is wrong for d/e ** f/g)
 973   my $pow2 = $self->bone();
 974   my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
 975   my $two = $MBI->_two();
 976
 977   while (!$MBI->_is_one($y1))
 978     {
 979     $pow2->bmul($x) if $MBI->_is_odd($y1);
 980     $MBI->_div($y1, $two);
 981     $x->bmul($x);
 982     }
 983   $x->bmul($pow2) unless $pow2->is_one();
 984   # n ** -x => 1/n ** x
 985   ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
 986   $x->bnorm()->round(@r);
 987   }
 988
 989 sub blog
 990   {
 991   # set up parameters
 992   my ($self,$x,$y,@r) = (ref($_[0]),@_);
 993
 994   # objectify is costly, so avoid it
 995   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
 996     {
 997     ($self,$x,$y,@r) = objectify(2,$class,@_);
 998     }
 999
1000   # blog(1,Y) => 0
1001   return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
1002
1003   # $x <= 0 => NaN
1004   return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
1005
1006   if ($x->is_int() && $y->is_int())
1007     {
1008     return $self->new($x->as_number()->blog($y->as_number(),@r));
1009     }
1010
1011   # do it with floats
1012   $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
1013   }
1014
1015 sub _float_from_part
1016   {
1017   my $x = shift;
1018
1019   my $f = Math::BigFloat->bzero();
1020   $f->{_m} = $MBI->_copy($x);
1021   $f->{_e} = $MBI->_zero();
1022
1023   $f;
1024   }
1025
1026 sub _as_float
1027   {
1028   my $x = shift;
1029
1030   local $Math::BigFloat::upgrade = undef;
1031   local $Math::BigFloat::accuracy = undef;
1032   local $Math::BigFloat::precision = undef;
1033   # 22/7 => 3.142857143..
1034
1035   my $a = $x->accuracy() || 0;
1036   if ($a != 0 || !$MBI->_is_one($x->{_d}))
1037     {
1038     # n/d
1039     return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
1040     }
1041   # just n
1042   Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
1043   }
1044
1045 sub broot
1046   {
1047   # set up parameters
1048   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1049   # objectify is costly, so avoid it
1050   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1051     {
1052     ($self,$x,$y,@r) = objectify(2,@_);
1053     }
1054
1055   if ($x->is_int() && $y->is_int())
1056     {
1057     return $self->new($x->as_number()->broot($y->as_number(),@r));
1058     }
1059
1060   # do it with floats
1061   $x->_new_from_float( $x->_as_float()->broot($y,@r) );
1062   }
1063
1064 sub bmodpow
1065   {
1066   # set up parameters
1067   my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
1068   # objectify is costly, so avoid it
1069   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1070     {
1071     ($self,$x,$y,$m,@r) = objectify(3,@_);
1072     }
1073
1074   # $x or $y or $m are NaN or +-inf => NaN
1075   return $x->bnan()
1076    if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
1077    $m->{sign} !~ /^[+-]$/;
1078
1079   if ($x->is_int() && $y->is_int() && $m->is_int())
1080     {
1081     return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
1082     }
1083
1084   warn ("bmodpow() not fully implemented");
1085   $x->bnan();
1086   }
1087
1088 sub bmodinv
1089   {
1090   # set up parameters
1091   my ($self,$x,$y,@r) = (ref($_[0]),@_);
1092   # objectify is costly, so avoid it
1093   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1094     {
1095     ($self,$x,$y,@r) = objectify(2,@_);
1096     }
1097
1098   # $x or $y are NaN or +-inf => NaN
1099   return $x->bnan()
1100    if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
1101
1102   if ($x->is_int() && $y->is_int())
1103     {
1104     return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
1105     }
1106
1107   warn ("bmodinv() not fully implemented");
1108   $x->bnan();
1109   }
1110
1111 sub bsqrt
1112   {
1113   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1114
1115   return $x->bnan() if $x->{sign} !~ /^[+]/;    # NaN, -inf or < 0
1116   return $x if $x->{sign} eq '+inf';            # sqrt(inf) == inf
1117   return $x->round(@r) if $x->is_zero() || $x->is_one();
1118
1119   local $Math::BigFloat::upgrade = undef;
1120   local $Math::BigFloat::downgrade = undef;
1121   local $Math::BigFloat::precision = undef;
1122   local $Math::BigFloat::accuracy = undef;
1123   local $Math::BigInt::upgrade = undef;
1124   local $Math::BigInt::precision = undef;
1125   local $Math::BigInt::accuracy = undef;
1126
1127   $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
1128   $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();
1129
1130   # XXX TODO: we probably can optimze this:
1131
1132   # if sqrt(D) was not integer
1133   if ($x->{_d}->{_es} ne '+')
1134     {
1135     $x->{_n}->blsft($x->{_d}->exponent()->babs(),10);   # 7.1/4.51 => 7.1/45.1
1136     $x->{_d} = $MBI->_copy( $x->{_d}->{_m} );           # 7.1/45.1 => 71/45.1
1137     }
1138   # if sqrt(N) was not integer
1139   if ($x->{_n}->{_es} ne '+')
1140     {
1141     $x->{_d}->blsft($x->{_n}->exponent()->babs(),10);   # 71/45.1 => 710/45.1
1142     $x->{_n} = $MBI->_copy( $x->{_n}->{_m} );           # 710/45.1 => 710/451
1143     }
1144
1145   # convert parts to $MBI again
1146   $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
1147     if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
1148   $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
1149     if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';
1150
1151   $x->bnorm()->round(@r);
1152   }
1153
1154 sub blsft
1155   {
1156   my ($self,$x,$y,$b,@r) = objectify(3,@_);
1157
1158   $b = 2 unless defined $b;
1159   $b = $self->new($b) unless ref ($b);
1160   $x->bmul( $b->copy()->bpow($y), @r);
1161   $x;
1162   }
1163
1164 sub brsft
1165   {
1166   my ($self,$x,$y,$b,@r) = objectify(3,@_);
1167
1168   $b = 2 unless defined $b;
1169   $b = $self->new($b) unless ref ($b);
1170   $x->bdiv( $b->copy()->bpow($y), @r);
1171   $x;
1172   }
1173
1174 ##############################################################################
1175 # round
1176
1177 sub round
1178   {
1179   $_[0];
1180   }
1181
1182 sub bround
1183   {
1184   $_[0];
1185   }
1186
1187 sub bfround
1188   {
1189   $_[0];
1190   }
1191
1192 ##############################################################################
1193 # comparing
1194
1195 sub bcmp
1196   {
1197   # compare two signed numbers
1198
1199   # set up parameters
1200   my ($self,$x,$y) = (ref($_[0]),@_);
1201   # objectify is costly, so avoid it
1202   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1203     {
1204     ($self,$x,$y) = objectify(2,@_);
1205     }
1206
1207   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1208     {
1209     # handle +-inf and NaN
1210     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1211     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1212     return +1 if $x->{sign} eq '+inf';
1213     return -1 if $x->{sign} eq '-inf';
1214     return -1 if $y->{sign} eq '+inf';
1215     return +1;
1216     }
1217   # check sign for speed first
1218   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
1219   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
1220
1221   # shortcut
1222   my $xz = $MBI->_is_zero($x->{_n});
1223   my $yz = $MBI->_is_zero($y->{_n});
1224   return 0 if $xz && $yz;                               # 0 <=> 0
1225   return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
1226   return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
1227
1228   my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1229   my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1230
1231   my $cmp = $MBI->_acmp($t,$u);                         # signs are equal
1232   $cmp = -$cmp if $x->{sign} eq '-';                    # both are '-' => reverse
1233   $cmp;
1234   }
1235
1236 sub bacmp
1237   {
1238   # compare two numbers (as unsigned)
1239
1240   # set up parameters
1241   my ($self,$x,$y) = (ref($_[0]),@_);
1242   # objectify is costly, so avoid it
1243   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1244     {
1245     ($self,$x,$y) = objectify(2,$class,@_);
1246     }
1247
1248   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1249     {
1250     # handle +-inf and NaN
1251     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1252     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1253     return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1254     return -1;
1255     }
1256
1257   my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1258   my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1259   $MBI->_acmp($t,$u);                                   # ignore signs
1260   }
1261
1262 ##############################################################################
1263 # output conversation
1264
1265 sub numify
1266   {
1267   # convert 17/8 => float (aka 2.125)
1268   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1269
1270   return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, NaN, etc
1271
1272   # N/1 => N
1273   my $neg = ''; $neg = '-' if $x->{sign} eq '-';
1274   return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
1275
1276   $x->_as_float()->numify() + 0.0;
1277   }
1278
1279 sub as_number
1280   {
1281   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1282
1283   return Math::BigInt->new($x) if $x->{sign} !~ /^[+-]$/;       # NaN, inf etc
1284
1285   my $u = Math::BigInt->bzero();
1286   $u->{sign} = $x->{sign};
1287   $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d});   # 22/7 => 3
1288   $u;
1289   }
1290
1291 sub as_bin
1292   {
1293   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1294
1295   return $x unless $x->is_int();
1296
1297   my $s = $x->{sign}; $s = '' if $s eq '+';
1298   $s . $MBI->_as_bin($x->{_n});
1299   }
1300
1301 sub as_hex
1302   {
1303   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1304
1305   return $x unless $x->is_int();
1306
1307   my $s = $x->{sign}; $s = '' if $s eq '+';
1308   $s . $MBI->_as_hex($x->{_n});
1309   }
1310
1311 ##############################################################################
1312 # import
1313
1314 sub import
1315   {
1316   my $self = shift;
1317   my $l = scalar @_;
1318   my $lib = ''; my @a;
1319
1320   for ( my $i = 0; $i < $l ; $i++)
1321     {
1322     if ( $_[$i] eq ':constant' )
1323       {
1324       # this rest causes overlord er load to step in
1325       overload::constant float => sub { $self->new(shift); };
1326       }
1327 #    elsif ($_[$i] eq 'upgrade')
1328 #      {
1329 #     # this causes upgrading
1330 #      $upgrade = $_[$i+1];             # or undef to disable
1331 #      $i++;
1332 #      }
1333     elsif ($_[$i] eq 'downgrade')
1334       {
1335       # this causes downgrading
1336       $downgrade = $_[$i+1];            # or undef to disable
1337       $i++;
1338       }
1339     elsif ($_[$i] eq 'lib')
1340       {
1341       $lib = $_[$i+1] || '';            # default Calc
1342       $i++;
1343       }
1344     elsif ($_[$i] eq 'with')
1345       {
1346       # this argument is no longer used
1347       #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
1348       $i++;
1349       }
1350     else
1351       {
1352       push @a, $_[$i];
1353       }
1354     }
1355   require Math::BigInt;
1356
1357   # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
1358   if ($lib ne '')
1359     {
1360     my @c = split /\s*,\s*/, $lib;
1361     foreach (@c)
1362       {
1363       $_ =~ tr/a-zA-Z0-9://cd;                    # limit to sane characters
1364       }
1365     $lib = join(",", @c);
1366     }
1367   my @import = ('objectify');
1368   push @import, lib => $lib if $lib ne '';
1369
1370   # MBI already loaded, so feed it our lib arguments
1371   Math::BigInt->import( @import );
1372
1373   $MBI = Math::BigFloat->config()->{lib};
1374
1375   # register us with MBI to get notified of future lib changes
1376   Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
1377
1378   # any non :constant stuff is handled by our parent, Exporter (loaded
1379   # by Math::BigFloat, even if @_ is empty, to give it a chance
1380   $self->SUPER::import(@a);             # for subclasses
1381   $self->export_to_level(1,$self,@a);   # need this, too
1382   }
1383
1384 1;
1385
1386 __END__
1387
1388 =head1 NAME
1389
1390 Math::BigRat - Arbitrary big rational numbers
1391
1392 =head1 SYNOPSIS
1393
1394         use Math::BigRat;
1395
1396         my $x = Math::BigRat->new('3/7'); $x += '5/9';
1397
1398         print $x->bstr(),"\n";
1399         print $x ** 2,"\n";
1400
1401         my $y = Math::BigRat->new('inf');
1402         print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
1403
1404         my $z = Math::BigRat->new(144); $z->bsqrt();
1405
1406 =head1 DESCRIPTION
1407
1408 Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1409 for arbitrary big rational numbers.
1410
1411 =head2 MATH LIBRARY
1412
1413 Math with the numbers is done (by default) by a module called
1414 Math::BigInt::Calc. This is equivalent to saying:
1415
1416         use Math::BigRat lib => 'Calc';
1417
1418 You can change this by using:
1419
1420         use Math::BigRat lib => 'BitVect';
1421
1422 The following would first try to find Math::BigInt::Foo, then
1423 Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1424
1425         use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1426
1427 Calc.pm uses as internal format an array of elements of some decimal base
1428 (usually 1e7, but this might be different for some systems) with the least
1429 significant digit first, while BitVect.pm uses a bit vector of base 2, most
1430 significant bit first. Other modules might use even different means of
1431 representing the numbers. See the respective module documentation for further
1432 details.
1433
1434 Currently the following replacement libraries exist, search for them at CPAN:
1435
1436         Math::BigInt::BitVect
1437         Math::BigInt::GMP
1438         Math::BigInt::Pari
1439         Math::BigInt::FastCalc
1440
1441 =head1 METHODS
1442
1443 Any methods not listed here are derived from Math::BigFloat (or
1444 Math::BigInt), so make sure you check these two modules for further
1445 information.
1446
1447 =head2 new()
1448
1449         $x = Math::BigRat->new('1/3');
1450
1451 Create a new Math::BigRat object. Input can come in various forms:
1452
1453         $x = Math::BigRat->new(123);                            # scalars
1454         $x = Math::BigRat->new('inf');                          # infinity
1455         $x = Math::BigRat->new('123.3');                        # float
1456         $x = Math::BigRat->new('1/3');                          # simple string
1457         $x = Math::BigRat->new('1 / 3');                        # spaced
1458         $x = Math::BigRat->new('1 / 0.1');                      # w/ floats
1459         $x = Math::BigRat->new(Math::BigInt->new(3));           # BigInt
1460         $x = Math::BigRat->new(Math::BigFloat->new('3.1'));     # BigFloat
1461         $x = Math::BigRat->new(Math::BigInt::Lite->new('2'));   # BigLite
1462
1463         # You can also give D and N as different objects:
1464         $x = Math::BigRat->new(
1465                 Math::BigInt->new(-123),
1466                 Math::BigInt->new(7),
1467                 );                      # => -123/7
1468
1469 =head2 numerator()
1470
1471         $n = $x->numerator();
1472
1473 Returns a copy of the numerator (the part above the line) as signed BigInt.
1474
1475 =head2 denominator()
1476
1477         $d = $x->denominator();
1478
1479 Returns a copy of the denominator (the part under the line) as positive BigInt.
1480
1481 =head2 parts()
1482
1483         ($n,$d) = $x->parts();
1484
1485 Return a list consisting of (signed) numerator and (unsigned) denominator as
1486 BigInts.
1487
1488 =head2 as_int()
1489
1490         $x = Math::BigRat->new('13/7');
1491         print $x->as_int(),"\n";                # '1'
1492
1493 Returns a copy of the object as BigInt, truncated to an integer.
1494
1495 C<as_number()> is an alias for C<as_int()>.
1496
1497 =head2 as_hex()
1498
1499         $x = Math::BigRat->new('13');
1500         print $x->as_hex(),"\n";                # '0xd'
1501
1502 Returns the BigRat as hexadecimal string. Works only for integers.
1503
1504 =head2 as_bin()
1505
1506         $x = Math::BigRat->new('13');
1507         print $x->as_bin(),"\n";                # '0x1101'
1508
1509 Returns the BigRat as binary string. Works only for integers.
1510
1511 =head2 bfac()
1512
1513         $x->bfac();
1514
1515 Calculates the factorial of $x. For instance:
1516
1517         print Math::BigRat->new('3/1')->bfac(),"\n";    # 1*2*3
1518         print Math::BigRat->new('5/1')->bfac(),"\n";    # 1*2*3*4*5
1519
1520 Works currently only for integers.
1521
1522 =head2 blog()
1523
1524 Is not yet implemented.
1525
1526 =head2 bround()/round()/bfround()
1527
1528 Are not yet implemented.
1529
1530 =head2 bmod()
1531
1532         use Math::BigRat;
1533         my $x = Math::BigRat->new('7/4');
1534         my $y = Math::BigRat->new('4/3');
1535         print $x->bmod($y);
1536
1537 Set $x to the remainder of the division of $x by $y.
1538
1539 =head2 is_one()
1540
1541         print "$x is 1\n" if $x->is_one();
1542
1543 Return true if $x is exactly one, otherwise false.
1544
1545 =head2 is_zero()
1546
1547         print "$x is 0\n" if $x->is_zero();
1548
1549 Return true if $x is exactly zero, otherwise false.
1550
1551 =head2 is_pos()
1552
1553         print "$x is >= 0\n" if $x->is_positive();
1554
1555 Return true if $x is positive (greater than or equal to zero), otherwise
1556 false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1557
1558 C<is_positive()> is an alias for C<is_pos()>.
1559
1560 =head2 is_neg()
1561
1562         print "$x is < 0\n" if $x->is_negative();
1563
1564 Return true if $x is negative (smaller than zero), otherwise false. Please
1565 note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1566
1567 C<is_negative()> is an alias for C<is_neg()>.
1568
1569 =head2 is_int()
1570
1571         print "$x is an integer\n" if $x->is_int();
1572
1573 Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1574 false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1575
1576 =head2 is_odd()
1577
1578         print "$x is odd\n" if $x->is_odd();
1579
1580 Return true if $x is odd, otherwise false.
1581
1582 =head2 is_even()
1583
1584         print "$x is even\n" if $x->is_even();
1585
1586 Return true if $x is even, otherwise false.
1587
1588 =head2 bceil()
1589
1590         $x->bceil();
1591
1592 Set $x to the next bigger integer value (e.g. truncate the number to integer
1593 and then increment it by one).
1594
1595 =head2 bfloor()
1596
1597         $x->bfloor();
1598
1599 Truncate $x to an integer value.
1600
1601 =head2 bsqrt()
1602
1603         $x->bsqrt();
1604
1605 Calculate the square root of $x.
1606
1607 =head2 config
1608
1609         use Data::Dumper;
1610
1611         print Dumper ( Math::BigRat->config() );
1612         print Math::BigRat->config()->{lib},"\n";
1613
1614 Returns a hash containing the configuration, e.g. the version number, lib
1615 loaded etc. The following hash keys are currently filled in with the
1616 appropriate information.
1617
1618         key             RO/RW   Description
1619                                 Example
1620         ============================================================
1621         lib             RO      Name of the Math library
1622                                 Math::BigInt::Calc
1623         lib_version     RO      Version of 'lib'
1624                                 0.30
1625         class           RO      The class of config you just called
1626                                 Math::BigRat
1627         version         RO      version number of the class you used
1628                                 0.10
1629         upgrade         RW      To which class numbers are upgraded
1630                                 undef
1631         downgrade       RW      To which class numbers are downgraded
1632                                 undef
1633         precision       RW      Global precision
1634                                 undef
1635         accuracy        RW      Global accuracy
1636                                 undef
1637         round_mode      RW      Global round mode
1638                                 even
1639         div_scale       RW      Fallback accuracy for div
1640                                 40
1641         trap_nan        RW      Trap creation of NaN (undef = no)
1642                                 undef
1643         trap_inf        RW      Trap creation of +inf/-inf (undef = no)
1644                                 undef
1645
1646 By passing a reference to a hash you may set the configuration values. This
1647 works only for values that a marked with a C<RW> above, anything else is
1648 read-only.
1649
1650 =head1 BUGS
1651
1652 Some things are not yet implemented, or only implemented half-way:
1653
1654 =over 2
1655
1656 =item inf handling (partial)
1657
1658 =item NaN handling (partial)
1659
1660 =item rounding (not implemented except for bceil/bfloor)
1661
1662 =item $x ** $y where $y is not an integer
1663
1664 =item bmod(), blog(), bmodinv() and bmodpow() (partial)
1665
1666 =back
1667
1668 =head1 LICENSE
1669
1670 This program is free software; you may redistribute it and/or modify it under
1671 the same terms as Perl itself.
1672
1673 =head1 SEE ALSO
1674
1675 L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1676 L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
1677
1678 See L<http://search.cpan.org/search?dist=bignum> for a way to use
1679 Math::BigRat.
1680
1681 The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1682 may contain more documentation and examples as well as testcases.
1683
1684 =head1 AUTHORS
1685
1686 (C) by Tels L<http://bloodgate.com/> 2001 - 2005.
1687
1688 =cut