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