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