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