From: Jarkko Hietaniemi Date: Sat, 23 Mar 2002 23:07:04 +0000 (+0000) Subject: Merge Math::BigRat 0.04, from Tels. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=184f15d5c89b4453db9c19df21ac9805bf2f4e07;p=p5sagit%2Fp5-mst-13.2.git Merge Math::BigRat 0.04, from Tels. p4raw-id: //depot/perl@15453 --- diff --git a/MANIFEST b/MANIFEST index 1b168a3..c041880 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1160,11 +1160,6 @@ lib/look.pl A "look" equivalent lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt -lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly -lib/Math/BigInt/t/use_lib1.t Test combinations of Math::BigInt and BigFloat -lib/Math/BigInt/t/use_lib2.t Test combinations of Math::BigInt and BigFloat -lib/Math/BigInt/t/use_lib3.t Test combinations of Math::BigInt and BigFloat -lib/Math/BigInt/t/use_lib4.t Test combinations of Math::BigInt and BigFloat lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t @@ -1180,6 +1175,7 @@ lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling lib/Math/BigInt/t/isa.t Test for Math::BigInt inheritance lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precicion and fallback, round_mode tests lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode +lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly lib/Math/BigInt/t/require.t Test if require Math::BigInt works lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt @@ -1187,6 +1183,16 @@ lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works +lib/Math/BigInt/t/use_lib1.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib2.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib3.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigInt/t/use_lib4.t Test combinations of Math::BigInt and BigFloat +lib/Math/BigRat.pm Math::BigRat +lib/Math/BigRat/t/bigfltpm.inc Math::BigRat test +lib/Math/BigRat/t/bigfltrt.t Math::BigRat test +lib/Math/BigRat/t/bigrat.t Math::BigRat test +lib/Math/BigRat/t/bigratpm.inc Math::BigRat test +lib/Math/BigRat/t/bigratpm.t Math::BigRat test lib/Math/Complex.pm A Complex package lib/Math/Complex.t See if Math::Complex works lib/Math/Trig.pm A simple interface to complex trigonometry @@ -2247,6 +2253,7 @@ t/lib/locale/utf8 Part of locale.t in UTF8 t/lib/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for test t/lib/Math/BigInt/BareCalc.pm Bigint's simulation of Calc t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test +t/lib/Math/BigRat/Test.pm Math::BigRat test helper t/lib/sample-tests/bailout Test data for Test::Harness t/lib/sample-tests/combined Test data for Test::Harness t/lib/sample-tests/descriptive Test data for Test::Harness diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm new file mode 100644 index 0000000..b23408a --- /dev/null +++ b/lib/Math/BigRat.pm @@ -0,0 +1,806 @@ +#!/usr/bin/perl -w + +# The following hash values are used: +# sign : +,-,NaN,+inf,-inf +# _d : denominator +# _n : numeraotr (value = _n/_d) +# _a : accuracy +# _p : precision +# _f : flags, used by MBR to flag parts of a rationale as untouchable + +package Math::BigRat; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigFloat); +@EXPORT_OK = qw(); + +$VERSION = '0.04'; + +use overload; # inherit from Math::BigFloat + +############################################################################## +# global constants, flags and accessory + +use constant MB_NEVER_ROUND => 0x0001; + +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; +$upgrade = undef; +$downgrade = undef; + +my $nan = 'NaN'; +my $class = 'Math::BigRat'; + +sub _new_from_float + { + # turn a single float input into a rationale (like '0.1') + my ($self,$f) = @_; + + return $self->bnan() if $f->is_nan(); + return $self->binf('-inf') if $f->{sign} eq '-inf'; + return $self->binf('+inf') if $f->{sign} eq '+inf'; + + #print "f $f caller", join(' ',caller()),"\n"; + $self->{_n} = $f->{_m}->copy(); # mantissa + $self->{_d} = Math::BigInt->bone(); + $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+'; + if ($f->{_e}->{sign} eq '-') + { + # something like Math::BigRat->new('0.1'); + $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10 + } + else + { + # something like Math::BigRat->new('10'); + # 1 / 1 => 10/1 + $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero(); + } +# print "float new $self->{_n} / $self->{_d}\n"; + $self; + } + +sub new + { + # create a Math::BigRat + my $class = shift; + + my ($n,$d) = shift; + + 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'))) + { +# 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" = $d + $self->{_d} = Math::BigInt->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->{sign} = '+'; + return $self->bnorm(); + } + # string input with / delimiter + if ($n =~ /\s*\/\s*/) + { + return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid + return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid + ($n,$d) = split (/\//,$n); + # try as BigFloats first + if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/)) + { + # one of them looks like a float + $self->_new_from_float(Math::BigFloat->new($n)); + # now correct $self->{_n} due to $n + my $f = Math::BigFloat->new($d); + if ($f->{_e}->{sign} eq '-') + { + # 10 / 0.1 => 100/1 + $self->{_n}->blsft($f->{_e}->copy()->babs(),10); + } + else + { + $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1 + } + } + else + { + $self->{_n} = Math::BigInt->new($n); + $self->{_d} = Math::BigInt->new($d); + return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan(); + # inf handling is missing here + + $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+'; + # if $d is negative, flip sign + $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-'; + $self->{_d}->{sign} = '+'; # normalize + } + return $self->bnorm(); + } + + # simple string input + if (($n =~ /[\.eE]/)) + { + # 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->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+'; + } + $self->bnorm(); + } + +sub bstr + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + 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(); + return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr(); + } + +sub bsstr + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + return $x->{_n}->bstr() . '/' . $x->{_d}->bstr(); + } + +sub bnorm + { + # reduce the number to the shortest form and remember this (so that we + # don't reduce again) + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + # this is to prevent automatically rounding when MBI's globals are set + $x->{_d}->{_f} = MB_NEVER_ROUND; + $x->{_n}->{_f} = MB_NEVER_ROUND; + # 'forget' that parts were rounded via MBI::bround() in MBF's bfround() + $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef; + $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef; + + # 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(); + return $x; + } + +# print "$x->{_n} / $x->{_d} => "; + # reduce other numbers + my $gcd = $x->{_n}->bgcd($x->{_d}); + + if (!$gcd->is_one()) + { + $x->{_n}->bdiv($gcd); + $x->{_d}->bdiv($gcd); + } +# print "$x->{_n} / $x->{_d}\n"; + $x; + } + +############################################################################## +# special values + +sub _bnan + { + # used by parent class bone() to initialize number to 1 + my $self = shift; + $self->{_n} = Math::BigInt->bzero(); + $self->{_d} = Math::BigInt->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(); + } + +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(); + } + +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(); + } + +############################################################################## +# mul/add/div etc + +sub badd + { + # add two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 + # - + - = --------- = -- + # 4 3 4*3 12 + + my $gcd = $x->{_d}->bgcd($y->{_d}); + + my $aa = $x->{_d}->copy(); + my $bb = $y->{_d}->copy(); + if ($gcd->is_one()) + { + $bb->bdiv($gcd); $aa->bdiv($gcd); + } + $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign}; + my $m = $y->{_n}->copy()->bmul($aa); + $m->{sign} = $y->{sign}; # 2/1 - 2/1 + $x->{_n}->badd($m); + + $x->{_d}->bmul($y->{_d}); + + # calculate new sign + $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bsub + { + # subtract two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + # TODO: inf handling + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 gcd(3,4) = 1 1*3 + 1*4 7 + # - + - = --------- = -- + # 4 3 4*3 12 + + my $gcd = $x->{_d}->bgcd($y->{_d}); + + my $aa = $x->{_d}->copy(); + my $bb = $y->{_d}->copy(); + if ($gcd->is_one()) + { + $bb->bdiv($gcd); $aa->bdiv($gcd); + } + $x->{_n}->bmul($bb); $x->{_n}->{sign} = $x->{sign}; + my $m = $y->{_n}->copy()->bmul($aa); + $m->{sign} = $y->{sign}; # 2/1 - 2/1 + $x->{_n}->bsub($m); + + $x->{_d}->bmul($y->{_d}); + + # calculate new sign + $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bmul + { + # multiply two rationales + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + return $x->bnan() if $x->is_zero() || $y->is_zero(); + # result will always be +-inf: + # +inf * +/+inf => +inf, -inf * -/-inf => +inf + # +inf * -/-inf => -inf, -inf * +/+inf => -inf + return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); + return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); + return $x->binf('-'); + } + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # TODO: upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # According to Knuth, this can be optimized by doingtwice gcd (for d and n) + # and reducing in one step) + + # 1 1 2 1 + # - * - = - = - + # 4 3 12 6 + $x->{_n}->bmul($y->{_n}); + $x->{_d}->bmul($y->{_d}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round($a,$p,$r); + } + +sub bdiv + { + # (dividend: BRAT or num_str, divisor: BRAT or num_str) return + # (BRAT,BRAT) (quo,rem) or BRAT (only rem) + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); + + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + + # TODO: list context, upgrade + +# # upgrade +# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + + # 1 1 1 3 + # - / - == - * - + # 4 3 4 1 + $x->{_n}->bmul($y->{_d}); + $x->{_d}->bmul($y->{_n}); + + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; + + $x->bnorm()->round($a,$p,$r); + } + +############################################################################## +# is_foo methods (the rest is inherited) + +sub is_int + { + # return true if arg (BRAT or num_str) is an integer + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't + $x->{_d}->is_one(); # 1e-1 => no integer + 0; + } + +sub is_zero + { + # return true if arg (BRAT or num_str) is zero + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero(); + 0; + } + +sub is_one + { + # return true if arg (BRAT or num_str) is +1 or -1 if signis given + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $sign = shift || ''; $sign = '+' if $sign ne '-'; + return 1 + if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one()); + 0; + } + +sub is_odd + { + # return true if arg (BFLOAT or num_str) is odd or false if even + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't + ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1 + 0; + } + +sub is_even + { + # return true if arg (BINT or num_str) is even or false if odd + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't + return 1 if ($x->{_d}->is_one() # x/3 is never + && $x->{_n}->is_even()); # but 4/1 is + 0; + } + +BEGIN + { + *objectify = \&Math::BigInt::objectify; + } + +############################################################################## +# parts() and friends + +sub numerator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign}; + $n; + } + +sub denominator + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + $x->{_d}->copy(); + } + +sub parts + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + my $n = $x->{_n}->copy(); + $n->{sign} = $x->{sign}; + return ($x->{_n}->copy(),$x->{_d}->copy()); + } + +sub length + { + return 0; + } + +sub digit + { + return 0; + } + +############################################################################## +# special calc routines + +sub bceil + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + 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->{_d}->bone(); + $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1 + $x; + } + +sub bfloor + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + 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->{_d}->bone(); + $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1 + $x; + } + +sub bfac + { + return Math::BigRat->bnan(); + } + +sub bpow + { + my ($self,$x,$y,@r) = objectify(2,@_); + + return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x + return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; + return $x->bone(@r) if $y->is_zero(); + return $x->round(@r) if $x->is_one() || $y->is_one(); + if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one()) + { + # if $x == -1 and odd/even y => +1/-1 + return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); + # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; + } + # 1 ** -y => 1 / (1 ** |y|) + # so do test for negative $y after above's clause + # return $x->bnan() if $y->{sign} eq '-'; + return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) + + my $pow2 = $self->__one(); + my $y1 = Math::BigInt->new($y->{_n}/$y->{_d})->babs(); + my $two = Math::BigInt->new(2); + while (!$y1->is_one()) + { + print "at $y1 (= $x)\n"; + $pow2->bmul($x) if $y1->is_odd(); + $y1->bdiv($two); + $x->bmul($x); + } + $x->bmul($pow2) unless $pow2->is_one(); + # n ** -x => 1/n ** x + ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-'; + $x; + #$x->round(@r); + } + +sub blog + { + return Math::BigRat->bnan(); + } + +sub bsqrt + { + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc + $x->{_d}->bsqrt($a,$p,$r); + $x->{_n}->bsqrt($a,$p,$r); + $x->bnorm(); + } + +sub blsft + { + my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_); + + $x->bmul( $b->copy()->bpow($y), $a,$p,$r); + $x; + } + +sub brsft + { + my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_); + + $x->bdiv( $b->copy()->bpow($y), $a,$p,$r); + $x; + } + +############################################################################## +# round + +sub round + { + $_[0]; + } + +sub bround + { + $_[0]; + } + +sub bfround + { + $_[0]; + } + +############################################################################## +# comparing + +sub bcmp + { + my ($self,$x,$y) = objectify(2,@_); + + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # handle +-inf and NaN + return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return +1 if $x->{sign} eq '+inf'; + return -1 if $x->{sign} eq '-inf'; + return -1 if $y->{sign} eq '+inf'; + return +1; + } + # check sign for speed first + return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y + return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 + + # shortcut + my $xz = $x->{_n}->is_zero(); + my $yz = $y->{_n}->is_zero(); + return 0 if $xz && $yz; # 0 <=> 0 + return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y + return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 + + my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign}; + my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign}; + $t->bcmp($u); + } + +sub bacmp + { + my ($self,$x,$y) = objectify(2,@_); + + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # handle +-inf and NaN + return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; + return +1; # inf is always bigger + } + + my $t = $x->{_n} * $y->{_d}; + my $u = $y->{_n} * $x->{_d}; + $t->bacmp($u); + } + +############################################################################## +# output conversation + +sub as_number + { + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc + my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3 + $t->{sign} = $x->{sign}; + $t; + } + +#sub import +# { +# my $self = shift; +# Math::BigInt->import(@_); +# $self->SUPER::import(@_); # need it for subclasses +# #$self->export_to_level(1,$self,@_); # need this ? +# } + +1; + +__END__ + +=head1 NAME + +Math::BigRat - arbitrarily big rationales + +=head1 SYNOPSIS + + use Math::BigRat; + + $x = Math::BigRat->new('3/7'); + + print $x->bstr(),"\n"; + +=head1 DESCRIPTION + +This is just a placeholder until the real thing is up and running. Watch this +space... + +=head2 MATH LIBRARY + +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use Math::BigRat lib => 'Calc'; + +You can change this by using: + + use Math::BigRat lib => 'BitVect'; + +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; + +Calc.pm uses as internal format an array of elements of some decimal base +(usually 1e7, but this might be differen for some systems) with the least +significant digit first, while BitVect.pm uses a bit vector of base 2, most +significant bit first. Other modules might use even different means of +representing the numbers. See the respective module documentation for further +details. + +=head1 METHODS + +=head2 new + + $x = Math::BigRat->new('1/3'); + +Create a new Math::BigRat object. Input can come in various forms: + + $x = Math::BigRat->new('1/3'); # simple string + $x = Math::BigRat->new('1 / 3'); # spaced + $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 + +=head2 numerator + + $n = $x->numerator(); + +Returns a copy of the numerator (the part above the line) as signed BigInt. + +=head2 denominator + + $d = $x->denominator(); + +Returns a copy of the denominator (the part under the line) as positive BigInt. + +=head2 parts + + ($n,$d) = $x->parts(); + +Return a list consisting of (signed) numerator and (unsigned) denominator as +BigInts. + +=head1 BUGS + +None know yet. Please see also L. + +=head1 LICENSE + +This program is free software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 SEE ALSO + +L and L as well as L, +L and L. + +The package at +L may +contain more documentation and examples as well as testcases. + +=head1 AUTHORS + +(C) by Tels L 2001-2002. + +=cut diff --git a/lib/Math/BigRat/t/bigfltpm.inc b/lib/Math/BigRat/t/bigfltpm.inc new file mode 100644 index 0000000..5b3f4f1 --- /dev/null +++ b/lib/Math/BigRat/t/bigfltpm.inc @@ -0,0 +1,1244 @@ +#include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + +while () + { + chop; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "fnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "exponent") { + # ->bstr() to see if an object is returned + $try .= '$x->exponent()->bstr();'; + } elsif ($f eq "mantissa") { + # ->bstr() to see if an object is returned + $try .= '$x->mantissa()->bstr();'; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "length") { + $try .= "\$x->length();"; + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "as_number") { + $try .= '$x->as_number();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->bround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->bfround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->bsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->blog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->bfac();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "fcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "facmp") { + $try .= '$x->bacmp($y);'; + } elsif ($f eq "fpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "fadd") { + $try .= '$x + $y;'; + } elsif ($f eq "fsub") { + $try .= '$x - $y;'; + } elsif ($f eq "fmul") { + $try .= '$x * $y;'; + } elsif ($f eq "fdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->bdiv(\$y));"; + } elsif ($f eq "frsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "flsft") { + $try .= '$x << $y;'; + } elsif ($f eq "fmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); +# if (ref($ans1) eq "$class") +# { +# # float numbers are normalized (for now), so mantissa shouldn't have +# # trailing zeros +# #print $ans1->_trailing_zeros(),"\n"; +# print "# Has trailing zeros after '$try'\n" +# if !ok ($ans1->{_m}->_trailing_zeros(), 0); +# } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +ok ($y,1200); ok ($x,1200); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +############################################################################### +# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() +# correctly modifies $x + +$class->accuracy(undef); $class->precision(undef); # reset + +$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); + +$class->precision(undef); +$x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); + +$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); + +# A and P set => NaN +${${class}.'::accuracy'} = 4; $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN'); +# supplied arg overrides set global +$class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); + +$class->accuracy(undef); $class->precision(undef); # reset for further tests + +1; # all done + +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +__DATA__ +$div_scale = 40; +&flog +0:NaN +-1:NaN +-2:NaN +1:0 +# this is too slow for the testsuite +#2.718281828:0.9999999998311266953289851340574956564911 +#$div_scale = 20; +#2.718281828:0.99999999983112669533 +1:0 +# too slow, too (or hangs?) +#123:4.8112184355 +# $div_scale = 14; +#10:0:2.302585092994 +#1000:0:6.90775527898214 +#100:0:4.60517018598809 +#2:0:0.693147180559945 +#3.1415:0:1.14470039286086 +#12345:0:9.42100640177928 +#0.001:0:-6.90775527898214 +# reset for further tests +$div_scale = 40; +&frsft +NaNfrsft:2:NaN +0:2:0 +1:1:0.5 +2:1:1 +4:1:2 +123:1:61.5 +32:3:4 +&flsft +NaNflsft:0:NaN +2:1:4 +4:3:32 +5:3:40 +1:2:4 +0:5:0 +&fnorm +1:1 +-0:0 +fnormNaN:NaN ++inf:inf +-inf:-inf +123:123 +-123.4567:-123.4567 +# invalid inputs +1__2:NaN +1E1__2:NaN +11__2E2:NaN +#1.E3:NaN +.2E-3.:NaN +#1e3e4:NaN +.2E2:20 +&as_number +0:0 +1:1 +1.2:1 +2.345:2 +-2:-2 +-123.456:-123 +-200:-200 +&finf +1:+:inf +2:-:-inf +3:abc:inf +&numify +0:0e+1 ++1:1e+0 +1234:1234e+0 +NaN:NaN ++inf:inf +-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1234.567:1234567e-3 +&fstr ++inf:::inf +-inf:::-inf +abcfstr:::NaN +1234.567:9::1234.56700 +1234.567::-6:1234.567000 +12345:5::12345 +0.001234:6::0.00123400 +0.001234::-8:0.00123400 +0:4::0 +0::-4:0.0000 +&fnorm +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:123.456 +0.01:0.01 +.002:0.002 ++.2:0.2 +-0.0003:-0.0003 +-.0000000004:-0.0000000004 +123456E2:12345600 +123456E-2:1234.56 +-123456E2:-12345600 +-123456E-2:-1234.56 +1e1:10 +2e-11:0.00000000002 +# excercise _split + .02e-1:0.002 + 000001:1 + -00001:-1 + -1:-1 + 000.01:0.01 + -000.0023:-0.0023 + 1.1e1:11 +-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 +&fpow +2:2:4 +1:2:1 +1:3:1 +-1:2:1 +-1:3:-1 +123.456:2:15241.383936 +2:-2:0.25 +2:-3:0.125 +128:-2:0.00006103515625 +abc:123.456:NaN +123.456:abc:NaN ++inf:123.45:inf +-inf:123.45:-inf ++inf:-123.45:inf +-inf:-123.45:-inf +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123.456789 +-123456.789:123456.789 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123.456789 +-123456.789:123456.789 +&fround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNfround:5:NaN ++10123456789:5:10123000000 +-10123456789:5:-10123000000 ++10123456789.123:5:10123000000 +-10123456789.123:5:-10123000000 ++10123456789:9:10123456700 +-10123456789:9:-10123456700 ++101234500:6:101234000 +-101234500:6:-101234000 +$round_mode = "zero" ++20123456789:5:20123000000 +-20123456789:5:-20123000000 ++20123456789.123:5:20123000000 +-20123456789.123:5:-20123000000 ++20123456789:9:20123456800 +-20123456789:9:-20123456800 ++201234500:6:201234000 +-201234500:6:-201234000 +$round_mode = "+inf" ++30123456789:5:30123000000 +-30123456789:5:-30123000000 ++30123456789.123:5:30123000000 +-30123456789.123:5:-30123000000 ++30123456789:9:30123456800 +-30123456789:9:-30123456800 ++301234500:6:301235000 +-301234500:6:-301234000 +$round_mode = "-inf" ++40123456789:5:40123000000 +-40123456789:5:-40123000000 ++40123456789.123:5:40123000000 +-40123456789.123:5:-40123000000 ++40123456789:9:40123456800 +-40123456789:9:-40123456800 ++401234500:6:401234000 +-401234500:6:-401235000 +$round_mode = "odd" ++50123456789:5:50123000000 +-50123456789:5:-50123000000 ++50123456789.123:5:50123000000 +-50123456789.123:5:-50123000000 ++50123456789:9:50123456800 +-50123456789:9:-50123456800 ++501234500:6:501235000 +-501234500:6:-501235000 +$round_mode = "even" ++60123456789:5:60123000000 +-60123456789:5:-60123000000 ++60123456789:9:60123456800 +-60123456789:9:-60123456800 ++601234500:6:601234000 +-601234500:6:-601234000 ++60123456789.0123:5:60123000000 +-60123456789.0123:5:-60123000000 +&ffround +$round_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNffround:5:NaN ++1.23:-1:1.2 ++1.234:-1:1.2 ++1.2345:-1:1.2 ++1.23:-2:1.23 ++1.234:-2:1.23 ++1.2345:-2:1.23 ++1.23:-3:1.230 ++1.234:-3:1.234 ++1.2345:-3:1.234 +-1.23:-1:-1.2 ++1.27:-1:1.2 +-1.27:-1:-1.2 ++1.25:-1:1.2 +-1.25:-1:-1.2 ++1.35:-1:1.3 +-1.35:-1:-1.3 +-0.0061234567890:-1:0.0 +-0.0061:-1:0.0 +-0.00612:-1:0.0 +-0.00612:-2:0.00 +-0.006:-1:0.0 +-0.006:-2:0.00 +-0.0006:-2:0.00 +-0.0006:-3:0.000 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:0 +0.41:0:0 +$round_mode = "zero" ++2.23:-1:/2.2(?:0{5}\d+)? +-2.23:-1:/-2.2(?:0{5}\d+)? ++2.27:-1:/2.(?:3|29{5}\d+) +-2.27:-1:/-2.(?:3|29{5}\d+) ++2.25:-1:/2.2(?:0{5}\d+)? +-2.25:-1:/-2.2(?:0{5}\d+)? ++2.35:-1:/2.(?:3|29{5}\d+) +-2.35:-1:/-2.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "+inf" ++3.23:-1:/3.2(?:0{5}\d+)? +-3.23:-1:/-3.2(?:0{5}\d+)? ++3.27:-1:/3.(?:3|29{5}\d+) +-3.27:-1:/-3.(?:3|29{5}\d+) ++3.25:-1:/3.(?:3|29{5}\d+) +-3.25:-1:/-3.2(?:0{5}\d+)? ++3.35:-1:/3.(?:4|39{5}\d+) +-3.35:-1:/-3.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-6e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "-inf" ++4.23:-1:/4.2(?:0{5}\d+)? +-4.23:-1:/-4.2(?:0{5}\d+)? ++4.27:-1:/4.(?:3|29{5}\d+) +-4.27:-1:/-4.(?:3|29{5}\d+) ++4.25:-1:/4.2(?:0{5}\d+)? +-4.25:-1:/-4.(?:3|29{5}\d+) ++4.35:-1:/4.(?:3|29{5}\d+) +-4.35:-1:/-4.(?:4|39{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +$round_mode = "odd" ++5.23:-1:/5.2(?:0{5}\d+)? +-5.23:-1:/-5.2(?:0{5}\d+)? ++5.27:-1:/5.(?:3|29{5}\d+) +-5.27:-1:/-5.(?:3|29{5}\d+) ++5.25:-1:/5.(?:3|29{5}\d+) +-5.25:-1:/-5.(?:3|29{5}\d+) ++5.35:-1:/5.(?:3|29{5}\d+) +-5.35:-1:/-5.(?:3|29{5}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.007|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:1 +0.51:0:1 +0.41:0:0 +$round_mode = "even" ++6.23:-1:/6.2(?:0{5}\d+)? +-6.23:-1:/-6.2(?:0{5}\d+)? ++6.27:-1:/6.(?:3|29{5}\d+) +-6.27:-1:/-6.(?:3|29{5}\d+) ++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) +-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) ++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) +-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) +-0.0065:-1:0.0 +-0.0065:-2:/-0\.01|-1e-02 +-0.0065:-3:/-0\.006|-7e-03 +-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 +0.05:0:0 +0.5:0:0 +0.51:0:1 +0.41:0:0 +0.01234567:-3:0.012 +0.01234567:-4:0.0123 +0.01234567:-5:0.01235 +0.01234567:-6:0.012346 +0.01234567:-7:0.0123457 +0.01234567:-8:0.01234567 +0.01234567:-9:0.012345670 +0.01234567:-12:0.012345670000 +&fcmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:-1 ++0:-1:1 ++1:+0:1 ++0:+1:-1 +-1:+1:-1 ++1:-1:1 +-1:-1:0 ++1:+1:0 +-1.1:0:-1 ++0:-1.1:1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:-1 +-12:-123:1 ++123:+124:-1 ++124:+123:1 +-123:-124:1 +-124:-123:-1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:1 +0:-0.1:1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:-1 +-0.1:0:-1 +0:0.0001234:-1 +0:-0.0001234:1 +0.0001234:0:1 +-0.0001234:0:-1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:-1 ++inf:5432112345:1 +-inf:-5432112345:-1 ++inf:-5432112345:1 +-inf:54321.12345:-1 ++inf:54321.12345:1 +-inf:-54321.12345:-1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 +# return undef ++inf:NaN: +NaN:inf: +-inf:NaN: +NaN:-inf: +&facmp +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: ++0:+0:0 +-1:+0:1 ++0:-1:-1 ++1:+0:1 ++0:+1:-1 +-1:+1:0 ++1:-1:0 +-1:-1:0 ++1:+1:0 +-1.1:0:1 ++0:-1.1:-1 ++1.1:+0:1 ++0:+1.1:-1 ++123:+123:0 ++123:+12:1 ++12:+123:-1 +-123:-123:0 +-123:-12:1 +-12:-123:-1 ++123:+124:-1 ++124:+123:1 +-123:-124:-1 +-124:-123:1 +0:0.01:-1 +0:0.0001:-1 +0:-0.0001:-1 +0:-0.1:-1 +0.1:0:1 +0.00001:0:1 +-0.0001:0:1 +-0.1:0:1 +0:0.0001234:-1 +0:-0.0001234:-1 +0.0001234:0:1 +-0.0001234:0:1 +0.0001:0.0005:-1 +0.0005:0.0001:1 +0.005:0.0001:1 +0.001:0.0005:1 +0.000001:0.0005:-1 +0.00000123:0.0005:-1 +0.00512:0.0001:1 +0.005:0.000112:1 +0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 +# infinity +-inf:5432112345:1 ++inf:5432112345:1 +-inf:-5432112345:1 ++inf:-5432112345:1 +-inf:54321.12345:1 ++inf:54321.12345:1 +-inf:-54321.12345:1 ++inf:-54321.12345:1 ++inf:+inf:0 +-inf:-inf:0 ++inf:-inf:0 +-inf:+inf:0 +5:inf:-1 +-1:inf:-1 +5:-inf:-1 +-1:-inf:-1 +# return undef ++inf:facmpNaN: +facmpNaN:inf: +-inf:facmpNaN: +facmpNaN:-inf: +&fdec +fdecNaN:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +1.23:0.23 +-1.23:-2.23 +100:99 +101:100 +-100:-101 +-99:-100 +-98:-99 +99:98 +&finc +fincNaN:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +1.23:2.23 +-1.23:-0.23 +100:101 +-100:-99 +-99:-98 +-101:-100 +99:100 +&fadd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:0 +-inf:+inf:0 ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +0.001234:0.0001234:0.0013574 +&fsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:0 +-inf:-inf:0 +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +&fmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +&fdiv-list +0:0:NaN,NaN +0:1:0,0 +9:4:2.25,1 +9:5:1.8,4 +&fdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:0.5 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:111111111.1111111111111111111111111111111 ++2000000000:+9:222222222.2222222222222222222222222222222 ++3000000000:+9:333333333.3333333333333333333333333333333 ++4000000000:+9:444444444.4444444444444444444444444444444 ++5000000000:+9:555555555.5555555555555555555555555555556 ++6000000000:+9:666666666.6666666666666666666666666666667 ++7000000000:+9:777777777.7777777777777777777777777777778 ++8000000000:+9:888888888.8888888888888888888888888888889 ++9000000000:+9:1000000000 ++35500000:+113:314159.2920353982300884955752212389380531 ++71000000:+226:314159.2920353982300884955752212389380531 ++106500000:+339:314159.2920353982300884955752212389380531 ++1000000000:+3:333333333.3333333333333333333333333333333 +2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 +123456:1:123456 +$div_scale = 20 ++1000000000:+9:111111111.11111111111 ++2000000000:+9:222222222.22222222222 ++3000000000:+9:333333333.33333333333 ++4000000000:+9:444444444.44444444444 ++5000000000:+9:555555555.55555555556 ++6000000000:+9:666666666.66666666667 ++7000000000:+9:777777777.77777777778 ++8000000000:+9:888888888.88888888889 ++9000000000:+9:1000000000 +1:10:0.1 +1:100:0.01 +1:1000:0.001 +1:10000:0.0001 +1:504:0.001984126984126984127 +2:1.987654321:1.0062111801179738436 +123456789.123456789123456789123456789:1:123456789.12345678912 +# the next two cases are the "old" behaviour, but are now (>v0.01) different +#+35500000:+113:314159.292035398230088 +#+71000000:+226:314159.292035398230088 ++35500000:+113:314159.29203539823009 ++71000000:+226:314159.29203539823009 ++106500000:+339:314159.29203539823009 ++1000000000:+3:333333333.33333333333 +$div_scale = 1 +# round to accuracy 1 after bdiv ++124:+3:40 +123456789.1234:1:100000000 +# reset scale for further tests +$div_scale = 40 +&fmod ++9:4:1 ++9:5:4 ++9000:56:40 ++56:9000:56 +# inf handling, see table in doc +0:inf:0 +0:-inf:0 +5:inf:5 +5:-inf:5 +-5:inf:-5 +-5:-inf:-5 +inf:5:0 +-inf:5:0 +inf:-5:0 +-inf:-5:0 +5:5:0 +-5:-5:0 +inf:inf:NaN +-inf:-inf:NaN +-inf:inf:NaN +inf:-inf:NaN +8:0:8 +inf:0:inf +# exceptions to reminder rule +-inf:0:-inf +-8:0:-8 +0:0:NaN +abc:abc:NaN +abc:1:abc:NaN +1:abc:NaN +0:0:NaN +0:1:0 +1:0:1 +0:-1:0 +-1:0:-1 +1:1:0 +-1:-1:0 +1:-1:0 +-1:1:0 +1:2:1 +2:1:0 +1000000000:9:1 +2000000000:9:2 +3000000000:9:3 +4000000000:9:4 +5000000000:9:5 +6000000000:9:6 +7000000000:9:7 +8000000000:9:8 +9000000000:9:0 +35500000:113:33 +71000000:226:66 +106500000:339:99 +1000000000:3:1 +10:5:0 +100:4:0 +1000:8:0 +10000:16:0 +999999999999:9:0 +999999999999:99:0 +999999999999:999:0 +999999999999:9999:0 +999999999999999:99999:0 +-9:+5:1 ++9:-5:-1 +-9:-5:-4 +-5:3:1 +-2:3:1 +4:3:1 +1:3:1 +-5:-3:-2 +-2:-3:-2 +4:-3:-2 +1:-3:-2 +4095:4095:0 +100041000510123:3:0 +152403346:12345:4321 +87654321:87654321:0 +# now some floating point tests +123:2.5:0.5 +1230:2.5:0 +123.4:2.5:0.9 +123e1:25:5 +&ffac +Nanfac:NaN +-1:NaN +0:1 +1:1 +2:2 +3:6 +4:24 +5:120 +6:720 +10:3628800 +11:39916800 +12:479001600 +&fsqrt ++0:0 +-1:NaN +-2:NaN +-16:NaN +-123.45:NaN +nanfsqrt:NaN ++inf:inf +-inf:NaN +1:1 +2:1.41421356237309504880168872420969807857 +4:2 +9:3 +16:4 +100:10 +123.456:11.11107555549866648462149404118219234119 +15241.38393:123.4559999756998444766131352122991626468 +1.44:1.2 +# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 +1.44E10:120000 +2e10:141421.356237309504880168872420969807857 +144e20:120000000000 +# proved to be an endless loop under 7-9 +12:3.464101615137754587054892683011744733886 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_positive +0:1 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +&parts +0:0 1 +1:1 0 +123:123 0 +-123:-123 0 +-1200:-12 2 +NaNparts:NaN NaN ++inf:inf inf +-inf:-inf inf +&exponent +0:1 +1:0 +123:0 +-123:0 +-1200:2 ++inf:inf +-inf:inf +NaNexponent:NaN +&mantissa +0:0 +1:1 +123:123 +-123:-123 +-1200:-12 ++inf:inf +-inf:-inf +NaNmantissa:NaN +&length +123:3 +-123:3 +0:1 +1:1 +12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/lib/Math/BigRat/t/bigfltrt.t b/lib/Math/BigRat/t/bigfltrt.t new file mode 100755 index 0000000..2b049e2 --- /dev/null +++ b/lib/Math/BigRat/t/bigfltrt.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/bigfltrt.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../lib lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + +# plan tests => 1585; + plan tests => 1; + } + +#use Math::BigInt; +#use Math::BigRat; +use Math::BigRat::Test; # test via this + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat::Test"; +$CL = "Math::BigInt::Calc"; + +ok (1,1); + +# does not fully work yet +# require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t new file mode 100755 index 0000000..380f2e7 --- /dev/null +++ b/lib/Math/BigRat/t/bigrat.t @@ -0,0 +1,79 @@ +#!/usr/bin/perl -w + +use strict; +use Test; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; # for running manually + plan tests => 36; + } + +# testing of Math::BigRat + +use Math::BigRat; + +my ($x,$y,$z); + +$x = Math::BigRat->new(1234); ok ($x,1234); +$x = Math::BigRat->new('1234/1'); ok ($x,1234); +$x = Math::BigRat->new('1234/2'); ok ($x,617); + +$x = Math::BigRat->new('100/1.0'); ok ($x,100); +$x = Math::BigRat->new('10.0/1.0'); ok ($x,10); +$x = Math::BigRat->new('0.1/10'); ok ($x,'1/100'); +$x = Math::BigRat->new('0.1/0.1'); ok ($x,'1'); +$x = Math::BigRat->new('1e2/10'); ok ($x,10); +$x = Math::BigRat->new('1e2/1e1'); ok ($x,10); +$x = Math::BigRat->new('1 / 3'); ok ($x,'1/3'); +$x = Math::BigRat->new('-1 / 3'); ok ($x,'-1/3'); +$x = Math::BigRat->new('NaN'); ok ($x,'NaN'); +$x = Math::BigRat->new('inf'); ok ($x,'inf'); +$x = Math::BigRat->new('-inf'); ok ($x,'-inf'); +$x = Math::BigRat->new('1/'); ok ($x,'NaN'); + +$x = Math::BigRat->new('1/4'); $y = Math::BigRat->new('1/3'); +ok ($x + $y, '7/12'); +ok ($x * $y, '1/12'); +ok ($x / $y, '3/4'); + +$x = Math::BigRat->new('7/5'); $x *= '3/2'; +ok ($x,'21/10'); +$x -= '0.1'; +ok ($x,'2'); # not 21/10 + +$x = Math::BigRat->new('2/3'); $y = Math::BigRat->new('3/2'); +ok ($x > $y,''); +ok ($x < $y,1); +ok ($x == $y,''); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('3/2'); +ok ($x > $y,''); +ok ($x < $y,'1'); +ok ($x == $y,''); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('-2/3'); +ok ($x > $y,''); +ok ($x < $y,''); +ok ($x == $y,'1'); + +$x = Math::BigRat->new('-2/3'); $y = Math::BigRat->new('-1/3'); +ok ($x > $y,''); +ok ($x < $y,'1'); +ok ($x == $y,''); + +$x = Math::BigRat->new('-124'); $y = Math::BigRat->new('-122'); +ok ($x->bacmp($y),1); + +$x = Math::BigRat->new('-124'); $y = Math::BigRat->new('-122'); +ok ($x->bcmp($y),-1); + +$x = Math::BigRat->new('-144/9'); $x->bsqrt(); ok ($x,'NaN'); +$x = Math::BigRat->new('144/9'); $x->bsqrt(); ok ($x,'4'); + +# done + +1; + diff --git a/lib/Math/BigRat/t/bigratpm.inc b/lib/Math/BigRat/t/bigratpm.inc new file mode 100644 index 0000000..bbec697 --- /dev/null +++ b/lib/Math/BigRat/t/bigratpm.inc @@ -0,0 +1,642 @@ +#include this file into another test for subclass testing... + +ok ($class->config()->{lib},$CL); + +while () + { + chop; + $_ =~ s/#.*$//; # remove comments + $_ =~ s/\s+$//; # trailing spaces + next if /^$/; # skip empty lines & comments + if (s/^&//) + { + $f = $_; + } + elsif (/^\$/) + { + $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale + #print "\$setup== $setup\n"; + } + else + { + if (m|^(.*?):(/.+)$|) + { + $ans = $2; + @args = split(/:/,$1,99); + } + else + { + @args = split(/:/,$_,99); $ans = pop(@args); + } + $try = "\$x = new $class \"$args[0]\";"; + if ($f eq "bnorm") + { + $try .= "\$x;"; + } elsif ($f eq "finf") { + $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "is_inf") { + $try .= "\$x->is_inf('$args[1]');"; + } elsif ($f eq "fone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "fstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; + } elsif ($f eq "parts") { + # ->bstr() to see if an object is returned + $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; + $try .= '"$a $b";'; + } elsif ($f eq "numerator") { + # ->bstr() to see if an object is returned + $try .= '$x->numerator()->bstr();'; + } elsif ($f eq "denominator") { + # ->bstr() to see if an object is returned + $try .= '$x->denominator()->bstr();'; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "length") { + $try .= "\$x->length();"; + # some unary ops (test the fxxx form, since that is done by AUTOLOAD) + } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { + $try .= "\$x->b$1();"; + # some is_xxx test function + } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { + $try .= "\$x->$f();"; + } elsif ($f eq "as_number") { + $try .= '$x->as_number();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; + }elsif ($f eq "fround") { + $try .= "$setup; \$x->bround($args[1]);"; + } elsif ($f eq "ffround") { + $try .= "$setup; \$x->bfround($args[1]);"; + } elsif ($f eq "fsqrt") { + $try .= "$setup; \$x->bsqrt();"; + } elsif ($f eq "flog") { + $try .= "$setup; \$x->blog();"; + } elsif ($f eq "ffac") { + $try .= "$setup; \$x->bfac();"; + } + else + { + $try .= "\$y = new $class \"$args[1]\";"; + if ($f eq "fcmp") { + $try .= '$x <=> $y;'; + } elsif ($f eq "facmp") { + $try .= '$x->bacmp($y);'; + } elsif ($f eq "bpow") { + $try .= '$x ** $y;'; + } elsif ($f eq "badd") { + $try .= '$x + $y;'; + } elsif ($f eq "bsub") { + $try .= '$x - $y;'; + } elsif ($f eq "bmul") { + $try .= '$x * $y;'; + } elsif ($f eq "bdiv") { + $try .= "$setup; \$x / \$y;"; + } elsif ($f eq "fdiv-list") { + $try .= "$setup; join(',',\$x->bdiv(\$y));"; + } elsif ($f eq "brsft") { + $try .= '$x >> $y;'; + } elsif ($f eq "blsft") { + $try .= '$x << $y;'; + } elsif ($f eq "bmod") { + $try .= '$x % $y;'; + } else { warn "Unknown op '$f'"; } + } + # print "# Trying: '$try'\n"; + $ans1 = eval $try; + if ($ans =~ m|^/(.*)$|) + { + my $pat = $1; + if ($ans1 =~ /$pat/) + { + ok (1,1); + } + else + { + print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0); + } + } + else + { + if ($ans eq "") + { + ok_undef ($ans1); + } + else + { + print "# Tried: '$try'\n" if !ok ($ans1, $ans); +# if (ref($ans1) eq "$class") +# { +# # float numbers are normalized (for now), so mantissa shouldn't have +# # trailing zeros +# #print $ans1->_trailing_zeros(),"\n"; +# print "# Has trailing zeros after '$try'\n" +# if !ok ($ans1->{_m}->_trailing_zeros(), 0); +# } + } + } # end pattern or string + } + } # end while + +# check whether $class->new( Math::BigInt->new()) destroys it +# ($y == 12 in this case) +$x = Math::BigInt->new(1200); $y = $class->new($x); +ok ($y,1200); ok ($x,1200); + +############################################################################### +# zero,inf,one,nan + +$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->binf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->bone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); +$x = $class->new(2); $x->bnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +1; # all done + +############################################################################### +# Perl 5.005 does not like ok ($x,undef) + +sub ok_undef + { + my $x = shift; + + ok (1,1) and return if !defined $x; + ok ($x,'undef'); + } + +__DATA__ +&finf +1:+:inf +2:-:-inf +3:abc:inf +#&numify +#0:0e+1 +#+1:1e+0 +#1234:1234e+0 +#NaN:NaN +#+inf:inf +#-inf:-inf +&fnan +abc:NaN +2:NaN +-2:NaN +0:NaN +&fone +2:+:1 +-2:-:-1 +-2:+:1 +2:-:-1 +0::1 +-2::1 +abc::1 +2:abc:1 +&fsstr ++inf:inf +-inf:-inf +abcfsstr:NaN +1:1/1 +3/1:3/1 +0.1:1/10 +&bnorm +1:1 +-0:0 +bnormNaN:NaN ++inf:inf +-inf:-inf +123:123 +-123.4567:-1234567/10000 +# invalid inputs +1__2:NaN +1E1__2:NaN +11__2E2:NaN +#1.E3:NaN +.2E-3.:NaN +#1e3e4:NaN +.2E2:20 +inf:inf ++inf:inf +-inf:-inf ++infinity:NaN ++-inf:NaN +abc:NaN + 1 a:NaN +1bcd2:NaN +11111b:NaN ++1z:NaN +-1z:NaN +0:0 ++0:0 ++00:0 ++0_0_0:0 +000000_0000000_00000:0 +-0:0 +-0000:0 ++1:1 ++01:1 ++001:1 ++00000100000:100000 +123456789:123456789 +-1:-1 +-01:-1 +-001:-1 +-123456789:-123456789 +-00000100000:-100000 +123.456a:NaN +123.456:15432/125 +0.01:1/100 +.002:1/500 ++.2:1/5 +-0.0003:-3/10000 +-.0000000004:-1/2500000000 +123456E2:12345600 +123456E-2:30864/25 +-123456E2:-12345600 +-123456E-2:-30864/25 +1e1:10 +2e-11:1/50000000000 +12/10:6/5 +0.1/0.1:1 +100/0.1:1000 +0.1/10:1/100 +1 / 3:1/3 +1/ 3:1/3 +1 /3:1/3 +&fneg +fnegNaN:NaN ++inf:-inf +-inf:inf ++0:0 ++1:-1 +-1:1 ++123456789:-123456789 +-123456789:123456789 ++123.456789:-123456789/1000000 +-123456.789:123456789/1000 +&fabs +fabsNaN:NaN ++inf:inf +-inf:inf ++0:0 ++1:1 +-1:1 ++123456789:123456789 +-123456789:123456789 ++123.456789:123456789/1000000 +-123456.789:123456789/1000 +&badd +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:NaN +-inf:+inf:NaN ++inf:+inf:inf +-inf:-inf:-inf +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:1 ++1:+1:2 +-1:+0:-1 ++0:-1:-1 +-1:-1:-2 +-1:+1:0 ++1:-1:0 ++9:+1:10 ++99:+1:100 ++999:+1:1000 ++9999:+1:10000 ++99999:+1:100000 ++999999:+1:1000000 ++9999999:+1:10000000 ++99999999:+1:100000000 ++999999999:+1:1000000000 ++9999999999:+1:10000000000 ++99999999999:+1:100000000000 ++10:-1:9 ++100:-1:99 ++1000:-1:999 ++10000:-1:9999 ++100000:-1:99999 ++1000000:-1:999999 ++10000000:-1:9999999 ++100000000:-1:99999999 ++1000000000:-1:999999999 ++10000000000:-1:9999999999 ++123456789:+987654321:1111111110 +-123456789:+987654321:864197532 +-123456789:-987654321:-1111111110 ++123456789:-987654321:-864197532 +1/3:1/3:2/3 +2/3:-1/3:1/3 +&bsub +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:NaN +-inf:-inf:NaN +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN ++0:+0:0 ++1:+0:1 ++0:+1:-1 ++1:+1:0 +-1:+0:-1 ++0:-1:1 +-1:-1:0 +-1:+1:-2 ++1:-1:2 ++9:+1:8 ++99:+1:98 ++999:+1:998 ++9999:+1:9998 ++99999:+1:99998 ++999999:+1:999998 ++9999999:+1:9999998 ++99999999:+1:99999998 ++999999999:+1:999999998 ++9999999999:+1:9999999998 ++99999999999:+1:99999999998 ++10:-1:11 ++100:-1:101 ++1000:-1:1001 ++10000:-1:10001 ++100000:-1:100001 ++1000000:-1:1000001 ++10000000:-1:10000001 ++100000000:-1:100000001 ++1000000000:-1:1000000001 ++10000000000:-1:10000000001 ++123456789:+987654321:-864197532 +-123456789:+987654321:-1111111110 +-123456789:-987654321:864197532 ++123456789:-987654321:1111111110 +2/3:1/3:1/3 +7/27:3/54:11/54 +-2/3:+2/3:-4/3 +-2/3:-2/3:0 +&bmul +abc:abc:NaN +abc:+0:NaN ++0:abc:NaN ++inf:NaNmul:NaN ++inf:NaNmul:NaN +NaNmul:+inf:NaN +NaNmul:-inf:NaN ++inf:+inf:inf ++inf:-inf:-inf ++inf:-inf:-inf ++inf:+inf:inf ++inf:123.34:inf ++inf:-123.34:-inf +-inf:123.34:-inf +-inf:-123.34:inf +123.34:+inf:inf +-123.34:+inf:-inf +123.34:-inf:-inf +-123.34:-inf:inf ++0:+0:0 ++0:+1:0 ++1:+0:0 ++0:-1:0 +-1:+0:0 ++123456789123456789:+0:0 ++0:+123456789123456789:0 +-1:-1:1 +-1:+1:-1 ++1:-1:-1 ++1:+1:1 ++2:+3:6 +-2:+3:-6 ++2:-3:-6 +-2:-3:6 ++111:+111:12321 ++10101:+10101:102030201 ++1001001:+1001001:1002003002001 ++100010001:+100010001:10002000300020001 ++10000100001:+10000100001:100002000030000200001 ++11111111111:+9:99999999999 ++22222222222:+9:199999999998 ++33333333333:+9:299999999997 ++44444444444:+9:399999999996 ++55555555555:+9:499999999995 ++66666666666:+9:599999999994 ++77777777777:+9:699999999993 ++88888888888:+9:799999999992 ++99999999999:+9:899999999991 +6:120:720 +10:10000:100000 +1/4:1/3:1/12 +&bdiv +$div_scale = 40; $round_mode = 'even' +abc:abc:NaN +abc:+1:abc:NaN ++1:abc:NaN +-1:abc:NaN +0:abc:NaN ++0:+0:NaN ++0:+1:0 ++1:+0:inf ++3214:+0:inf ++0:-1:0 +-1:+0:-inf +-3214:+0:-inf ++1:+1:1 +-1:-1:1 ++1:-1:-1 +-1:+1:-1 ++1:+2:1/2 ++2:+1:2 +123:+inf:0 +123:-inf:0 ++10:+5:2 ++100:+4:25 ++1000:+8:125 ++10000:+16:625 ++10000:-16:-625 ++999999999999:+9:111111111111 ++999999999999:+99:10101010101 ++999999999999:+999:1001001001 ++999999999999:+9999:100010001 ++999999999999999:+99999:10000100001 ++1000000000:+9:1000000000/9 ++2000000000:+9:2000000000/9 ++3000000000:+9:1000000000/3 ++4000000000:+9:4000000000/9 ++5000000000:+9:5000000000/9 ++6000000000:+9:2000000000/3 ++7000000000:+9:7000000000/9 ++8000000000:+9:8000000000/9 ++9000000000:+9:1000000000 ++35500000:+113:35500000/113 ++71000000:+226:35500000/113 ++106500000:+339:35500000/113 ++1000000000:+3:1000000000/3 +2:25.024996000799840031993601279744051189762:1000000000000000000000000000000000000000/12512498000399920015996800639872025594881 +123456:1:123456 +1/4:1/3:3/4 +# reset scale for further tests +$div_scale = 40 +&is_nan +123:0 +abc:1 +NaN:1 +-123:0 +&is_inf ++inf::1 +-inf::1 +abc::0 +1::0 +NaN::0 +-1::0 ++inf:-:0 ++inf:+:1 +-inf:-:1 +-inf:+:0 +# it must be exactly /^[+-]inf$/ ++infinity::0 +-infinity::0 +&is_odd +abc:0 +0:0 +-1:1 +-3:1 +1:1 +3:1 +1000001:1 +1000002:0 ++inf:0 +-inf:0 +123.45:0 +-123.45:0 +2:0 +&is_int +NaNis_int:0 +0:1 +1:1 +2:1 +-2:1 +-1:1 +-inf:0 ++inf:0 +123.4567:0 +-0.1:0 +-0.002:0 +1/3:0 +3/1:1 +&is_even +abc:0 +0:1 +-1:0 +-3:0 +1:0 +3:0 +1000001:0 +1000002:1 +2:1 ++inf:0 +-inf:0 +123.456:0 +-123.456:0 +0.01:0 +-0.01:0 +120:1 +1200:1 +-1200:1 +&is_positive +0:1 +1:1 +-1:0 +-123:0 +NaN:0 +-inf:0 ++inf:1 +&is_negative +0:0 +1:0 +-1:1 +-123:1 +NaN:0 +-inf:1 ++inf:0 +#&parts +#0:0 1 +#1:1 0 +#123:123 0 +#-123:-123 0 +#-1200:-12 2 +#NaNparts:NaN NaN +#+inf:inf inf +#-inf:-inf inf +#&exponent +#0:1 +#1:0 +#123:0 +#-123:0 +#-1200:2 +#+inf:inf +#-inf:inf +#NaNexponent:NaN +#&mantissa +#0:0 +#1:1 +#123:123 +#-123:-123 +#-1200:-12 +#+inf:inf +#-inf:-inf +#NaNmantissa:NaN +#&length +#123:3 +#-123:3 +#0:1 +#1:1 +#12345678901234567890:20 +&is_zero +NaNzero:0 ++inf:0 +-inf:0 +0:1 +-1:0 +1:0 +0/3:1 +1/3:0 +&is_one +NaNone:0 ++inf:0 +-inf:0 +0:0 +2:0 +1:1 +-1:0 +-2:0 +1/3:0 +100/100:1 +0.1/0.1:1 +&ffloor +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-52 +12.2:12 +&fceil +0:0 +abc:NaN ++inf:inf +-inf:-inf +1:1 +-51:-51 +-51.2:-51 +12.2:13 diff --git a/lib/Math/BigRat/t/bigratpm.t b/lib/Math/BigRat/t/bigratpm.t new file mode 100755 index 0000000..a4d8ed9 --- /dev/null +++ b/lib/Math/BigRat/t/bigratpm.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/bigratpm.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../lib); + } + unshift @INC, '../lib'; + if (-d 't') + { + chdir 't'; + require File::Spec; + unshift @INC, File::Spec->catdir(File::Spec->updir, $location); + } + else + { + unshift @INC, $location; + } + print "# INC = @INC\n"; + + plan tests => 414; + } + +#use Math::BigInt; +use Math::BigRat; + +use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); +$class = "Math::BigRat"; +$CL = "Math::BigInt::Calc"; + +require 'bigratpm.inc'; # all tests here for sharing diff --git a/t/lib/Math/BigRat/Test.pm b/t/lib/Math/BigRat/Test.pm new file mode 100644 index 0000000..80be068 --- /dev/null +++ b/t/lib/Math/BigRat/Test.pm @@ -0,0 +1,81 @@ +#!/usr/bin/perl -w + +package Math::BigRat::Test; + +require 5.005_02; +use strict; + +use Exporter; +use Math::BigRat; +use Math::BigFloat; +use vars qw($VERSION @ISA $PACKAGE + $accuracy $precision $round_mode $div_scale); + +@ISA = qw(Exporter Math::BigRat); +$VERSION = 0.03; + +use overload; # inherit overload from BigRat + +# Globals +$accuracy = $precision = undef; +$round_mode = 'even'; +$div_scale = 40; + +my $class = 'Math::BigRat::Test'; + +#ub new +#{ +# my $proto = shift; +# my $class = ref($proto) || $proto; +# +# my $value = shift; +# my $a = $accuracy; $a = $_[0] if defined $_[0]; +# my $p = $precision; $p = $_[1] if defined $_[1]; +# # Store the floating point value +# my $self = Math::BigFloat->new($value,$a,$p,$round_mode); +# bless $self, $class; +# $self->{'_custom'} = 1; # make sure this never goes away +# return $self; +#} + +sub bstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n} if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bstr(); + } + +sub bsstr + { + # calculate a BigFloat compatible string output + my ($x) = @_; + + $x = $class->new($x) unless ref $x; + + if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc + { + my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf + return $s; + } + + my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 + + return $s.$x->{_n}->bsstr() if $x->{_d}->is_one(); + my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); + return $s.$output->bsstr(); + } + +1;