projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / 5.8.0 / Math / BigRat.pm
CommitLineData
86530b38
AT		 1
2#
3# "Tax the rat farms."
4#
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
12# _f : flags, used by MBR to flag parts of a rational as untouchable
13
14package Math::BigRat;
15
16require 5.005_03;
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
27$VERSION = '0.07';
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';
44my $MBI = 'Math::BigInt';
45
46sub isa
47 {
48 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
49 UNIVERSAL::isa(@_);
50 }
51
52sub _new_from_float
53 {
54 # turn a single float input into a rational (like '0.1')
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
63 $self->{_d} = $MBI->bone();
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 }
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
88 # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
89
90 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
91 {
92 if ($n->isa('Math::BigFloat'))
93 {
94 return $self->_new_from_float($n)->bnorm();
95 }
96 if ($n->isa('Math::BigInt'))
97 {
98 $self->{_n} = $n->copy(); # "mantissa" = $n
99 $self->{_d} = $MBI->bone();
100 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
101 return $self->bnorm();
102 }
103 if ($n->isa('Math::BigInt::Lite'))
104 {
105 $self->{_n} = $MBI->new($$n); # "mantissa" = $n
106 $self->{_d} = $MBI->bone();
107 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
108 return $self->bnorm();
109 }
110 }
111 return $n->copy() if ref $n;
112
113 if (!defined $n)
114 {
115 $self->{_n} = $MBI->bzero(); # undef => 0
116 $self->{_d} = $MBI->bone();
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 {
145 $self->{_n} = $MBI->new($n);
146 $self->{_d} = $MBI->new($d);
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 {
161 # work around bug in BigFloat that makes 1.1.2 valid
162 return $self->bnan() if $n =~ /\..*\./;
163 # looks like a float
164 $self->_new_from_float(Math::BigFloat->new($n));
165 }
166 else
167 {
168 $self->{_n} = $MBI->new($n);
169 $self->{_d} = $MBI->bone();
170 $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
171 return $self->bnan() if $self->{sign} eq 'NaN';
172 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
173 }
174 $self->bnorm();
175 }
176
177###############################################################################
178
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
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
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
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
228 # no normalize for NaN, inf etc.
229 return $x if $x->{sign} !~ /^[+-]$/;
230
231 # normalize zeros to 0/1
232 if (($x->{sign} =~ /^[+-]$/) &&
233 ($x->{_n}->is_zero()))
234 {
235 $x->{sign} = '+'; # never -0
236 $x->{_d} = $MBI->bone() unless $x->{_d}->is_one();
237 return $x;
238 }
239
240 return $x if $x->{_d}->is_one(); # no need to reduce
241
242 # reduce other numbers
243 # disable upgrade in BigInt, otherwise deep recursion
244 local $Math::BigInt::upgrade = undef;
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 }
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;
262 $self->{_n} = $MBI->bzero();
263 $self->{_d} = $MBI->bzero();
264 }
265
266sub _binf
267 {
268 # used by parent class bone() to initialize number to 1
269 my $self = shift;
270 $self->{_n} = $MBI->bzero();
271 $self->{_d} = $MBI->bzero();
272 }
273
274sub _bone
275 {
276 # used by parent class bone() to initialize number to 1
277 my $self = shift;
278 $self->{_n} = $MBI->bone();
279 $self->{_d} = $MBI->bone();
280 }
281
282sub _bzero
283 {
284 # used by parent class bone() to initialize number to 1
285 my $self = shift;
286 $self->{_n} = $MBI->bzero();
287 $self->{_d} = $MBI->bone();
288 }
289
290##############################################################################
291# mul/add/div etc
292
293sub badd
294 {
295 # add two rationals
296 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
297
298 $x = $self->new($x) unless $x->isa($self);
299 $y = $self->new($y) unless $y->isa($self);
300
301 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
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 {
330 # subtract two rationals
331 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
332
333 $x = $class->new($x) unless $x->isa($class);
334 $y = $class->new($y) unless $y->isa($class);
335
336 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
337 # TODO: inf handling
338
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 {
366 # multiply two rationals
367 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
368
369 $x = $class->new($x) unless $x->isa($class);
370 $y = $class->new($y) unless $y->isa($class);
371
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
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
410 $x = $class->new($x) unless $x->isa($class);
411 $y = $class->new($y) unless $y->isa($class);
412
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
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);
431 $x;
432 }
433
434##############################################################################
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##############################################################################
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,@_);
560
561 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
562
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
571 return $MBI->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
572 $x->{_d}->copy();
573 }
574
575sub parts
576 {
577 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
578
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
583 my $n = $x->{_n}->copy();
584 $n->{sign} = $x->{sign};
585 return ($n,$x->{_d}->copy());
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
608 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
609 $x->{_d}->bone();
610 $x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
611 $x->{sign} = '+' if $x->{_n}->is_zero(); # -0 => 0
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
622 $x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
623 $x->{_d}->bone();
624 $x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
625 $x;
626 }
627
628sub bfac
629 {
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();
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
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)
697 my $pow2 = $self->__one();
698 my $y1 = $MBI->new($y->{_n}/$y->{_d})->babs();
699 my $two = $MBI->new(2);
700 while (!$y1->is_one())
701 {
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
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 {
875 # MBI not loaded, or not with "Math::BigInt"
876 $lib .= ",$mbilib" if defined $mbilib;
877
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 }
900
9011;
902
903__END__
904
905=head1 NAME
906
907Math::BigRat - arbitrarily big rationals
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
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()
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
962 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
963
964=head2 numerator()
965
966 $n = $x->numerator();
967
968Returns a copy of the numerator (the part above the line) as signed BigInt.
969
970=head2 denominator()
971
972 $d = $x->denominator();
973
974Returns a copy of the denominator (the part under the line) as positive BigInt.
975
976=head2 parts()
977
978 ($n,$d) = $x->parts();
979
980Return a list consisting of (signed) numerator and (unsigned) denominator as
981BigInts.
982
983=head2 as_number()
984
985Returns a copy of the object as BigInt by truncating it to integer.
986
987=head2 bfac()
988
989 $x->bfac();
990
991Calculates the factorial of $x. For instance:
992
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
995
996Only works for integers for now.
997
998=head2 blog()
999
1000Is not yet implemented.
1001
1002=head2 bround()/round()/bfround()
1003
1004Are not yet implemented.
1005
1006
1007=head1 BUGS
1008
1009Some things are not yet implemented, or only implemented half-way.
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
Full OpenSPARC design & verification tarball including full HDL.