Math::BigRat 0.22

Message-Id: <200804072127.38258@bloodgate.com>

p4raw-id: //depot/perl@33666

diff --git a/MANIFEST b/MANIFEST
index da1de82..fc4aa65 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2127,6 +2127,7 @@ lib/Math/BigRat/t/bigratpm.t              Math::BigRat test
 lib/Math/BigRat/t/bigrat.t             Math::BigRat test
 lib/Math/BigRat/t/bigratup.t   test under $Math::BigInt::upgrade
 lib/Math/BigRat/t/bigroot.t            Math::BigRat test
+lib/Math/BigRat/t/hang.t               Math::BigRat test for bug #34584 - hang in exp()
 lib/Math/BigRat/t/requirer.t   see if require works properly
 lib/Math/BigRat/t/trap.t       see if trap_nan and trap_inf work
 lib/Math/Complex.pm            A Complex package

diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm
index 9e2e62d..6d77f98 100644 (file)
--- a/lib/Math/BigRat.pm
+++ b/lib/Math/BigRat.pm
@@ -23,7 +23,7 @@ use vars qw($VERSION @ISA $upgrade $downgrade
 
 @ISA = qw(Math::BigFloat);
 
-$VERSION = '0.21';
+$VERSION = '0.22';
 
 use overload;                  # inherit overload from Math::BigFloat
 
@@ -937,6 +937,13 @@ sub bpow
 
   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 
+  # shortcut if y == 1/N (is then sqrt() respective broot())
+  if ($MBI->_is_one($y->{_n}))
+    {
+    return $x->bsqrt(@r) if $MBI->_is_two($y->{_d});   # 1/2 => sqrt
+    return $x->broot($MBI->_str($y->{_d}),@r);         # 1/N => root(N)
+    }
+
   # shortcut y/1 (and/or x/1)
   if ($MBI->_is_one($y->{_d}))
     {
@@ -974,21 +981,18 @@ sub bpow
     return $x->round(@r);
     }
 
-  # regular calculation (this is wrong for d/e ** f/g)
-  my $pow2 = $self->bone();
-  my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
-  my $two = $MBI->_two();
+#  print STDERR "# $x $y\n";
 
-  while (!$MBI->_is_one($y1))
-    {
-    $pow2->bmul($x) if $MBI->_is_odd($y1);
-    $MBI->_div($y1, $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->bnorm()->round(@r);
+  # otherwise:
+
+  #      n/d     n  ______________
+  # a/b       =  -\/  (a/b) ** d
+
+  # (a/b) ** n == (a ** n) / (b ** n)
+  $MBI->_pow($x->{_n}, $y->{_n} );
+  $MBI->_pow($x->{_d}, $y->{_n} );
+
+  return $x->broot($MBI->_str($y->{_d}),@r);           # n/d => root(n)
   }
 
 sub blog
@@ -1020,21 +1024,21 @@ sub blog
 sub bexp
   {
   # set up parameters
-  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+  my ($self,$x,$y,@r) = (ref($_[0]),@_);
 
   # objectify is costly, so avoid it
   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
     {
-    ($self,$x,$y,$a,$p,$r) = objectify(2,$class,@_);
+    ($self,$x,$y,@r) = objectify(2,$class,@_);
     }
 
-  return $x->binf() if $x->{sign} eq '+inf';
-  return $x->bzero() if $x->{sign} eq '-inf';
+  return $x->binf(@r) if $x->{sign} eq '+inf';
+  return $x->bzero(@r) if $x->{sign} eq '-inf';
 
   # we need to limit the accuracy to protect against overflow
   my $fallback = 0;
   my ($scale,@params);
-  ($x,@params) = $x->_find_round_parameters($a,$p,$r);
+  ($x,@params) = $x->_find_round_parameters(@r);
 
   # also takes care of the "error in _find_round_parameters?" case
   return $x if $x->{sign} eq 'NaN';
@@ -1043,11 +1047,11 @@ sub bexp
   if (scalar @params == 0)
     {
     # simulate old behaviour
-    $params[0] = $self->div_scale();    # and round to it as accuracy
-    $params[1] = undef;                 # P = undef
-    $scale = $params[0]+4;              # at least four more for proper round
-    $params[2] = $r;                    # round mode by caller or undef
-    $fallback = 1;                      # to clear a/p afterwards
+    $params[0] = $self->div_scale();   # and round to it as accuracy
+    $params[1] = undef;                        # P = undef
+    $scale = $params[0]+4;             # at least four more for proper round
+    $params[2] = $r[2];                        # round mode by caller or undef
+    $fallback = 1;                     # to clear a/p afterwards
     }
   else
     {
@@ -1165,7 +1169,7 @@ sub _as_float
   if ($a != 0 || !$MBI->_is_one($x->{_d}))
     {
     # n/d
-    return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
+    return scalar Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
     }
   # just n
   Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
@@ -1187,7 +1191,7 @@ sub broot
     }
 
   # do it with floats
-  $x->_new_from_float( $x->_as_float()->broot($y,@r) );
+  $x->_new_from_float( $x->_as_float()->broot($y->_as_float(),@r) )->bnorm()->bround(@r);
   }
 
 sub bmodpow
@@ -1418,6 +1422,28 @@ sub as_number
   $u;
   }
 
+sub as_float
+  {
+  # return N/D as Math::BigFloat
+
+  # set up parameters
+  my ($self,$x,@r) = (ref($_[0]),@_);
+  # objectify is costly, so avoid it
+  ($self,$x,@r) = objectify(1,$class,@_) unless ref $_[0];
+
+  # NaN, inf etc
+  return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
+ 
+  my $u = Math::BigFloat->bzero();
+  $u->{sign} = $x->{sign};
+  # n
+  $u->{_m} = $MBI->_copy($x->{_n});
+  $u->{_e} = $MBI->_zero();
+  $u->bdiv( $MBI->_str($x->{_d}), @r);
+  # return $u
+  $u;
+  }
+
 sub as_bin
   {
   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
@@ -1655,7 +1681,7 @@ BigInts.
 
 Returns the object as a scalar. This will lose some data if the object
 cannot be represented by a normal Perl scalar (integer or float), so
-use as_int() instead.
+use L<as_int()> or L<as_float()> instead.
 
 This routine is automatically used whenever a scalar is required:
 
@@ -1672,6 +1698,19 @@ Returns a copy of the object as BigInt, truncated to an integer.
 
 C<as_number()> is an alias for C<as_int()>.
 
+=head2 as_float()
+
+       $x = Math::BigRat->new('13/7');
+       print $x->as_float(),"\n";              # '1'
+
+       $x = Math::BigRat->new('2/3');
+       print $x->as_float(5),"\n";             # '0.66667'
+
+Returns a copy of the object as BigFloat, preserving the
+accuracy as wanted, or the default of 40 digits.
+
+This method was added in v0.22 of Math::BigRat (April 2008).
+
 =head2 as_hex()
 
        $x = Math::BigRat->new('13');
@@ -1933,6 +1972,10 @@ By passing a reference to a hash you may set the configuration values. This
 works only for values that a marked with a C<RW> above, anything else is
 read-only.
 
+=head2 objectify()
+
+This is an internal routine that turns scalars into objects.
+
 =head1 BUGS
 
 Some things are not yet implemented, or only implemented half-way:
@@ -1969,6 +2012,6 @@ may contain more documentation and examples as well as testcases.
 
 =head1 AUTHORS
 
-(C) by Tels L<http://bloodgate.com/> 2001 - 2007.
+(C) by Tels L<http://bloodgate.com/> 2001 - 2008.
 
 =cut

diff --git a/lib/Math/BigRat/t/biglog.t b/lib/Math/BigRat/t/biglog.t
index d201c41..3002c20 100644 (file)
--- a/lib/Math/BigRat/t/biglog.t
+++ b/lib/Math/BigRat/t/biglog.t
@@ -28,7 +28,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 14;
+  plan tests => 17;
   }
 
 use Math::BigRat;
@@ -66,18 +66,18 @@ is ($cl->new(1)->bexp(),
   '90933395208605785401971970164779391644753259799242' . '/' .
   '33452526613163807108170062053440751665152000000000',
   'bexp(1)');
-#is ($cl->new(2)->bexp(40), $cl->new(1)->bexp(45)->bpow(2,40), 'bexp(2)'); 
+is ($cl->new(2)->bexp(1,40), $cl->new(1)->bexp(1,45)->bpow(2,40), 'bexp(2)'); 
 
-#is ($cl->new("12.5")->bexp(61), $cl->new(1)->bexp(65)->bpow(12.5,61), 'bexp(12.5)'); 
+is ($cl->new("12.5")->bexp(1,61), $cl->new(1)->bexp(1,65)->bpow(12.5,61), 'bexp(12.5)'); 
 
 #############################################################################
 # test bexp() with big values (non-cached)
 
-#is ($cl->new(1)->bexp(100), 
-#  '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427',
-# 'bexp(100)');
+is ($cl->new(1)->bexp(1,100)->as_float(100), 
+  '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427',
+ 'bexp(100)');
 
-is ($cl->new("12.5")->bexp(91), $cl->new(1)->bexp(95)->bpow(12.5,91), 
+is ($cl->new("12.5")->bexp(1,91), $cl->new(1)->bexp(1,95)->bpow(12.5,91), 
   'bexp(12.5) to 91 digits'); 
 
 #############################################################################

diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t
index adab326..d898335 100755 (executable)
--- a/lib/Math/BigRat/t/bigrat.t
+++ b/lib/Math/BigRat/t/bigrat.t
@@ -8,7 +8,7 @@ BEGIN
   $| = 1;
   chdir 't' if -d 't';
   unshift @INC, '../lib'; # for running manually
-  plan tests => 193;
+  plan tests => 198;
   }
 
 # basic testing of Math::BigRat
@@ -197,8 +197,8 @@ $x = $cr->new('1/2');  $z = $x->bpow('3/1'); ok ($x,'1/8');
 $x = $cr->new('1/3');  $z = $x->bpow('4/1'); ok ($x,'1/81');
 $x = $cr->new('2/3');  $z = $x->bpow('4/1'); ok ($x,'16/81');
 
-# XXX todo:
-#$x = $cr->new('2/3');  $z = $x->bpow('5/3'); ok ($x,'32/81 ???');
+$x = $cr->new('2/3');  $z = $x->bpow('5/3'); 
+ok ($x, '31797617848703662994667839220546583581/62500000000000000000000000000000000000');
 
 ##############################################################################
 # bfac
@@ -279,7 +279,7 @@ ok (ref($x->copy()->bmodinv($y)), $cr);
 
 # square root with exact result
 $x = $cr->new('1.44');
-ok ($x->copy()->broot(2), '12/10');
+ok ($x->copy()->broot(2), '6/5');
 ok (ref($x->copy()->broot(2)), $cr);
 
 # log with exact result
@@ -312,6 +312,19 @@ $x = $cr->from_oct('0100');
 ok ($x, '64', 'from_oct');
 
 ##############################################################################
+# as_float()
+
+$x = Math::BigRat->new('1/2'); my $f = $x->as_float();
+
+ok ($x, '1/2', '$x unmodified');
+ok ($f, '0.5', 'as_float(0.5)');
+
+$x = Math::BigRat->new('2/3'); $f = $x->as_float(5);
+
+ok ($x, '2/3', '$x unmodified');
+ok ($f, '0.66667', 'as_float(2/3,5)');
+
+##############################################################################
 # done
 
 1;

diff --git a/lib/Math/BigRat/t/bigroot.t b/lib/Math/BigRat/t/bigroot.t
index 41fee89..5b147e1 100644 (file)
--- a/lib/Math/BigRat/t/bigroot.t
+++ b/lib/Math/BigRat/t/bigroot.t
@@ -34,7 +34,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 4 * 2;
+  plan tests => 8 * 2;
   }
 
 use Math::BigFloat;
