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