projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
According to Tels our M::BI is _better_ than the 1.64 in CPAN.
[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
7d341013 12# _f : flags, used by MBR to flag parts of a rationale as untouchable
184f15d5 13
14package Math::BigRat;
15
a4e2b1c6 16require 5.005_03;
184f15d5 17use strict;
18
19use Exporter;
20use Math::BigFloat;
21use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
22 $accuracy $precision $round_mode $div_scale);
23
24@ISA = qw(Exporter Math::BigFloat);
25@EXPORT_OK = qw();
26
7d341013 27$VERSION = '0.09';
184f15d5 28
29use overload; # inherit from Math::BigFloat
30
31##############################################################################
32# global constants, flags and accessory
33
34use constant MB_NEVER_ROUND => 0x0001;
35
36$accuracy = $precision = undef;
37$round_mode = 'even';
38$div_scale = 40;
39$upgrade = undef;
40$downgrade = undef;
41
42my $nan = 'NaN';
43my $class = 'Math::BigRat';
6de7f0cc 44my $MBI = 'Math::BigInt';
184f15d5 45
8f675a64 46sub isa
47 {
48 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
49 UNIVERSAL::isa(@_);
50 }
51
184f15d5 52sub _new_from_float
53 {
7d341013 54 # turn a single float input into a rationale (like '0.1')
184f15d5 55 my ($self,$f) = @_;
56
57 return $self->bnan() if $f->is_nan();
58 return $self->binf('-inf') if $f->{sign} eq '-inf';
59 return $self->binf('+inf') if $f->{sign} eq '+inf';
60
184f15d5 61 $self->{_n} = $f->{_m}->copy(); # mantissa
6de7f0cc 62 $self->{_d} = $MBI->bone();
184f15d5 63 $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
64 if ($f->{_e}->{sign} eq '-')
65 {
66 # something like Math::BigRat->new('0.1');
67 $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10
68 }
69 else
70 {
71 # something like Math::BigRat->new('10');
72 # 1 / 1 => 10/1
73 $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
74 }
184f15d5 75 $self;
76 }
77
78sub new
79 {
80 # create a Math::BigRat
81 my $class = shift;
82
83 my ($n,$d) = shift;
84
85 my $self = { }; bless $self,$class;
86
184f15d5 87 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
88
6de7f0cc 89 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
184f15d5 90 {
184f15d5 91 if ($n->isa('Math::BigFloat'))
92 {
184f15d5 93 return $self->_new_from_float($n)->bnorm();
94 }
95 if ($n->isa('Math::BigInt'))
96 {
8f675a64 97 $self->{_n} = $n->copy(); # "mantissa" = $n
6de7f0cc 98 $self->{_d} = $MBI->bone();
8f675a64 99 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
100 return $self->bnorm();
101 }
102 if ($n->isa('Math::BigInt::Lite'))
103 {
7d341013 104 $self->{_n} = $MBI->new($$n,undef,undef); # "mantissa" = $n
6de7f0cc 105 $self->{_d} = $MBI->bone();
184f15d5 106 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
107 return $self->bnorm();
108 }
109 }
110 return $n->copy() if ref $n;
184f15d5 111
112 if (!defined $n)
113 {
7d341013 114 $self->{_n} = $MBI->bzero(); # undef => 0
6de7f0cc 115 $self->{_d} = $MBI->bone();
184f15d5 116 $self->{sign} = '+';
117 return $self->bnorm();
118 }
119 # string input with / delimiter
120 if ($n =~ /\s*\/\s*/)
121 {
122 return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
123 return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
124 ($n,$d) = split (/\//,$n);
125 # try as BigFloats first
126 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
127 {
128 # one of them looks like a float
7d341013 129 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
130 local $Math::BigFloat::accuracy = undef;
131 local $Math::BigFloat::precision = undef;
132 local $Math::BigInt::accuracy = undef;
133 local $Math::BigInt::precision = undef;
184f15d5 134 $self->_new_from_float(Math::BigFloat->new($n));
135 # now correct $self->{_n} due to $n
7d341013 136 my $f = Math::BigFloat->new($d,undef,undef);
184f15d5 137 if ($f->{_e}->{sign} eq '-')
138 {
139 # 10 / 0.1 => 100/1
140 $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
141 }
142 else
143 {
144 $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1
145 }
146 }
147 else
148 {
7d341013 149 # both d and n are (big)ints
150 $self->{_n} = $MBI->new($n,undef,undef);
151 $self->{_d} = $MBI->new($d,undef,undef);
184f15d5 152 return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
153 # inf handling is missing here
154
155 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
156 # if $d is negative, flip sign
157 $self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
158 $self->{_d}->{sign} = '+'; # normalize
159 }
160 return $self->bnorm();
161 }
162
163 # simple string input
164 if (($n =~ /[\.eE]/))
165 {
7d341013 166 # looks like a float, quacks like a float, so probably is a float
167 # Math::BigFloat($n,undef,undef) does not what it is supposed to do, so:
168 local $Math::BigFloat::accuracy = undef;
169 local $Math::BigFloat::precision = undef;
170 local $Math::BigInt::accuracy = undef;
171 local $Math::BigInt::precision = undef;
172 $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
184f15d5 173 }
174 else
175 {
7d341013 176 $self->{_n} = $MBI->new($n,undef,undef);
6de7f0cc 177 $self->{_d} = $MBI->bone();
184f15d5 178 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
a4e2b1c6 179 return $self->bnan() if $self->{sign} eq 'NaN';
180 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
184f15d5 181 }
182 $self->bnorm();
183 }
184
8f675a64 185###############################################################################
186
184f15d5 187sub bstr
188 {
189 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
190
191 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
192 {
193 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
194 return $s;
195 }
196
184f15d5 197 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
198
199 return $s.$x->{_n}->bstr() if $x->{_d}->is_one();
200 return $s.$x->{_n}->bstr() . '/' . $x->{_d}->bstr();
201 }
202
203sub bsstr
204 {
205 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
206
207 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
208 {
209 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
210 return $s;
211 }
212
213 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
7d341013 214 return $s . $x->{_n}->bstr() . '/' . $x->{_d}->bstr();
184f15d5 215 }
216
217sub bnorm
218 {
219 # reduce the number to the shortest form and remember this (so that we
220 # don't reduce again)
221 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
222
6de7f0cc 223 # both parts must be BigInt's
224 die ("n is not $MBI but (".ref($x->{_n}).')')
225 if ref($x->{_n}) ne $MBI;
226 die ("d is not $MBI but (".ref($x->{_d}).')')
227 if ref($x->{_d}) ne $MBI;
228
184f15d5 229 # this is to prevent automatically rounding when MBI's globals are set
230 $x->{_d}->{_f} = MB_NEVER_ROUND;
231 $x->{_n}->{_f} = MB_NEVER_ROUND;
232 # 'forget' that parts were rounded via MBI::bround() in MBF's bfround()
233 $x->{_d}->{_a} = undef; $x->{_n}->{_a} = undef;
234 $x->{_d}->{_p} = undef; $x->{_n}->{_p} = undef;
235
6de7f0cc 236 # no normalize for NaN, inf etc.
237 return $x if $x->{sign} !~ /^[+-]$/;
238
184f15d5 239 # normalize zeros to 0/1
240 if (($x->{sign} =~ /^[+-]$/) &&
241 ($x->{_n}->is_zero()))
242 {
a4e2b1c6 243 $x->{sign} = '+'; # never -0
6de7f0cc 244 $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
184f15d5 245 return $x;
246 }
247
a4e2b1c6 248 return $x if $x->{_d}->is_one(); # no need to reduce
6de7f0cc 249
184f15d5 250 # reduce other numbers
8f675a64 251 # disable upgrade in BigInt, otherwise deep recursion
252 local $Math::BigInt::upgrade = undef;
7d341013 253 local $Math::BigInt::accuracy = undef;
254 local $Math::BigInt::precision = undef;
184f15d5 255 my $gcd = $x->{_n}->bgcd($x->{_d});
256
257 if (!$gcd->is_one())
258 {
259 $x->{_n}->bdiv($gcd);
260 $x->{_d}->bdiv($gcd);
261 }
184f15d5 262 $x;
263 }
264
265##############################################################################
266# special values
267
268sub _bnan
269 {
270 # used by parent class bone() to initialize number to 1
271 my $self = shift;
a4e2b1c6 272 $self->{_n} = $MBI->bzero();
273 $self->{_d} = $MBI->bzero();
184f15d5 274 }
275
276sub _binf
277 {
7d341013 278 # used by parent class bone() to initialize number to +inf/-inf
184f15d5 279 my $self = shift;
a4e2b1c6 280 $self->{_n} = $MBI->bzero();
281 $self->{_d} = $MBI->bzero();
184f15d5 282 }
283
284sub _bone
285 {
7d341013 286 # used by parent class bone() to initialize number to +1/-1
184f15d5 287 my $self = shift;
a4e2b1c6 288 $self->{_n} = $MBI->bone();
289 $self->{_d} = $MBI->bone();
184f15d5 290 }
291
292sub _bzero
293 {
7d341013 294 # used by parent class bone() to initialize number to 0
184f15d5 295 my $self = shift;
a4e2b1c6 296 $self->{_n} = $MBI->bzero();
297 $self->{_d} = $MBI->bone();
184f15d5 298 }
299
300##############################################################################
301# mul/add/div etc
302
303sub badd
304 {
7d341013 305 # add two rationales
306
307 # set up parameters
308 my ($self,$x,$y,@r) = (ref($_[0]),@_);
309 # objectify is costly, so avoid it
310 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
311 {
312 ($self,$x,$y,@r) = objectify(2,@_);
313 }
184f15d5 314
6de7f0cc 315 $x = $self->new($x) unless $x->isa($self);
316 $y = $self->new($y) unless $y->isa($self);
184f15d5 317
8f675a64 318 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
7d341013 319 # TODO: inf handling
184f15d5 320
321 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
322 # - + - = --------- = --
323 # 4 3 4*3 12
324
7d341013 325 # we do not compute the gcd() here, but simple do:
326 # 5 7 5*3 + 7*4 41
327 # - + - = --------- = --
328 # 4 3 4*3 12
329
330 # the gcd() calculation and reducing is then done in bnorm()
184f15d5 331
7d341013 332 local $Math::BigInt::accuracy = undef;
333 local $Math::BigInt::precision = undef;
334
335 $x->{_n}->bmul($y->{_d}); $x->{_n}->{sign} = $x->{sign};
336 my $m = $y->{_n}->copy()->bmul($x->{_d});
184f15d5 337 $m->{sign} = $y->{sign}; # 2/1 - 2/1
338 $x->{_n}->badd($m);
339
340 $x->{_d}->bmul($y->{_d});
341
342 # calculate new sign
343 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
344
7d341013 345 $x->bnorm()->round(@r);
184f15d5 346 }
347
348sub bsub
349 {
7d341013 350 # subtract two rationales
351
352 # set up parameters
353 my ($self,$x,$y,@r) = (ref($_[0]),@_);
354 # objectify is costly, so avoid it
355 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
356 {
357 ($self,$x,$y,@r) = objectify(2,@_);
358 }
184f15d5 359
8f675a64 360 $x = $class->new($x) unless $x->isa($class);
361 $y = $class->new($y) unless $y->isa($class);
362
184f15d5 363 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
364 # TODO: inf handling
365
7d341013 366 # 1 1 gcd(3,4) = 1 1*3 - 1*4 7
367 # - - - = --------- = --
184f15d5 368 # 4 3 4*3 12
7d341013 369
370 # we do not compute the gcd() here, but simple do:
371 # 5 7 5*3 - 7*4 13
372 # - - - = --------- = - --
373 # 4 3 4*3 12
184f15d5 374
7d341013 375 local $Math::BigInt::accuracy = undef;
376 local $Math::BigInt::precision = undef;
184f15d5 377
7d341013 378 $x->{_n}->bmul($y->{_d}); $x->{_n}->{sign} = $x->{sign};
379 my $m = $y->{_n}->copy()->bmul($x->{_d});
184f15d5 380 $m->{sign} = $y->{sign}; # 2/1 - 2/1
381 $x->{_n}->bsub($m);
382
383 $x->{_d}->bmul($y->{_d});
384
385 # calculate new sign
386 $x->{sign} = $x->{_n}->{sign}; $x->{_n}->{sign} = '+';
387
7d341013 388 $x->bnorm()->round(@r);
184f15d5 389 }
390
391sub bmul
392 {
7d341013 393 # multiply two rationales
394
395 # set up parameters
396 my ($self,$x,$y,@r) = (ref($_[0]),@_);
397 # objectify is costly, so avoid it
398 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
399 {
400 ($self,$x,$y,@r) = objectify(2,@_);
401 }
184f15d5 402
8f675a64 403 $x = $class->new($x) unless $x->isa($class);
404 $y = $class->new($y) unless $y->isa($class);
405
184f15d5 406 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
407
408 # inf handling
409 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
410 {
411 return $x->bnan() if $x->is_zero() || $y->is_zero();
412 # result will always be +-inf:
413 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
414 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
415 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
416 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
417 return $x->binf('-');
418 }
419
420 # x== 0 # also: or y == 1 or y == -1
421 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
422
184f15d5 423 # According to Knuth, this can be optimized by doingtwice gcd (for d and n)
424 # and reducing in one step)
425
426 # 1 1 2 1
427 # - * - = - = -
428 # 4 3 12 6
7d341013 429
430 local $Math::BigInt::accuracy = undef;
431 local $Math::BigInt::precision = undef;
184f15d5 432 $x->{_n}->bmul($y->{_n});
433 $x->{_d}->bmul($y->{_d});
434
435 # compute new sign
436 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
437
7d341013 438 $x->bnorm()->round(@r);
184f15d5 439 }
440
441sub bdiv
442 {
443 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
444 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
7d341013 445
446 # set up parameters
447 my ($self,$x,$y,@r) = (ref($_[0]),@_);
448 # objectify is costly, so avoid it
449 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
450 {
451 ($self,$x,$y,@r) = objectify(2,@_);
452 }
184f15d5 453
8f675a64 454 $x = $class->new($x) unless $x->isa($class);
455 $y = $class->new($y) unless $y->isa($class);
456
184f15d5 457 return $self->_div_inf($x,$y)
458 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
459
460 # x== 0 # also: or y == 1 or y == -1
461 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
462
463 # TODO: list context, upgrade
464
184f15d5 465 # 1 1 1 3
466 # - / - == - * -
467 # 4 3 4 1
7d341013 468
469# local $Math::BigInt::accuracy = undef;
470# local $Math::BigInt::precision = undef;
184f15d5 471 $x->{_n}->bmul($y->{_d});
472 $x->{_d}->bmul($y->{_n});
473
474 # compute new sign
475 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
476
7d341013 477 $x->bnorm()->round(@r);
6de7f0cc 478 $x;
184f15d5 479 }
480
481##############################################################################
a4e2b1c6 482# bdec/binc
483
484sub bdec
485 {
486 # decrement value (subtract 1)
487 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
488
489 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
490
491 if ($x->{sign} eq '-')
492 {
493 $x->{_n}->badd($x->{_d}); # -5/2 => -7/2
494 }
495 else
496 {
497 if ($x->{_n}->bacmp($x->{_d}) < 0)
498 {
499 # 1/3 -- => -2/3
500 $x->{_n} = $x->{_d} - $x->{_n};
501 $x->{sign} = '-';
502 }
503 else
504 {
505 $x->{_n}->bsub($x->{_d}); # 5/2 => 3/2
506 }
507 }
508 $x->bnorm()->round(@r);
a4e2b1c6 509 }
510
511sub binc
512 {
513 # increment value (add 1)
514 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
515
516 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
517
518 if ($x->{sign} eq '-')
519 {
520 if ($x->{_n}->bacmp($x->{_d}) < 0)
521 {
522 # -1/3 ++ => 2/3 (overflow at 0)
523 $x->{_n} = $x->{_d} - $x->{_n};
524 $x->{sign} = '+';
525 }
526 else
527 {
528 $x->{_n}->bsub($x->{_d}); # -5/2 => -3/2
529 }
530 }
531 else
532 {
533 $x->{_n}->badd($x->{_d}); # 5/2 => 7/2
534 }
535 $x->bnorm()->round(@r);
a4e2b1c6 536 }
537
538##############################################################################
184f15d5 539# is_foo methods (the rest is inherited)
540
541sub is_int
542 {
543 # return true if arg (BRAT or num_str) is an integer
544 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
545
546 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
7d341013 547 $x->{_d}->is_one(); # x/y && y != 1 => no integer
184f15d5 548 0;
549 }
550
551sub is_zero
552 {
553 # return true if arg (BRAT or num_str) is zero
554 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
555
556 return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
557 0;
558 }
559
560sub is_one
561 {
562 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
563 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
564
565 my $sign = shift || ''; $sign = '+' if $sign ne '-';
566 return 1
567 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
568 0;
569 }
570
571sub is_odd
572 {
573 # return true if arg (BFLOAT or num_str) is odd or false if even
574 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
575
576 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
577 ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
578 0;
579 }
580
581sub is_even
582 {
583 # return true if arg (BINT or num_str) is even or false if odd
584 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
585
586 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
587 return 1 if ($x->{_d}->is_one() # x/3 is never
588 && $x->{_n}->is_even()); # but 4/1 is
589 0;
590 }
591
592BEGIN
593 {
594 *objectify = \&Math::BigInt::objectify;
595 }
596
597##############################################################################
598# parts() and friends
599
600sub numerator
601 {
602 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
a4e2b1c6 603
604 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
605
184f15d5 606 my $n = $x->{_n}->copy(); $n->{sign} = $x->{sign};
607 $n;
608 }
609
610sub denominator
611 {
612 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
613
a4e2b1c6 614 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
184f15d5 615 $x->{_d}->copy();
616 }
617
618sub parts
619 {
620 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
621
a4e2b1c6 622 return ($self->bnan(),$self->bnan()) if $x->{sign} eq 'NaN';
623 return ($self->binf(),$self->binf()) if $x->{sign} eq '+inf';
624 return ($self->binf('-'),$self->binf()) if $x->{sign} eq '-inf';
625
184f15d5 626 my $n = $x->{_n}->copy();
627 $n->{sign} = $x->{sign};
a4e2b1c6 628 return ($n,$x->{_d}->copy());
184f15d5 629 }
630
631sub length
632 {
633 return 0;
634 }
635
636sub digit
637 {
638 return 0;
639 }
640
641##############################################################################
642# special calc routines
643
644sub bceil
645 {
646 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
647
648 return $x unless $x->{sign} =~ /^[+-]$/;
649 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
650
a4e2b1c6 651 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
184f15d5 652 $x->{_d}->bone();
653 $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
a4e2b1c6 654 $x->{sign} = '+' if $x->{_n}->is_zero(); # -0 => 0
184f15d5 655 $x;
656 }
657
658sub bfloor
659 {
660 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
661
662 return $x unless $x->{sign} =~ /^[+-]$/;
663 return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
664
a4e2b1c6 665 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
184f15d5 666 $x->{_d}->bone();
667 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
668 $x;
669 }
670
671sub bfac
672 {
a4e2b1c6 673 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
674
675 if (($x->{sign} eq '+') && ($x->{_d}->is_one()))
676 {
677 $x->{_n}->bfac();
678 return $x->round(@r);
679 }
680 $x->bnan();
184f15d5 681 }
682
683sub bpow
684 {
7d341013 685 # power ($x ** $y)
686
687 # set up parameters
688 my ($self,$x,$y,@r) = (ref($_[0]),@_);
689 # objectify is costly, so avoid it
690 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
691 {
692 ($self,$x,$y,@r) = objectify(2,@_);
693 }
184f15d5 694
695 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
696 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
697 return $x->bone(@r) if $y->is_zero();
698 return $x->round(@r) if $x->is_one() || $y->is_one();
699 if ($x->{sign} eq '-' && $x->{_n}->is_one() && $x->{_d}->is_one())
700 {
701 # if $x == -1 and odd/even y => +1/-1
702 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
703 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
704 }
705 # 1 ** -y => 1 / (1 ** |y|)
706 # so do test for negative $y after above's clause
707 # return $x->bnan() if $y->{sign} eq '-';
708 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
709
a4e2b1c6 710 # shortcut y/1 (and/or x/1)
711 if ($y->{_d}->is_one())
712 {
713 # shortcut for x/1 and y/1
714 if ($x->{_d}->is_one())
715 {
716 $x->{_n}->bpow($y->{_n}); # x/1 ** y/1 => (x ** y)/1
717 if ($y->{sign} eq '-')
718 {
719 # 0.2 ** -3 => 1/(0.2 ** 3)
720 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
721 }
722 # correct sign; + ** + => +
723 if ($x->{sign} eq '-')
724 {
725 # - * - => +, - * - * - => -
726 $x->{sign} = '+' if $y->{_n}->is_even();
727 }
728 return $x->round(@r);
729 }
730 # x/z ** y/1
731 $x->{_n}->bpow($y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
732 $x->{_d}->bpow($y->{_n});
733 if ($y->{sign} eq '-')
734 {
735 # 0.2 ** -3 => 1/(0.2 ** 3)
736 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
737 }
738 # correct sign; + ** + => +
739 if ($x->{sign} eq '-')
740 {
741 # - * - => +, - * - * - => -
742 $x->{sign} = '+' if $y->{_n}->is_even();
743 }
744 return $x->round(@r);
745 }
746
747 # regular calculation (this is wrong for d/e ** f/g)
184f15d5 748 my $pow2 = $self->__one();
a4e2b1c6 749 my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
750 my $two = $MBI->new(2);
184f15d5 751 while (!$y1->is_one())
752 {
184f15d5 753 $pow2->bmul($x) if $y1->is_odd();
754 $y1->bdiv($two);
755 $x->bmul($x);
756 }
757 $x->bmul($pow2) unless $pow2->is_one();
758 # n ** -x => 1/n ** x
759 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
7d341013 760 $x->bnorm()->round(@r);
184f15d5 761 }
762
763sub blog
764 {
765 return Math::BigRat->bnan();
766 }
767
768sub bsqrt
769 {
770 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
771
772 return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc
773 $x->{_d}->bsqrt($a,$p,$r);
774 $x->{_n}->bsqrt($a,$p,$r);
775 $x->bnorm();
776 }
777
778sub blsft
779 {
780 my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
781
782 $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
783 $x;
784 }
785
786sub brsft
787 {
788 my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
789
790 $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
791 $x;
792 }
793
794##############################################################################
795# round
796
797sub round
798 {
799 $_[0];
800 }
801
802sub bround
803 {
804 $_[0];
805 }
806
807sub bfround
808 {
809 $_[0];
810 }
811
812##############################################################################
813# comparing
814
815sub bcmp
816 {
817 my ($self,$x,$y) = objectify(2,@_);
818
819 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
820 {
821 # handle +-inf and NaN
822 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
823 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
824 return +1 if $x->{sign} eq '+inf';
825 return -1 if $x->{sign} eq '-inf';
826 return -1 if $y->{sign} eq '+inf';
827 return +1;
828 }
829 # check sign for speed first
830 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
831 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
832
833 # shortcut
834 my $xz = $x->{_n}->is_zero();
835 my $yz = $y->{_n}->is_zero();
836 return 0 if $xz && $yz; # 0 <=> 0
837 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
838 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
839
840 my $t = $x->{_n} * $y->{_d}; $t->{sign} = $x->{sign};
841 my $u = $y->{_n} * $x->{_d}; $u->{sign} = $y->{sign};
842 $t->bcmp($u);
843 }
844
845sub bacmp
846 {
847 my ($self,$x,$y) = objectify(2,@_);
848
849 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
850 {
851 # handle +-inf and NaN
852 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
853 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
854 return +1; # inf is always bigger
855 }
856
857 my $t = $x->{_n} * $y->{_d};
858 my $u = $y->{_n} * $x->{_d};
859 $t->bacmp($u);
860 }
861
862##############################################################################
863# output conversation
864
7d341013 865sub numify
866 {
867 # convert 17/8 => float (aka 2.125)
868 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
869
870 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
871
872 my $t = Math::BigFloat->new($x->{_n});
873 $t->bneg() if $x->is_negative();
874 $t->bdiv($x->{_d});
875 $t->numify();
876 }
877
184f15d5 878sub as_number
879 {
880 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
881
882 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
883 my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
884 $t->{sign} = $x->{sign};
885 $t;
886 }
887
6de7f0cc 888sub import
889 {
890 my $self = shift;
891 my $l = scalar @_;
892 my $lib = ''; my @a;
893 for ( my $i = 0; $i < $l ; $i++)
894 {
895# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
896 if ( $_[$i] eq ':constant' )
897 {
898 # this rest causes overlord er load to step in
899 # print "overload @_\n";
900 overload::constant float => sub { $self->new(shift); };
901 }
902# elsif ($_[$i] eq 'upgrade')
903# {
904# # this causes upgrading
905# $upgrade = $_[$i+1]; # or undef to disable
906# $i++;
907# }
908 elsif ($_[$i] eq 'downgrade')
909 {
910 # this causes downgrading
911 $downgrade = $_[$i+1]; # or undef to disable
912 $i++;
913 }
914 elsif ($_[$i] eq 'lib')
915 {
916 $lib = $_[$i+1] || ''; # default Calc
917 $i++;
918 }
919 elsif ($_[$i] eq 'with')
920 {
921 $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
922 $i++;
923 }
924 else
925 {
926 push @a, $_[$i];
927 }
928 }
929 # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
930 my $mbilib = eval { Math::BigInt->config()->{lib} };
931 if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
932 {
933 # MBI already loaded
934 $MBI->import('lib',"$lib,$mbilib", 'objectify');
935 }
936 else
937 {
a4e2b1c6 938 # MBI not loaded, or not with "Math::BigInt"
6de7f0cc 939 $lib .= ",$mbilib" if defined $mbilib;
940
6de7f0cc 941 if ($] < 5.006)
942 {
943 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
944 # used in the same script, or eval inside import().
945 my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
946 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
947 $file = File::Spec->catfile (@parts, $file);
948 eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
949 }
950 else
951 {
952 my $rc = "use $MBI lib => '$lib', 'objectify';";
953 eval $rc;
954 }
955 }
956 die ("Couldn't load $MBI: $! $@") if $@;
957
958 # any non :constant stuff is handled by our parent, Exporter
959 # even if @_ is empty, to give it a chance
960 $self->SUPER::import(@a); # for subclasses
961 $self->export_to_level(1,$self,@a); # need this, too
962 }
184f15d5 963
9641;
965
966__END__
967
968=head1 NAME
969
7d341013 970Math::BigRat - arbitrarily big rationales
184f15d5 971
972=head1 SYNOPSIS
973
7d341013 974 use Math::BigRat;
184f15d5 975
7d341013 976 $x = Math::BigRat->new('3/7'); $x += '5/9';
184f15d5 977
7d341013 978 print $x->bstr(),"\n";
979 print $x ** 2,"\n";
184f15d5 980
981=head1 DESCRIPTION
982
7d341013 983Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
984for arbitrarily big rationales.
184f15d5 985
986=head2 MATH LIBRARY
987
988Math with the numbers is done (by default) by a module called
989Math::BigInt::Calc. This is equivalent to saying:
990
991 use Math::BigRat lib => 'Calc';
992
993You can change this by using:
994
995 use Math::BigRat lib => 'BitVect';
996
997The following would first try to find Math::BigInt::Foo, then
998Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
999
1000 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1001
1002Calc.pm uses as internal format an array of elements of some decimal base
7d341013 1003(usually 1e7, but this might be different for some systems) with the least
184f15d5 1004significant digit first, while BitVect.pm uses a bit vector of base 2, most
1005significant bit first. Other modules might use even different means of
1006representing the numbers. See the respective module documentation for further
1007details.
1008
7d341013 1009Currently the following replacement libraries exist, search for them at CPAN:
1010
1011 Math::BigInt::BitVect
1012 Math::BigInt::GMP
1013 Math::BigInt::Pari
1014 Math::BigInt::FastCalc
1015
184f15d5 1016=head1 METHODS
1017
7d341013 1018Any methods not listed here are dervied from Math::BigFloat (or
6de7f0cc 1019Math::BigInt), so make sure you check these two modules for further
1020information.
1021
1022=head2 new()
184f15d5 1023
1024 $x = Math::BigRat->new('1/3');
1025
1026Create a new Math::BigRat object. Input can come in various forms:
1027
7d341013 1028 $x = Math::BigRat->new(123); # scalars
1029 $x = Math::BigRat->new('123.3'); # float
184f15d5 1030 $x = Math::BigRat->new('1/3'); # simple string
1031 $x = Math::BigRat->new('1 / 3'); # spaced
1032 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1033 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1034 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
6de7f0cc 1035 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
184f15d5 1036
6de7f0cc 1037=head2 numerator()
184f15d5 1038
1039 $n = $x->numerator();
1040
1041Returns a copy of the numerator (the part above the line) as signed BigInt.
1042
6de7f0cc 1043=head2 denominator()
184f15d5 1044
1045 $d = $x->denominator();
1046
1047Returns a copy of the denominator (the part under the line) as positive BigInt.
1048
6de7f0cc 1049=head2 parts()
184f15d5 1050
1051 ($n,$d) = $x->parts();
1052
1053Return a list consisting of (signed) numerator and (unsigned) denominator as
1054BigInts.
1055
6de7f0cc 1056=head2 as_number()
1057
7d341013 1058 $x = Math::BigRat->new('13/7');
1059 print $x->as_number(),"\n"; # '1'
1060
6de7f0cc 1061Returns a copy of the object as BigInt by truncating it to integer.
1062
a4e2b1c6 1063=head2 bfac()
6de7f0cc 1064
a4e2b1c6 1065 $x->bfac();
6de7f0cc 1066
a4e2b1c6 1067Calculates the factorial of $x. For instance:
6de7f0cc 1068
a4e2b1c6 1069 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1070 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
184f15d5 1071
7d341013 1072Works currently only for integers.
6de7f0cc 1073
a4e2b1c6 1074=head2 blog()
6de7f0cc 1075
a4e2b1c6 1076Is not yet implemented.
6de7f0cc 1077
a4e2b1c6 1078=head2 bround()/round()/bfround()
6de7f0cc 1079
a4e2b1c6 1080Are not yet implemented.
6de7f0cc 1081
7d341013 1082=head2 is_one()
1083
1084 print "$x is 1\n" if $x->is_one();
1085
1086Return true if $x is exactly one, otherwise false.
1087
1088=head2 is_zero()
1089
1090 print "$x is 0\n" if $x->is_zero();
1091
1092Return true if $x is exactly zero, otherwise false.
1093
1094=head2 is_positive()
1095
1096 print "$x is >= 0\n" if $x->is_positive();
1097
1098Return true if $x is positive (greater than or equal to zero), otherwise
1099false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1100
1101=head2 is_negative()
1102
1103 print "$x is < 0\n" if $x->is_negative();
1104
1105Return true if $x is negative (smaller than zero), otherwise false. Please
1106note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1107
1108=head2 is_int()
1109
1110 print "$x is an integer\n" if $x->is_int();
1111
1112Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1113false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1114
1115=head2 is_odd()
1116
1117 print "$x is odd\n" if $x->is_odd();
1118
1119Return true if $x is odd, otherwise false.
1120
1121=head2 is_even()
1122
1123 print "$x is even\n" if $x->is_even();
1124
1125Return true if $x is even, otherwise false.
1126
1127=head2 bceil()
1128
1129 $x->bceil();
1130
1131Set $x to the next bigger integer value (e.g. truncate the number to integer
1132and then increment it by one).
1133
1134=head2 bfloor()
1135
1136 $x->bfloor();
1137
1138Truncate $x to an integer value.
6de7f0cc 1139
a4e2b1c6 1140=head1 BUGS
6de7f0cc 1141
7d341013 1142Some things are not yet implemented, or only implemented half-way:
1143
1144=over 2
1145
1146=item inf handling (partial)
1147
1148=item NaN handling (partial)
1149
1150=item rounding (not implemented except for bceil/bfloor)
1151
1152=item $x ** $y where $y is not an integer
1153
1154=back
184f15d5 1155
1156=head1 LICENSE
1157
1158This program is free software; you may redistribute it and/or modify it under
1159the same terms as Perl itself.
1160
1161=head1 SEE ALSO
1162
1163L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1164L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1165
7d341013 1166See L<http://search.cpan.org/search?dist=bignum> for a way to use
1167Math::BigRat.
1168
1169The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1170may contain more documentation and examples as well as testcases.
184f15d5 1171
1172=head1 AUTHORS
1173
1174(C) by Tels L<http://bloodgate.com/> 2001-2002.
1175
1176=cut
Unnamed repository; edit this file to name it for gitweb.