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