-#!/usr/bin/perl -w
+
+#
+# "Tax the rat farms."
+#
# The following hash values are used:
# sign : +,-,NaN,+inf,-inf
# _n : numeraotr (value = _n/_d)
# _a : accuracy
# _p : precision
-# _f : flags, used by MBR to flag parts of a rationale as untouchable
+# _f : flags, used by MBR to flag parts of a rational as untouchable
package Math::BigRat;
-require 5.005_02;
+require 5.005_03;
use strict;
use Exporter;
@ISA = qw(Exporter Math::BigFloat);
@EXPORT_OK = qw();
-$VERSION = '0.05';
+$VERSION = '0.07';
use overload; # inherit from Math::BigFloat
my $nan = 'NaN';
my $class = 'Math::BigRat';
+my $MBI = 'Math::BigInt';
sub isa
{
sub _new_from_float
{
- # turn a single float input into a rationale (like '0.1')
+ # turn a single float input into a rational (like '0.1')
my ($self,$f) = @_;
return $self->bnan() if $f->is_nan();
#print "f $f caller", join(' ',caller()),"\n";
$self->{_n} = $f->{_m}->copy(); # mantissa
- $self->{_d} = Math::BigInt->bone();
+ $self->{_d} = $MBI->bone();
$self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
if ($f->{_e}->{sign} eq '-')
{
# 1 / 1 => 10/1
$self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
}
-# print "float new $self->{_n} / $self->{_d}\n";
$self;
}
my $self = { }; bless $self,$class;
-# print "ref ",ref($d),"\n";
-# if (ref($d))
-# {
-# print "isa float ",$d->isa('Math::BigFloat'),"\n";
-# print "isa int ",$d->isa('Math::BigInt'),"\n";
-# print "isa rat ",$d->isa('Math::BigRat'),"\n";
-# }
-
# input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
- if ((ref $n) && (!$n->isa('Math::BigRat')))
+ if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
{
-# print "is ref, but not rat\n";
if ($n->isa('Math::BigFloat'))
{
- # print "is ref, and float\n";
return $self->_new_from_float($n)->bnorm();
}
if ($n->isa('Math::BigInt'))
{
-# print "is ref, and int\n";
$self->{_n} = $n->copy(); # "mantissa" = $n
- $self->{_d} = Math::BigInt->bone();
+ $self->{_d} = $MBI->bone();
$self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
return $self->bnorm();
}
if ($n->isa('Math::BigInt::Lite'))
{
-# print "is ref, and lite\n";
- $self->{_n} = Math::BigInt->new($$n); # "mantissa" = $n
- $self->{_d} = Math::BigInt->bone();
+ $self->{_n} = $MBI->new($$n); # "mantissa" = $n
+ $self->{_d} = $MBI->bone();
$self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
return $self->bnorm();
}
}
return $n->copy() if ref $n;
-
-# print "is string\n";
if (!defined $n)
{
- $self->{_n} = Math::BigInt->bzero(); # undef => 0
- $self->{_d} = Math::BigInt->bone();
+ $self->{_n} = $MBI->bzero(); # undef => 0
+ $self->{_d} = $MBI->bone();
$self->{sign} = '+';
return $self->bnorm();
}
}
else
{
- $self->{_n} = Math::BigInt->new($n);
- $self->{_d} = Math::BigInt->new($d);
+ $self->{_n} = $MBI->new($n);
+ $self->{_d} = $MBI->new($d);
return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
# inf handling is missing here
# simple string input
if (($n =~ /[\.eE]/))
{
+ # work around bug in BigFloat that makes 1.1.2 valid
+ return $self->bnan() if $n =~ /\..*\./;
# looks like a float
-# print "float-like string $d\n";
$self->_new_from_float(Math::BigFloat->new($n));
}
else
{
- $self->{_n} = Math::BigInt->new($n);
- $self->{_d} = Math::BigInt->bone();
+ $self->{_n} = $MBI->new($n);
+ $self->{_d} = $MBI->bone();
$self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
+ return $self->bnan() if $self->{sign} eq 'NaN';
+ return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
}
$self->bnorm();
}
return $s;
}
-# print "bstr $x->{sign} $x->{_n} $x->{_d}\n";
my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
# don't reduce again)
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ # both parts must be BigInt's
+ die ("n is not $MBI but (".ref($x->{_n}).')')
+ if ref($x->{_n}) ne $MBI;
+ die ("d is not $MBI but (".ref($x->{_d}).')')
+ if ref($x->{_d}) ne $MBI;
+
# this is to prevent automatically rounding when MBI's globals are set
$x->{_d}->{_f} = MB_NEVER_ROUND;
$x->{_n}->{_f} = MB_NEVER_ROUND;
$x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
$x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
+ # no normalize for NaN, inf etc.
+ return $x if $x->{sign} !~ /^[+-]$/;
+
# normalize zeros to 0/1
if (($x->{sign} =~ /^[+-]$/) &&
($x->{_n}->is_zero()))
{
- $x->{sign} = '+'; # never -0
- $x->{_d} = Math::BigInt->bone() unless $x->{_d}->is_one();
+ $x->{sign} = '+'; # never -0
+ $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
return $x;
}
-# print "$x->{_n} / $x->{_d} => ";
+ return $x if $x->{_d}->is_one(); # no need to reduce
+
# reduce other numbers
- # print "bgcd $x->{_n} (",ref($x->{_n}),") $x->{_d} (",ref($x->{_d}),")\n";
# disable upgrade in BigInt, otherwise deep recursion
local $Math::BigInt::upgrade = undef;
my $gcd = $x->{_n}->bgcd($x->{_d});
$x->{_n}->bdiv($gcd);
$x->{_d}->bdiv($gcd);
}
-# print "$x->{_n} / $x->{_d}\n";
$x;
}
{
# used by parent class bone() to initialize number to 1
my $self = shift;
- $self->{_n} = Math::BigInt->bzero();
- $self->{_d} = Math::BigInt->bzero();
+ $self->{_n} = $MBI->bzero();
+ $self->{_d} = $MBI->bzero();
}
sub _binf
{
# used by parent class bone() to initialize number to 1
my $self = shift;
- $self->{_n} = Math::BigInt->bzero();
- $self->{_d} = Math::BigInt->bzero();
+ $self->{_n} = $MBI->bzero();
+ $self->{_d} = $MBI->bzero();
}
sub _bone
{
# used by parent class bone() to initialize number to 1
my $self = shift;
- $self->{_n} = Math::BigInt->bone();
- $self->{_d} = Math::BigInt->bone();
+ $self->{_n} = $MBI->bone();
+ $self->{_d} = $MBI->bone();
}
sub _bzero
{
# used by parent class bone() to initialize number to 1
my $self = shift;
- $self->{_n} = Math::BigInt->bzero();
- $self->{_d} = Math::BigInt->bone();
+ $self->{_n} = $MBI->bzero();
+ $self->{_d} = $MBI->bone();
}
##############################################################################
sub badd
{
- # add two rationales
+ # add two rationals
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- $x = $class->new($x) unless $x->isa($class);
- $y = $class->new($y) unless $y->isa($class);
+ $x = $self->new($x) unless $x->isa($self);
+ $y = $self->new($y) unless $y->isa($self);
return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
sub bsub
{
- # subtract two rationales
+ # subtract two rationals
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
$x = $class->new($x) unless $x->isa($class);
sub bmul
{
- # multiply two rationales
+ # multiply two rationals
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
$x = $class->new($x) unless $x->isa($class);
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
$x->bnorm()->round($a,$p,$r);
+ $x;
+ }
+
+##############################################################################
+# bdec/binc
+
+sub bdec
+ {
+ # decrement value (subtract 1)
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+
+ if ($x->{sign} eq '-')
+ {
+ $x->{_n}->badd($x->{_d}); # -5/2 => -7/2
+ }
+ else
+ {
+ if ($x->{_n}->bacmp($x->{_d}) < 0)
+ {
+ # 1/3 -- => -2/3
+ $x->{_n} = $x->{_d} - $x->{_n};
+ $x->{sign} = '-';
+ }
+ else
+ {
+ $x->{_n}->bsub($x->{_d}); # 5/2 => 3/2
+ }
+ }
+ $x->bnorm()->round(@r);
+
+ #$x->bsub($self->bone())->round(@r);
+ }
+
+sub binc
+ {
+ # increment value (add 1)
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+
+ if ($x->{sign} eq '-')
+ {
+ if ($x->{_n}->bacmp($x->{_d}) < 0)
+ {
+ # -1/3 ++ => 2/3 (overflow at 0)
+ $x->{_n} = $x->{_d} - $x->{_n};
+ $x->{sign} = '+';
+ }
+ else
+ {
+ $x->{_n}->bsub($x->{_d}); # -5/2 => -3/2
+ }
+ }
+ else
+ {
+ $x->{_n}->badd($x->{_d}); # 5/2 => 7/2
+ }
+ $x->bnorm()->round(@r);
+
+ #$x->badd($self->bone())->round(@r);
}
##############################################################################
sub numerator
{
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
-
+
+ return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
+
my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
$n;
}
{
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
$x->{_d}->copy();
}
{
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ return ($self->bnan(),$self->bnan()) if $x->{sign} eq 'NaN';
+ return ($self->binf(),$self->binf()) if $x->{sign} eq '+inf';
+ return ($self->binf('-'),$self->binf()) if $x->{sign} eq '-inf';
+
my $n = $x->{_n}->copy();
$n->{sign} = $x->{sign};
- return ($x->{_n}->copy(),$x->{_d}->copy());
+ return ($n,$x->{_d}->copy());
}
sub length
return $x unless $x->{sign} =~ /^[+-]$/;
return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
- $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1
+ $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d}->bone();
$x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
+ $x->{sign} = '+' if $x->{_n}->is_zero(); # -0 => 0
$x;
}
return $x unless $x->{sign} =~ /^[+-]$/;
return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
- $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1
+ $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d}->bone();
$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
$x;
sub bfac
{
- return Math::BigRat->bnan();
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ if (($x->{sign} eq '+') && ($x->{_d}->is_one()))
+ {
+ $x->{_n}->bfac();
+ return $x->round(@r);
+ }
+ $x->bnan();
}
sub bpow
# return $x->bnan() if $y->{sign} eq '-';
return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
+ # shortcut y/1 (and/or x/1)
+ if ($y->{_d}->is_one())
+ {
+ # shortcut for x/1 and y/1
+ if ($x->{_d}->is_one())
+ {
+ $x->{_n}->bpow($y->{_n}); # x/1 ** y/1 => (x ** y)/1
+ if ($y->{sign} eq '-')
+ {
+ # 0.2 ** -3 => 1/(0.2 ** 3)
+ ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
+ }
+ # correct sign; + ** + => +
+ if ($x->{sign} eq '-')
+ {
+ # - * - => +, - * - * - => -
+ $x->{sign} = '+' if $y->{_n}->is_even();
+ }
+ return $x->round(@r);
+ }
+ # x/z ** y/1
+ $x->{_n}->bpow($y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
+ $x->{_d}->bpow($y->{_n});
+ if ($y->{sign} eq '-')
+ {
+ # 0.2 ** -3 => 1/(0.2 ** 3)
+ ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
+ }
+ # correct sign; + ** + => +
+ if ($x->{sign} eq '-')
+ {
+ # - * - => +, - * - * - => -
+ $x->{sign} = '+' if $y->{_n}->is_even();
+ }
+ return $x->round(@r);
+ }
+
+ # regular calculation (this is wrong for d/e ** f/g)
my $pow2 = $self->__one();
- my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs();
- my $two = Math::BigInt->new(2);
+ my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
+ my $two = $MBI->new(2);
while (!$y1->is_one())
{
- print "at $y1 (= $x)\n";
$pow2->bmul($x) if $y1->is_odd();
$y1->bdiv($two);
$x->bmul($x);
$t;
}
-#sub import
-# {
-# my $self = shift;
-# Math::BigInt->import(@_);
-# $self->SUPER::import(@_); # need it for subclasses
-# #$self->export_to_level(1,$self,@_); # need this ?
-# }
+sub import
+ {
+ my $self = shift;
+ my $l = scalar @_;
+ my $lib = ''; my @a;
+ for ( my $i = 0; $i < $l ; $i++)
+ {
+# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
+ if ( $_[$i] eq ':constant' )
+ {
+ # this rest causes overlord er load to step in
+ # print "overload @_\n";
+ overload::constant float => sub { $self->new(shift); };
+ }
+# elsif ($_[$i] eq 'upgrade')
+# {
+# # this causes upgrading
+# $upgrade = $_[$i+1]; # or undef to disable
+# $i++;
+# }
+ elsif ($_[$i] eq 'downgrade')
+ {
+ # this causes downgrading
+ $downgrade = $_[$i+1]; # or undef to disable
+ $i++;
+ }
+ elsif ($_[$i] eq 'lib')
+ {
+ $lib = $_[$i+1] || ''; # default Calc
+ $i++;
+ }
+ elsif ($_[$i] eq 'with')
+ {
+ $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
+ $i++;
+ }
+ else
+ {
+ push @a, $_[$i];
+ }
+ }
+ # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
+ my $mbilib = eval { Math::BigInt->config()->{lib} };
+ if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
+ {
+ # MBI already loaded
+ $MBI->import('lib',"$lib,$mbilib", 'objectify');
+ }
+ else
+ {
+ # MBI not loaded, or not with "Math::BigInt"
+ $lib .= ",$mbilib" if defined $mbilib;
+
+ if ($] < 5.006)
+ {
+ # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+ # used in the same script, or eval inside import().
+ my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
+ my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
+ $file = File::Spec->catfile (@parts, $file);
+ eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
+ }
+ else
+ {
+ my $rc = "use $MBI lib => '$lib', 'objectify';";
+ eval $rc;
+ }
+ }
+ die ("Couldn't load $MBI: $! $@") if $@;
+
+ # any non :constant stuff is handled by our parent, Exporter
+ # even if @_ is empty, to give it a chance
+ $self->SUPER::import(@a); # for subclasses
+ $self->export_to_level(1,$self,@a); # need this, too
+ }
1;
=head1 NAME
-Math::BigRat - arbitrarily big rationales
+Math::BigRat - arbitrarily big rationals
=head1 SYNOPSIS
=head1 METHODS
-=head2 new
+Any method not listed here is dervied from Math::BigFloat (or
+Math::BigInt), so make sure you check these two modules for further
+information.
+
+=head2 new()
$x = Math::BigRat->new('1/3');
$x = Math::BigRat->new('1 / 0.1'); # w/ floats
$x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
$x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
+ $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
-=head2 numerator
+=head2 numerator()
$n = $x->numerator();
Returns a copy of the numerator (the part above the line) as signed BigInt.
-=head2 denominator
+=head2 denominator()
$d = $x->denominator();
Returns a copy of the denominator (the part under the line) as positive BigInt.
-=head2 parts
+=head2 parts()
($n,$d) = $x->parts();
Return a list consisting of (signed) numerator and (unsigned) denominator as
BigInts.
+=head2 as_number()
+
+Returns a copy of the object as BigInt by truncating it to integer.
+
+=head2 bfac()
+
+ $x->bfac();
+
+Calculates the factorial of $x. For instance:
+
+ print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
+ print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
+
+Only works for integers for now.
+
+=head2 blog()
+
+Is not yet implemented.
+
+=head2 bround()/round()/bfround()
+
+Are not yet implemented.
+
+
=head1 BUGS
-None know yet. Please see also L<Math::BigInt>.
+Some things are not yet implemented, or only implemented half-way.
=head1 LICENSE
projects / p5sagit/p5-mst-13.2.git / blobdiff