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