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