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