@@ -46,11 +46,10 @@ my $c = "Math::BigInt";
 # 2 ** 240 = 
 # 1766847064778384329583297500742918515827483896875618958121606201292619776
 
-# takes way too long
-#test_broot ('2','240', 8, undef,   '1073741824');
-#test_broot ('2','240', 9, undef,   '106528681.3099908308759836475139583940127');
-#test_broot ('2','120', 9, undef,   '10321.27324073880096577298929482324664787');
-#test_broot ('2','120', 17, undef,   '133.3268493632747279600707813049418888729');
+test_broot ('2','240', 8, undef,   '1073741824');
+test_broot ('2','240', 9, undef,   '106528681.3099908308759836475139583940127');
+test_broot ('2','120', 9, undef,   '10321.27324073880096577298929482324664787');
+test_broot ('2','120', 17, undef,   '133.3268493632747279600707813049418888729');
 
 test_broot ('2','120', 8, undef,   '32768');
 test_broot ('2','60', 8, undef,   '181.0193359837561662466161566988413540569');

diff --git a/lib/Math/BigRat/t/hang.t b/lib/Math/BigRat/t/hang.t
new file mode 100644 (file)
index 0000000..5cb2b78
--- /dev/null
+++ b/lib/Math/BigRat/t/hang.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+# test for bug #34584: hang in exp(1/2)
+
+use strict;
+use Test::More;
+
+BEGIN 
+  {
+  $| = 1;
+  chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 1;
+  }
+
+use Math::BigRat;
+
+my $result = Math::BigRat->new('1/2')->bexp();
+
+is ("$result", "9535900335500879457687887524133067574481/5783815921445270815783609372070483523265",
+    "exp(1/2) worked");
+
+##############################################################################
+# done
+
+1;
+