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