home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Topware / activeperl / ActivePerl / Perl / lib / Math / BigRat.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-19  |  26.2 KB  |  1,030 lines
  1.  
  2. #
  3. # "Tax the rat farms."
  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.  
  14. package Math::BigRat;
  15.  
  16. require 5.005_03;
  17. use strict;
  18.  
  19. use Exporter;
  20. use Math::BigFloat;
  21. use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
  22.             $accuracy $precision $round_mode $div_scale);
  23.  
  24. @ISA = qw(Exporter Math::BigFloat);
  25. @EXPORT_OK = qw();
  26.  
  27. $VERSION = '0.07';
  28.  
  29. use overload;                # inherit from Math::BigFloat
  30.  
  31. ##############################################################################
  32. # global constants, flags and accessory
  33.  
  34. use constant MB_NEVER_ROUND => 0x0001;
  35.  
  36. $accuracy = $precision = undef;
  37. $round_mode = 'even';
  38. $div_scale = 40;
  39. $upgrade = undef;
  40. $downgrade = undef;
  41.  
  42. my $nan = 'NaN';
  43. my $class = 'Math::BigRat';
  44. my $MBI = 'Math::BigInt';
  45.  
  46. sub isa
  47.   {
  48.   return 0 if $_[1] =~ /^Math::Big(Int|Float)/;        # we aren't
  49.   UNIVERSAL::isa(@_);
  50.   }
  51.  
  52. sub _new_from_float
  53.   {
  54.   # turn a single float input into a rational (like '0.1')
  55.   my ($self,$f) = @_;
  56.  
  57.   return $self->bnan() if $f->is_nan();
  58.   return $self->binf('-inf') if $f->{sign} eq '-inf';
  59.   return $self->binf('+inf') if $f->{sign} eq '+inf';
  60.  
  61.   #print "f $f caller", join(' ',caller()),"\n";
  62.   $self->{_n} = $f->{_m}->copy();            # mantissa
  63.   $self->{_d} = $MBI->bone();
  64.   $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
  65.   if ($f->{_e}->{sign} eq '-')
  66.     {
  67.     # something like Math::BigRat->new('0.1');
  68.     $self->{_d}->blsft($f->{_e}->copy()->babs(),10);    # 1 / 1 => 1/10
  69.     }
  70.   else
  71.     {
  72.     # something like Math::BigRat->new('10');
  73.     # 1 / 1 => 10/1
  74.     $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();    
  75.     }
  76.   $self;
  77.   }
  78.  
  79. sub new
  80.   {
  81.   # create a Math::BigRat
  82.   my $class = shift;
  83.  
  84.   my ($n,$d) = shift;
  85.  
  86.   my $self = { }; bless $self,$class;
  87.  
  88.   # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
  89.  
  90.   if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
  91.     {
  92.     if ($n->isa('Math::BigFloat'))
  93.       {
  94.       return $self->_new_from_float($n)->bnorm();
  95.       }
  96.     if ($n->isa('Math::BigInt'))
  97.       {
  98.       $self->{_n} = $n->copy();                # "mantissa" = $n
  99.       $self->{_d} = $MBI->bone();
  100.       $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
  101.       return $self->bnorm();
  102.       }
  103.     if ($n->isa('Math::BigInt::Lite'))
  104.       {
  105.       $self->{_n} = $MBI->new($$n);        # "mantissa" = $n
  106.       $self->{_d} = $MBI->bone();
  107.       $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
  108.       return $self->bnorm();
  109.       }
  110.     }
  111.   return $n->copy() if ref $n;
  112.  
  113.   if (!defined $n)
  114.     {
  115.     $self->{_n} = $MBI->bzero();    # undef => 0
  116.     $self->{_d} = $MBI->bone();
  117.     $self->{sign} = '+';
  118.     return $self->bnorm();
  119.     }
  120.   # string input with / delimiter
  121.   if ($n =~ /\s*\/\s*/)
  122.     {
  123.     return Math::BigRat->bnan() if $n =~ /\/.*\//;    # 1/2/3 isn't valid
  124.     return Math::BigRat->bnan() if $n =~ /\/\s*$/;    # 1/ isn't valid
  125.     ($n,$d) = split (/\//,$n);
  126.     # try as BigFloats first
  127.     if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
  128.       {
  129.       # one of them looks like a float 
  130.       $self->_new_from_float(Math::BigFloat->new($n));
  131.       # now correct $self->{_n} due to $n
  132.       my $f = Math::BigFloat->new($d);
  133.       if ($f->{_e}->{sign} eq '-')
  134.         {
  135.     # 10 / 0.1 => 100/1
  136.         $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
  137.         }
  138.       else
  139.         {
  140.         $self->{_d}->blsft($f->{_e},10);         # 1 / 1 => 10/1
  141.          }
  142.       }
  143.     else
  144.       {
  145.       $self->{_n} = $MBI->new($n);
  146.       $self->{_d} = $MBI->new($d);
  147.       return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
  148.       # inf handling is missing here
  149.  
  150.       $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
  151.       # if $d is negative, flip sign
  152.       $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
  153.       $self->{_d}->{sign} = '+';    # normalize
  154.       }
  155.     return $self->bnorm();
  156.     }
  157.  
  158.   # simple string input
  159.   if (($n =~ /[\.eE]/))
  160.     {
  161.     # work around bug in BigFloat that makes 1.1.2 valid
  162.     return $self->bnan() if $n =~ /\..*\./;
  163.     # looks like a float
  164.     $self->_new_from_float(Math::BigFloat->new($n));
  165.     }
  166.   else
  167.     {
  168.     $self->{_n} = $MBI->new($n);
  169.     $self->{_d} = $MBI->bone();
  170.     $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
  171.     return $self->bnan() if $self->{sign} eq 'NaN';
  172.     return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
  173.     }
  174.   $self->bnorm();
  175.   }
  176.  
  177. ###############################################################################
  178.  
  179. sub bstr
  180.   {
  181.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  182.  
  183.   if ($x->{sign} !~ /^[+-]$/)        # inf, NaN etc
  184.     {
  185.     my $s = $x->{sign}; $s =~ s/^\+//;     # +inf => inf
  186.     return $s;
  187.     }
  188.  
  189.   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';    # +3 vs 3
  190.  
  191.   return $s.$x->{_n}->bstr() if $x->{_d}->is_one(); 
  192.   return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr(); 
  193.   }
  194.  
  195. sub bsstr
  196.   {
  197.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  198.  
  199.   if ($x->{sign} !~ /^[+-]$/)        # inf, NaN etc
  200.     {
  201.     my $s = $x->{sign}; $s =~ s/^\+//;     # +inf => inf
  202.     return $s;
  203.     }
  204.   
  205.   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';    # +3 vs 3
  206.   return $x->{_n}->bstr() . '/' . $x->{_d}->bstr(); 
  207.   }
  208.  
  209. sub bnorm
  210.   {
  211.   # reduce the number to the shortest form and remember this (so that we
  212.   # don't reduce again)
  213.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  214.  
  215.   # both parts must be BigInt's
  216.   die ("n is not $MBI but (".ref($x->{_n}).')')
  217.     if ref($x->{_n}) ne $MBI;
  218.   die ("d is not $MBI but (".ref($x->{_d}).')')
  219.     if ref($x->{_d}) ne $MBI;
  220.  
  221.   # this is to prevent automatically rounding when MBI's globals are set
  222.   $x->{_d}->{_f} = MB_NEVER_ROUND;
  223.   $x->{_n}->{_f} = MB_NEVER_ROUND;
  224.   # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
  225.   $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
  226.   $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef; 
  227.  
  228.   # no normalize for NaN, inf etc.
  229.   return $x if $x->{sign} !~ /^[+-]$/;
  230.  
  231.   # normalize zeros to 0/1
  232.   if (($x->{sign} =~ /^[+-]$/) &&
  233.       ($x->{_n}->is_zero()))
  234.     {
  235.     $x->{sign} = '+';                    # never -0
  236.     $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
  237.     return $x;
  238.     }
  239.  
  240.   return $x if $x->{_d}->is_one();            # no need to reduce
  241.  
  242.   # reduce other numbers
  243.   # disable upgrade in BigInt, otherwise deep recursion
  244.   local $Math::BigInt::upgrade = undef;
  245.   my $gcd = $x->{_n}->bgcd($x->{_d});
  246.  
  247.   if (!$gcd->is_one())
  248.     {
  249.     $x->{_n}->bdiv($gcd);
  250.     $x->{_d}->bdiv($gcd);
  251.     }
  252.   $x;
  253.   }
  254.  
  255. ##############################################################################
  256. # special values
  257.  
  258. sub _bnan
  259.   {
  260.   # used by parent class bone() to initialize number to 1
  261.   my $self = shift;
  262.   $self->{_n} = $MBI->bzero();
  263.   $self->{_d} = $MBI->bzero();
  264.   }
  265.  
  266. sub _binf
  267.   {
  268.   # used by parent class bone() to initialize number to 1
  269.   my $self = shift;
  270.   $self->{_n} = $MBI->bzero();
  271.   $self->{_d} = $MBI->bzero();
  272.   }
  273.  
  274. sub _bone
  275.   {
  276.   # used by parent class bone() to initialize number to 1
  277.   my $self = shift;
  278.   $self->{_n} = $MBI->bone();
  279.   $self->{_d} = $MBI->bone();
  280.   }
  281.  
  282. sub _bzero
  283.   {
  284.   # used by parent class bone() to initialize number to 1
  285.   my $self = shift;
  286.   $self->{_n} = $MBI->bzero();
  287.   $self->{_d} = $MBI->bone();
  288.   }
  289.  
  290. ##############################################################################
  291. # mul/add/div etc
  292.  
  293. sub badd
  294.   {
  295.   # add two rationals
  296.   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  297.  
  298.   $x = $self->new($x) unless $x->isa($self);
  299.   $y = $self->new($y) unless $y->isa($self);
  300.  
  301.   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
  302.  
  303.   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
  304.   #  - + -                  = --------- = --                 
  305.   #  4   3                      4*3       12
  306.  
  307.   my $gcd = $x->{_d}->bgcd($y->{_d});
  308.  
  309.   my $aa = $x->{_d}->copy();
  310.   my $bb = $y->{_d}->copy(); 
  311.   if ($gcd->is_one())
  312.     {
  313.     $bb->bdiv($gcd); $aa->bdiv($gcd);
  314.     }
  315.   $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
  316.   my $m = $y->{_n}->copy()->bmul($aa);
  317.   $m->{sign} = $y->{sign};            # 2/1 - 2/1
  318.   $x->{_n}->badd($m);
  319.  
  320.   $x->{_d}->bmul($y->{_d});
  321.  
  322.   # calculate new sign
  323.   $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
  324.  
  325.   $x->bnorm()->round($a,$p,$r);
  326.   }
  327.  
  328. sub bsub
  329.   {
  330.   # subtract two rationals
  331.   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  332.  
  333.   $x = $class->new($x) unless $x->isa($class);
  334.   $y = $class->new($y) unless $y->isa($class);
  335.  
  336.   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
  337.   # TODO: inf handling
  338.  
  339.   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
  340.   #  - + -                  = --------- = --                 
  341.   #  4   3                      4*3       12
  342.  
  343.   my $gcd = $x->{_d}->bgcd($y->{_d});
  344.  
  345.   my $aa = $x->{_d}->copy();
  346.   my $bb = $y->{_d}->copy(); 
  347.   if ($gcd->is_one())
  348.     {
  349.     $bb->bdiv($gcd); $aa->bdiv($gcd);
  350.     }
  351.   $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign};
  352.   my $m = $y->{_n}->copy()->bmul($aa);
  353.   $m->{sign} = $y->{sign};            # 2/1 - 2/1
  354.   $x->{_n}->bsub($m);
  355.  
  356.   $x->{_d}->bmul($y->{_d});
  357.   
  358.   # calculate new sign
  359.   $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
  360.  
  361.   $x->bnorm()->round($a,$p,$r);
  362.   }
  363.  
  364. sub bmul
  365.   {
  366.   # multiply two rationals
  367.   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  368.  
  369.   $x = $class->new($x) unless $x->isa($class);
  370.   $y = $class->new($y) unless $y->isa($class);
  371.  
  372.   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
  373.  
  374.   # inf handling
  375.   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
  376.     {
  377.     return $x->bnan() if $x->is_zero() || $y->is_zero();
  378.     # result will always be +-inf:
  379.     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
  380.     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
  381.     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
  382.     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
  383.     return $x->binf('-');
  384.     }
  385.  
  386.   # x== 0 # also: or y == 1 or y == -1
  387.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  388.  
  389.   # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
  390.   # and reducing in one step)
  391.  
  392.   #  1   1    2    1
  393.   #  - * - =  -  = -
  394.   #  4   3    12   6
  395.   $x->{_n}->bmul($y->{_n});
  396.   $x->{_d}->bmul($y->{_d});
  397.  
  398.   # compute new sign
  399.   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
  400.  
  401.   $x->bnorm()->round($a,$p,$r);
  402.   }
  403.  
  404. sub bdiv
  405.   {
  406.   # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
  407.   # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
  408.   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
  409.  
  410.   $x = $class->new($x) unless $x->isa($class);
  411.   $y = $class->new($y) unless $y->isa($class);
  412.  
  413.   return $self->_div_inf($x,$y)
  414.    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
  415.  
  416.   # x== 0 # also: or y == 1 or y == -1
  417.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  418.  
  419.   # TODO: list context, upgrade
  420.  
  421.   # 1     1    1   3
  422.   # -  /  - == - * -
  423.   # 4     3    4   1
  424.   $x->{_n}->bmul($y->{_d});
  425.   $x->{_d}->bmul($y->{_n});
  426.  
  427.   # compute new sign 
  428.   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
  429.  
  430.   $x->bnorm()->round($a,$p,$r);
  431.   $x;
  432.   }
  433.  
  434. ##############################################################################
  435. # bdec/binc
  436.  
  437. sub bdec
  438.   {
  439.   # decrement value (subtract 1)
  440.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  441.  
  442.   return $x if $x->{sign} !~ /^[+-]$/;    # NaN, inf, -inf
  443.  
  444.   if ($x->{sign} eq '-')
  445.     {
  446.     $x->{_n}->badd($x->{_d});    # -5/2 => -7/2
  447.     }
  448.   else
  449.     {
  450.     if ($x->{_n}->bacmp($x->{_d}) < 0)
  451.       {
  452.       # 1/3 -- => -2/3
  453.       $x->{_n} = $x->{_d} - $x->{_n};
  454.       $x->{sign} = '-';
  455.       }
  456.     else
  457.       {
  458.       $x->{_n}->bsub($x->{_d});        # 5/2 => 3/2
  459.       }
  460.     }
  461.   $x->bnorm()->round(@r);
  462.  
  463.   #$x->bsub($self->bone())->round(@r);
  464.   }
  465.  
  466. sub binc
  467.   {
  468.   # increment value (add 1)
  469.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  470.   
  471.   return $x if $x->{sign} !~ /^[+-]$/;    # NaN, inf, -inf
  472.  
  473.   if ($x->{sign} eq '-')
  474.     {
  475.     if ($x->{_n}->bacmp($x->{_d}) < 0)
  476.       {
  477.       # -1/3 ++ => 2/3 (overflow at 0)
  478.       $x->{_n} = $x->{_d} - $x->{_n};
  479.       $x->{sign} = '+';
  480.       }
  481.     else
  482.       {
  483.       $x->{_n}->bsub($x->{_d});        # -5/2 => -3/2
  484.       }
  485.     }
  486.   else
  487.     {
  488.     $x->{_n}->badd($x->{_d});    # 5/2 => 7/2
  489.     }
  490.   $x->bnorm()->round(@r);
  491.  
  492.   #$x->badd($self->bone())->round(@r);
  493.   }
  494.  
  495. ##############################################################################
  496. # is_foo methods (the rest is inherited)
  497.  
  498. sub is_int
  499.   {
  500.   # return true if arg (BRAT or num_str) is an integer
  501.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  502.  
  503.   return 1 if ($x->{sign} =~ /^[+-]$/) &&    # NaN and +-inf aren't
  504.     $x->{_d}->is_one();                # 1e-1 => no integer
  505.   0;
  506.   }
  507.  
  508. sub is_zero
  509.   {
  510.   # return true if arg (BRAT or num_str) is zero
  511.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  512.  
  513.   return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
  514.   0;
  515.   }
  516.  
  517. sub is_one
  518.   {
  519.   # return true if arg (BRAT or num_str) is +1 or -1 if signis given
  520.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  521.  
  522.   my $sign = shift || ''; $sign = '+' if $sign ne '-';
  523.   return 1
  524.    if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
  525.   0;
  526.   }
  527.  
  528. sub is_odd
  529.   {
  530.   # return true if arg (BFLOAT or num_str) is odd or false if even
  531.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  532.  
  533.   return 1 if ($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
  534.     ($x->{_d}->is_one() && $x->{_n}->is_odd());        # x/2 is not, but 3/1
  535.   0;
  536.   }
  537.  
  538. sub is_even
  539.   {
  540.   # return true if arg (BINT or num_str) is even or false if odd
  541.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  542.  
  543.   return 0 if $x->{sign} !~ /^[+-]$/;            # NaN & +-inf aren't
  544.   return 1 if ($x->{_d}->is_one()            # x/3 is never
  545.      && $x->{_n}->is_even());                # but 4/1 is
  546.   0;
  547.   }
  548.  
  549. BEGIN
  550.   {
  551.   *objectify = \&Math::BigInt::objectify;
  552.   }
  553.  
  554. ##############################################################################
  555. # parts() and friends
  556.  
  557. sub numerator
  558.   {
  559.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  560.  
  561.   return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
  562.  
  563.   my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
  564.   $n;
  565.   }
  566.  
  567. sub denominator
  568.   {
  569.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  570.  
  571.   return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
  572.   $x->{_d}->copy(); 
  573.   }
  574.  
  575. sub parts
  576.   {
  577.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  578.  
  579.   return ($self->bnan(),$self->bnan()) if $x->{sign} eq 'NaN';
  580.   return ($self->binf(),$self->binf()) if $x->{sign} eq '+inf';
  581.   return ($self->binf('-'),$self->binf()) if $x->{sign} eq '-inf';
  582.  
  583.   my $n = $x->{_n}->copy();
  584.   $n->{sign} = $x->{sign};
  585.   return ($n,$x->{_d}->copy());
  586.   }
  587.  
  588. sub length
  589.   {
  590.   return 0;
  591.   }
  592.  
  593. sub digit
  594.   {
  595.   return 0;
  596.   }
  597.  
  598. ##############################################################################
  599. # special calc routines
  600.  
  601. sub bceil
  602.   {
  603.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  604.  
  605.   return $x unless $x->{sign} =~ /^[+-]$/;
  606.   return $x if $x->{_d}->is_one();        # 22/1 => 22, 0/1 => 0
  607.  
  608.   $x->{_n}->bdiv($x->{_d});            # 22/7 => 3/1 w/ truncate
  609.   $x->{_d}->bone();
  610.   $x->{_n}->binc() if $x->{sign} eq '+';    # +22/7 => 4/1
  611.   $x->{sign} = '+' if $x->{_n}->is_zero();    # -0 => 0
  612.   $x;
  613.   }
  614.  
  615. sub bfloor
  616.   {
  617.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  618.  
  619.   return $x unless $x->{sign} =~ /^[+-]$/;
  620.   return $x if $x->{_d}->is_one();        # 22/1 => 22, 0/1 => 0
  621.  
  622.   $x->{_n}->bdiv($x->{_d});            # 22/7 => 3/1 w/ truncate
  623.   $x->{_d}->bone();
  624.   $x->{_n}->binc() if $x->{sign} eq '-';    # -22/7 => -4/1
  625.   $x;
  626.   }
  627.  
  628. sub bfac
  629.   {
  630.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  631.  
  632.   if (($x->{sign} eq '+') && ($x->{_d}->is_one()))
  633.     {
  634.     $x->{_n}->bfac();
  635.     return $x->round(@r);
  636.     }
  637.   $x->bnan();
  638.   }
  639.  
  640. sub bpow
  641.   {
  642.   my ($self,$x,$y,@r) = objectify(2,@_);
  643.  
  644.   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
  645.   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
  646.   return $x->bone(@r) if $y->is_zero();
  647.   return $x->round(@r) if $x->is_one() || $y->is_one();
  648.   if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
  649.     {
  650.     # if $x == -1 and odd/even y => +1/-1
  651.     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
  652.     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
  653.     }
  654.   # 1 ** -y => 1 / (1 ** |y|)
  655.   # so do test for negative $y after above's clause
  656.  #  return $x->bnan() if $y->{sign} eq '-';
  657.   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
  658.  
  659.   # shortcut y/1 (and/or x/1)
  660.   if ($y->{_d}->is_one())
  661.     {
  662.     # shortcut for x/1 and y/1
  663.     if ($x->{_d}->is_one())
  664.       {
  665.       $x->{_n}->bpow($y->{_n});        # x/1 ** y/1 => (x ** y)/1
  666.       if ($y->{sign} eq '-')
  667.         {
  668.         # 0.2 ** -3 => 1/(0.2 ** 3)
  669.         ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});    # swap
  670.         }
  671.       # correct sign; + ** + => +
  672.       if ($x->{sign} eq '-')
  673.         {
  674.         # - * - => +, - * - * - => -
  675.         $x->{sign} = '+' if $y->{_n}->is_even();    
  676.         }
  677.       return $x->round(@r);
  678.       }
  679.     # x/z ** y/1
  680.     $x->{_n}->bpow($y->{_n});        # 5/2 ** y/1 => 5 ** y / 2 ** y
  681.     $x->{_d}->bpow($y->{_n});
  682.     if ($y->{sign} eq '-')
  683.       {
  684.       # 0.2 ** -3 => 1/(0.2 ** 3)
  685.       ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});    # swap
  686.       }
  687.     # correct sign; + ** + => +
  688.     if ($x->{sign} eq '-')
  689.       {
  690.       # - * - => +, - * - * - => -
  691.       $x->{sign} = '+' if $y->{_n}->is_even();    
  692.       }
  693.     return $x->round(@r);
  694.     }
  695.  
  696.   # regular calculation (this is wrong for d/e ** f/g)
  697.   my $pow2 = $self->__one();
  698.   my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
  699.   my $two = $MBI->new(2);
  700.   while (!$y1->is_one())
  701.     {
  702.     $pow2->bmul($x) if $y1->is_odd();
  703.     $y1->bdiv($two);
  704.     $x->bmul($x);
  705.     }
  706.   $x->bmul($pow2) unless $pow2->is_one();
  707.   # n ** -x => 1/n ** x
  708.   ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-'; 
  709.   $x;
  710.   #$x->round(@r);
  711.   }
  712.  
  713. sub blog
  714.   {
  715.   return Math::BigRat->bnan();
  716.   }
  717.  
  718. sub bsqrt
  719.   {
  720.   my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  721.  
  722.   return $x->bnan() if $x->{sign} ne '+';    # inf, NaN, -1 etc
  723.   $x->{_d}->bsqrt($a,$p,$r);
  724.   $x->{_n}->bsqrt($a,$p,$r);
  725.   $x->bnorm();
  726.   }
  727.  
  728. sub blsft
  729.   {
  730.   my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
  731.  
  732.   $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
  733.   $x;
  734.   }
  735.  
  736. sub brsft
  737.   {
  738.   my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
  739.  
  740.   $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
  741.   $x;
  742.   }
  743.  
  744. ##############################################################################
  745. # round
  746.  
  747. sub round
  748.   {
  749.   $_[0];
  750.   }
  751.  
  752. sub bround
  753.   {
  754.   $_[0];
  755.   }
  756.  
  757. sub bfround
  758.   {
  759.   $_[0];
  760.   }
  761.  
  762. ##############################################################################
  763. # comparing
  764.  
  765. sub bcmp
  766.   {
  767.   my ($self,$x,$y) = objectify(2,@_);
  768.  
  769.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  770.     {
  771.     # handle +-inf and NaN
  772.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  773.     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
  774.     return +1 if $x->{sign} eq '+inf';
  775.     return -1 if $x->{sign} eq '-inf';
  776.     return -1 if $y->{sign} eq '+inf';
  777.     return +1;
  778.     }
  779.   # check sign for speed first
  780.   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
  781.   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
  782.  
  783.   # shortcut
  784.   my $xz = $x->{_n}->is_zero();
  785.   my $yz = $y->{_n}->is_zero();
  786.   return 0 if $xz && $yz;                               # 0 <=> 0
  787.   return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
  788.   return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
  789.  
  790.   my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
  791.   my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
  792.   $t->bcmp($u);
  793.   }
  794.  
  795. sub bacmp
  796.   {
  797.   my ($self,$x,$y) = objectify(2,@_);
  798.  
  799.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  800.     {
  801.     # handle +-inf and NaN
  802.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  803.     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
  804.     return +1;  # inf is always bigger
  805.     }
  806.  
  807.   my $t = $x->{_n} * $y->{_d};
  808.   my $u = $y->{_n} * $x->{_d};
  809.   $t->bacmp($u);
  810.   }
  811.  
  812. ##############################################################################
  813. # output conversation
  814.  
  815. sub as_number
  816.   {
  817.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  818.  
  819.   return $x if $x->{sign} !~ /^[+-]$/;            # NaN, inf etc 
  820.   my $t = $x->{_n}->copy()->bdiv($x->{_d});        # 22/7 => 3
  821.   $t->{sign} = $x->{sign};
  822.   $t;
  823.   }
  824.  
  825. sub import
  826.   {
  827.   my $self = shift;
  828.   my $l = scalar @_;
  829.   my $lib = ''; my @a;
  830.   for ( my $i = 0; $i < $l ; $i++)
  831.     {
  832. #    print "at $_[$i] (",$_[$i+1]||'undef',")\n";
  833.     if ( $_[$i] eq ':constant' )
  834.       {
  835.       # this rest causes overlord er load to step in
  836.       # print "overload @_\n";
  837.       overload::constant float => sub { $self->new(shift); };
  838.       }
  839. #    elsif ($_[$i] eq 'upgrade')
  840. #      {
  841. #     # this causes upgrading
  842. #      $upgrade = $_[$i+1];              # or undef to disable
  843. #      $i++;
  844. #      }
  845.     elsif ($_[$i] eq 'downgrade')
  846.       {
  847.       # this causes downgrading
  848.       $downgrade = $_[$i+1];            # or undef to disable
  849.       $i++;
  850.       }
  851.     elsif ($_[$i] eq 'lib')
  852.       {
  853.       $lib = $_[$i+1] || '';            # default Calc
  854.       $i++;
  855.       }
  856.     elsif ($_[$i] eq 'with')
  857.       {
  858.       $MBI = $_[$i+1] || 'Math::BigInt';        # default Math::BigInt
  859.       $i++;
  860.       }
  861.     else
  862.       {
  863.       push @a, $_[$i];
  864.       }
  865.     }
  866.   # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
  867.   my $mbilib = eval { Math::BigInt->config()->{lib} };
  868.   if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
  869.     {
  870.     # MBI already loaded
  871.     $MBI->import('lib',"$lib,$mbilib", 'objectify');
  872.     }
  873.   else
  874.     {
  875.     # MBI not loaded, or not with "Math::BigInt"
  876.     $lib .= ",$mbilib" if defined $mbilib;
  877.  
  878.     if ($] < 5.006)
  879.       {
  880.       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
  881.       # used in the same script, or eval inside import().
  882.       my @parts = split /::/, $MBI;             # Math::BigInt => Math BigInt
  883.       my $file = pop @parts; $file .= '.pm';    # BigInt => BigInt.pm
  884.       $file = File::Spec->catfile (@parts, $file);
  885.       eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
  886.       }
  887.     else
  888.       {
  889.       my $rc = "use $MBI lib => '$lib', 'objectify';";
  890.       eval $rc;
  891.       }
  892.     }
  893.   die ("Couldn't load $MBI: $! $@") if $@;
  894.  
  895.   # any non :constant stuff is handled by our parent, Exporter
  896.   # even if @_ is empty, to give it a chance
  897.   $self->SUPER::import(@a);             # for subclasses
  898.   $self->export_to_level(1,$self,@a);   # need this, too
  899.   }
  900.  
  901. 1;
  902.  
  903. __END__
  904.  
  905. =head1 NAME
  906.  
  907. Math::BigRat - arbitrarily big rationals
  908.  
  909. =head1 SYNOPSIS
  910.  
  911.   use Math::BigRat;
  912.  
  913.   $x = Math::BigRat->new('3/7');
  914.  
  915.   print $x->bstr(),"\n";
  916.  
  917. =head1 DESCRIPTION
  918.  
  919. This is just a placeholder until the real thing is up and running. Watch this
  920. space...
  921.  
  922. =head2 MATH LIBRARY
  923.  
  924. Math with the numbers is done (by default) by a module called
  925. Math::BigInt::Calc. This is equivalent to saying:
  926.  
  927.     use Math::BigRat lib => 'Calc';
  928.  
  929. You can change this by using:
  930.  
  931.     use Math::BigRat lib => 'BitVect';
  932.  
  933. The following would first try to find Math::BigInt::Foo, then
  934. Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
  935.  
  936.     use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
  937.  
  938. Calc.pm uses as internal format an array of elements of some decimal base
  939. (usually 1e7, but this might be differen for some systems) with the least
  940. significant digit first, while BitVect.pm uses a bit vector of base 2, most
  941. significant bit first. Other modules might use even different means of
  942. representing the numbers. See the respective module documentation for further
  943. details.
  944.  
  945. =head1 METHODS
  946.  
  947. Any method not listed here is dervied from Math::BigFloat (or
  948. Math::BigInt), so make sure you check these two modules for further
  949. information.
  950.  
  951. =head2 new()
  952.  
  953.     $x = Math::BigRat->new('1/3');
  954.  
  955. Create a new Math::BigRat object. Input can come in various forms:
  956.  
  957.     $x = Math::BigRat->new('1/3');                # simple string
  958.     $x = Math::BigRat->new('1 / 3');            # spaced
  959.     $x = Math::BigRat->new('1 / 0.1');            # w/ floats
  960.     $x = Math::BigRat->new(Math::BigInt->new(3));        # BigInt
  961.     $x = Math::BigRat->new(Math::BigFloat->new('3.1'));    # BigFloat
  962.     $x = Math::BigRat->new(Math::BigInt::Lite->new('2'));    # BigLite
  963.  
  964. =head2 numerator()
  965.  
  966.     $n = $x->numerator();
  967.  
  968. Returns a copy of the numerator (the part above the line) as signed BigInt.
  969.  
  970. =head2 denominator()
  971.     
  972.     $d = $x->denominator();
  973.  
  974. Returns a copy of the denominator (the part under the line) as positive BigInt.
  975.  
  976. =head2 parts()
  977.  
  978.     ($n,$d) = $x->parts();
  979.  
  980. Return a list consisting of (signed) numerator and (unsigned) denominator as
  981. BigInts.
  982.  
  983. =head2 as_number()
  984.  
  985. Returns a copy of the object as BigInt by truncating it to integer.
  986.  
  987. =head2 bfac()
  988.  
  989.     $x->bfac();
  990.  
  991. Calculates the factorial of $x. For instance:
  992.  
  993.     print Math::BigRat->new('3/1')->bfac(),"\n";    # 1*2*3
  994.     print Math::BigRat->new('5/1')->bfac(),"\n";    # 1*2*3*4*5
  995.  
  996. Only works for integers for now.
  997.  
  998. =head2 blog()
  999.  
  1000. Is not yet implemented.
  1001.  
  1002. =head2 bround()/round()/bfround()
  1003.  
  1004. Are not yet implemented.
  1005.  
  1006.  
  1007. =head1 BUGS
  1008.  
  1009. Some things are not yet implemented, or only implemented half-way.
  1010.  
  1011. =head1 LICENSE
  1012.  
  1013. This program is free software; you may redistribute it and/or modify it under
  1014. the same terms as Perl itself.
  1015.  
  1016. =head1 SEE ALSO
  1017.  
  1018. L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
  1019. L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
  1020.  
  1021. The package at
  1022. L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigRat> may
  1023. contain more documentation and examples as well as testcases.
  1024.  
  1025. =head1 AUTHORS
  1026.  
  1027. (C) by Tels L<http://bloodgate.com/> 2001-2002. 
  1028.  
  1029. =cut
  1030.