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