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