File Coverage

blib/lib/Math/BigRat.pm
Criterion Covered Total %
statement 828 1016 81.5
branch 542 796 68.0
condition 233 393 59.2
subroutine 97 128 75.7
pod 69 70 98.5
total 1769 2403 73.6


line stmt bran cond sub pod time code
1             #
2             # "Tax the rat farms." - Lord Vetinari
3             #
4              
5             # The following hash values are used:
6             # sign : +,-,NaN,+inf,-inf
7             # _d : denominator
8             # _n : numerator (value = _n/_d)
9             # _a : accuracy
10             # _p : precision
11             # You should not look at the innards of a BigRat - use the methods for this.
12              
13             package Math::BigRat;
14              
15 19     19   1191189 use 5.006;
  19         180  
16 19     19   90 use strict;
  19         25  
  19         462  
17 19     19   99 use warnings;
  19         33  
  19         585  
18              
19 19     19   88 use Carp qw< carp croak >;
  19         43  
  19         1022  
20 19     19   127 use Scalar::Util qw< blessed >;
  19         39  
  19         1219  
21              
22 19     19   17784 use Math::BigFloat ();
  19         980858  
  19         24864  
23              
24             our $VERSION = '0.2623';
25              
26             our @ISA = qw(Math::BigFloat);
27              
28             our ($accuracy, $precision, $round_mode, $div_scale,
29             $upgrade, $downgrade, $_trap_nan, $_trap_inf);
30              
31             use overload
32              
33             # overload key: with_assign
34              
35 49     49   317 '+' => sub { $_[0] -> copy() -> badd($_[1]); },
36              
37 53     53   327 '-' => sub { my $c = $_[0] -> copy;
38 53 50       179 $_[2] ? $c -> bneg() -> badd( $_[1])
39             : $c -> bsub($_[1]); },
40              
41 55     55   1017 '*' => sub { $_[0] -> copy() -> bmul($_[1]); },
42              
43 49 50   49   446 '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
44             : $_[0] -> copy() -> bdiv($_[1]); },
45              
46 21 50   21   204 '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
47             : $_[0] -> copy() -> bmod($_[1]); },
48              
49 2 50   2   14 '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
50             : $_[0] -> copy() -> bpow($_[1]); },
51              
52 0 0   0   0 '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
53             : $_[0] -> copy() -> blsft($_[1]); },
54              
55 0 0   0   0 '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
56             : $_[0] -> copy() -> brsft($_[1]); },
57              
58             # overload key: assign
59              
60 0     0   0 '+=' => sub { $_[0]->badd($_[1]); },
61              
62 1     1   401 '-=' => sub { $_[0]->bsub($_[1]); },
63              
64 1     1   10 '*=' => sub { $_[0]->bmul($_[1]); },
65              
66 0     0   0 '/=' => sub { scalar $_[0]->bdiv($_[1]); },
67              
68 0     0   0 '%=' => sub { $_[0]->bmod($_[1]); },
69              
70 0     0   0 '**=' => sub { $_[0]->bpow($_[1]); },
71              
72 0     0   0 '<<=' => sub { $_[0]->blsft($_[1]); },
73              
74 0     0   0 '>>=' => sub { $_[0]->brsft($_[1]); },
75              
76             # 'x=' => sub { },
77              
78             # '.=' => sub { },
79              
80             # overload key: num_comparison
81              
82 24 50   24   106 '<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
83             : $_[0] -> blt($_[1]); },
84              
85 0 0   0   0 '<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
86             : $_[0] -> ble($_[1]); },
87              
88 29 50   29   159 '>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
89             : $_[0] -> bgt($_[1]); },
90              
91 0 0   0   0 '>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
92             : $_[0] -> bge($_[1]); },
93              
94 10     10   196 '==' => sub { $_[0] -> beq($_[1]); },
95              
96 0     0   0 '!=' => sub { $_[0] -> bne($_[1]); },
97              
98             # overload key: 3way_comparison
99              
100 0     0   0 '<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]);
101 0 0 0     0 defined($cmp) && $_[2] ? -$cmp : $cmp; },
102              
103 1791 50   1791   513368 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
104             : $_[0] -> bstr() cmp "$_[1]"; },
105              
106             # overload key: str_comparison
107              
108             # 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
109             # : $_[0] -> bstrlt($_[1]); },
110             #
111             # 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
112             # : $_[0] -> bstrle($_[1]); },
113             #
114             # 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
115             # : $_[0] -> bstrgt($_[1]); },
116             #
117             # 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
118             # : $_[0] -> bstrge($_[1]); },
119             #
120             # 'eq' => sub { $_[0] -> bstreq($_[1]); },
121             #
122             # 'ne' => sub { $_[0] -> bstrne($_[1]); },
123              
124             # overload key: binary
125              
126 289 50   289   29241 '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
127             : $_[0] -> copy() -> band($_[1]); },
128              
129 0     0   0 '&=' => sub { $_[0] -> band($_[1]); },
130              
131 289 50   289   27471 '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
132             : $_[0] -> copy() -> bior($_[1]); },
133              
134 0     0   0 '|=' => sub { $_[0] -> bior($_[1]); },
135              
136 289 50   289   26215 '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
137             : $_[0] -> copy() -> bxor($_[1]); },
138              
139 0     0   0 '^=' => sub { $_[0] -> bxor($_[1]); },
140              
141             # '&.' => sub { },
142              
143             # '&.=' => sub { },
144              
145             # '|.' => sub { },
146              
147             # '|.=' => sub { },
148              
149             # '^.' => sub { },
150              
151             # '^.=' => sub { },
152              
153             # overload key: unary
154              
155 0     0   0 'neg' => sub { $_[0] -> copy() -> bneg(); },
156              
157             # '!' => sub { },
158              
159 0     0   0 '~' => sub { $_[0] -> copy() -> bnot(); },
160              
161             # '~.' => sub { },
162              
163             # overload key: mutators
164              
165 6     6   43 '++' => sub { $_[0] -> binc() },
166              
167 5     5   33 '--' => sub { $_[0] -> bdec() },
168              
169             # overload key: func
170              
171 0 0   0   0 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
172             : $_[0] -> copy() -> batan2($_[1]); },
173              
174 0     0   0 'cos' => sub { $_[0] -> copy() -> bcos(); },
175              
176 0     0   0 'sin' => sub { $_[0] -> copy() -> bsin(); },
177              
178 0     0   0 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); },
179              
180 0     0   0 'abs' => sub { $_[0] -> copy() -> babs(); },
181              
182 7     7   40 'log' => sub { $_[0] -> copy() -> blog(); },
183              
184 0     0   0 'sqrt' => sub { $_[0] -> copy() -> bsqrt(); },
185              
186 2     2   12 'int' => sub { $_[0] -> copy() -> bint(); },
187              
188             # overload key: conversion
189              
190 0 0   0   0 'bool' => sub { $_[0] -> is_zero() ? '' : 1; },
191              
192 5248     5248   314568 '""' => sub { $_[0] -> bstr(); },
193              
194 8     8   48 '0+' => sub { $_[0] -> numify(); },
195              
196 0     0   0 '=' => sub { $_[0]->copy(); },
197              
198 19     19   220 ;
  19         36  
  19         1288  
199              
200             BEGIN {
201 19     19   9223 *objectify = \&Math::BigInt::objectify; # inherit this from BigInt
202 19         58 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
203 19         48 *as_number = \&as_int;
204 19         38 *is_pos = \&is_positive;
205 19         214022 *is_neg = \&is_negative;
206             }
207              
208             ##############################################################################
209             # Global constants and flags. Access these only via the accessor methods!
210              
211             $accuracy = $precision = undef;
212             $round_mode = 'even';
213             $div_scale = 40;
214             $upgrade = undef;
215             $downgrade = undef;
216              
217             # These are internally, and not to be used from the outside at all!
218              
219             $_trap_nan = 0; # are NaNs ok? set w/ config()
220             $_trap_inf = 0; # are infs ok? set w/ config()
221              
222             # the math backend library
223              
224             my $LIB = 'Math::BigInt::Calc';
225              
226             my $nan = 'NaN';
227             #my $class = 'Math::BigRat';
228              
229             sub isa {
230 5813 100   5813 0 675629 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
231 3540         11600 UNIVERSAL::isa(@_);
232             }
233              
234             ##############################################################################
235              
236             sub new {
237 19871     19871 1 14689441 my $proto = shift;
238 19871         31109 my $protoref = ref $proto;
239 19871   33     68882 my $class = $protoref || $proto;
240              
241             # Check the way we are called.
242              
243 19871 50       37160 if ($protoref) {
244 0         0 croak("new() is a class method, not an instance method");
245             }
246              
247 19871 100       38732 if (@_ < 1) {
248             #carp("Using new() with no argument is deprecated;",
249             # " use bzero() or new(0) instead");
250 1         4 return $class -> bzero();
251             }
252              
253 19870 50       33892 if (@_ > 2) {
254 0         0 carp("Superfluous arguments to new() ignored.");
255             }
256              
257             # Get numerator and denominator. If any of the arguments is undefined,
258             # return zero.
259              
260 19870         35316 my ($n, $d) = @_;
261              
262 19870 100 100     84330 if (@_ == 1 && !defined $n ||
      33        
      66        
      66        
263             @_ == 2 && (!defined $n || !defined $d))
264             {
265             #carp("Use of uninitialized value in new()");
266 1         4 return $class -> bzero();
267             }
268              
269             # Initialize a new object.
270              
271 19869         35589 my $self = bless {}, $class;
272              
273             # One or two input arguments may be given. First handle the numerator $n.
274              
275 19869 100       35803 if (ref($n)) {
276 6018 50 66     34726 $n = Math::BigFloat -> new($n, undef, undef)
      66        
277             unless ($n -> isa('Math::BigRat') ||
278             $n -> isa('Math::BigInt') ||
279             $n -> isa('Math::BigFloat'));
280             } else {
281 13851 100       22363 if (defined $d) {
282             # If the denominator is defined, the numerator is not a string
283             # fraction, e.g., "355/113".
284 5         11 $n = Math::BigFloat -> new($n, undef, undef);
285             } else {
286             # If the denominator is undefined, the numerator might be a string
287             # fraction, e.g., "355/113".
288 13846 100       26156 if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) {
289 397         1354 $n = Math::BigFloat -> new($1, undef, undef);
290 397         21826 $d = Math::BigFloat -> new($2, undef, undef);
291             } else {
292 13449         43029 $n = Math::BigFloat -> new($n, undef, undef);
293             }
294             }
295             }
296              
297             # At this point $n is an object and $d is either an object or undefined. An
298             # undefined $d means that $d was not specified by the caller (not that $d
299             # was specified as an undefined value).
300              
301 19869 100       916397 unless (defined $d) {
302             #return $n -> copy($n) if $n -> isa('Math::BigRat');
303 19462 50       45141 if ($n -> isa('Math::BigRat')) {
304 0 0 0     0 return $downgrade -> new($n)
305             if defined($downgrade) && $n -> is_int();
306 0         0 return $class -> copy($n);
307             }
308              
309 19462 100       135851 if ($n -> is_nan()) {
310 333         2104 return $class -> bnan();
311             }
312              
313 19129 100       121635 if ($n -> is_inf()) {
314 595         5215 return $class -> binf($n -> sign());
315             }
316              
317 18534 100       131491 if ($n -> isa('Math::BigInt')) {
318 5875         15838 $self -> {_n} = $LIB -> _new($n -> copy() -> babs(undef, undef)
319             -> bstr());
320 5875         333029 $self -> {_d} = $LIB -> _one();
321 5875         30944 $self -> {sign} = $n -> sign();
322 5875 100       40192 return $downgrade -> new($n) if defined $downgrade;
323 5874         13688 return $self;
324             }
325              
326 12659 50       75403 if ($n -> isa('Math::BigFloat')) {
327 12659         90260 my $m = $n -> mantissa(undef, undef) -> babs(undef, undef);
328 12659         1113951 my $e = $n -> exponent(undef, undef);
329 12659         1157197 $self -> {_n} = $LIB -> _new($m -> bstr());
330 12659         279010 $self -> {_d} = $LIB -> _one();
331              
332 12659 100       73024 if ($e > 0) {
    100          
333             $self -> {_n} = $LIB -> _lsft($self -> {_n},
334 747         126608 $LIB -> _new($e -> bstr()), 10);
335             } elsif ($e < 0) {
336             $self -> {_d} = $LIB -> _lsft($self -> {_d},
337 880         256050 $LIB -> _new(-$e -> bstr()), 10);
338              
339             my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}),
340 880         88528 $self -> {_d});
341 880 100       87133 if (!$LIB -> _is_one($gcd)) {
342 852         5569 $self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
343 852         8153 $self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
344             }
345             }
346              
347 12659         3430764 $self -> {sign} = $n -> sign();
348 12659 100 100     95446 return $downgrade -> new($n, undef, undef)
349             if defined($downgrade) && $n -> is_int();
350 12654         143371 return $self;
351             }
352              
353 0         0 die "I don't know how to handle this"; # should never get here
354             }
355              
356             # At the point we know that both $n and $d are defined. We know that $n is
357             # an object, but $d might still be a scalar. Now handle $d.
358              
359 407 100 66     1568 $d = Math::BigFloat -> new($d, undef, undef)
      100        
360             unless ref($d) && ($d -> isa('Math::BigRat') ||
361             $d -> isa('Math::BigInt') ||
362             $d -> isa('Math::BigFloat'));
363              
364             # At this point both $n and $d are objects.
365              
366 407 100 66     8654 if ($n -> is_nan() || $d -> is_nan()) {
367 3         22 return $class -> bnan();
368             }
369              
370             # At this point neither $n nor $d is a NaN.
371              
372 404 100       4714 if ($n -> is_zero()) {
373 6 50       64 if ($d -> is_zero()) { # 0/0 = NaN
374 0         0 return $class -> bnan();
375             }
376 6         62 return $class -> bzero();
377             }
378              
379 398 50       3645 if ($d -> is_zero()) {
380 0         0 return $class -> binf($d -> sign());
381             }
382              
383             # At this point, neither $n nor $d is a NaN or a zero.
384              
385             # Copy them now before manipulating them.
386              
387 398         3741 $n = $n -> copy();
388 398         10943 $d = $d -> copy();
389              
390 398 100       8948 if ($d < 0) { # make sure denominator is positive
391 10         1559 $n -> bneg();
392 10         377 $d -> bneg();
393             }
394              
395 398 100       72948 if ($n -> is_inf()) {
396 8 100       72 return $class -> bnan() if $d -> is_inf(); # Inf/Inf = NaN
397 7         49 return $class -> binf($n -> sign());
398             }
399              
400             # At this point $n is finite.
401              
402 390 100       2776 return $class -> bzero() if $d -> is_inf();
403 386 50       2427 return $class -> binf($d -> sign()) if $d -> is_zero();
404              
405             # At this point both $n and $d are finite and non-zero.
406              
407 386 100       3378 if ($n < 0) {
408 129         19479 $n -> bneg();
409 129         4743 $self -> {sign} = '-';
410             } else {
411 257         42619 $self -> {sign} = '+';
412             }
413              
414 386 50       995 if ($n -> isa('Math::BigRat')) {
415              
416 0 0       0 if ($d -> isa('Math::BigRat')) {
417              
418             # At this point both $n and $d is a Math::BigRat.
419              
420             # p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
421             # - / - = ----- = ---------------------------------
422             # q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
423              
424 0         0 my $p = $n -> {_n};
425 0         0 my $q = $n -> {_d};
426 0         0 my $r = $d -> {_n};
427 0         0 my $s = $d -> {_d};
428 0         0 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r);
429 0         0 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q);
430 0         0 $self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr),
431             $LIB -> _div($LIB -> _copy($s), $gcd_sq));
432 0         0 $self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
433             $LIB -> _div($LIB -> _copy($r), $gcd_pr));
434              
435 0 0 0     0 return $downgrade -> new($n->bstr())
436             if defined($downgrade) && $self -> is_int();
437 0         0 return $self; # no need for $self -> bnorm() here
438             }
439              
440             # At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float).
441              
442 0         0 my $p = $n -> {_n};
443 0         0 my $q = $n -> {_d};
444 0         0 my $m = $d -> mantissa();
445 0         0 my $e = $d -> exponent();
446              
447             # / p
448             # | ------------ if e > 0
449             # | q * m * 10^e
450             # |
451             # p | p
452             # - / (m * 10^e) = | ----- if e == 0
453             # q | q * m
454             # |
455             # | p * 10^-e
456             # | -------- if e < 0
457             # \ q * m
458              
459 0         0 $self -> {_n} = $LIB -> _copy($p);
460 0         0 $self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m);
461 0 0       0 if ($e > 0) {
    0          
462 0         0 $self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10);
463             } elsif ($e < 0) {
464 0         0 $self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10);
465             }
466              
467 0         0 return $self -> bnorm();
468              
469             } else {
470              
471 386 50       3074 if ($d -> isa('Math::BigRat')) {
472              
473             # At this point $n is a Math::Big(Int|Float) and $d is a
474             # Math::BigRat.
475              
476 0         0 my $m = $n -> mantissa();
477 0         0 my $e = $n -> exponent();
478 0         0 my $p = $d -> {_n};
479 0         0 my $q = $d -> {_d};
480              
481             # / q * m * 10^e
482             # | ------------ if e > 0
483             # | p
484             # |
485             # p | m * q
486             # (m * 10^e) / - = | ----- if e == 0
487             # q | p
488             # |
489             # | q * m
490             # | --------- if e < 0
491             # \ p * 10^-e
492              
493 0         0 $self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m);
494 0         0 $self -> {_d} = $LIB -> _copy($p);
495 0 0       0 if ($e > 0) {
    0          
496 0         0 $self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10);
497             } elsif ($e < 0) {
498 0         0 $self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10);
499             }
500 0         0 return $self -> bnorm();
501              
502             } else {
503              
504             # At this point $n and $d are both a Math::Big(Int|Float)
505              
506 386         2674 my $m1 = $n -> mantissa();
507 386         21844 my $e1 = $n -> exponent();
508 386         34847 my $m2 = $d -> mantissa();
509 386         18776 my $e2 = $d -> exponent();
510              
511             # /
512             # | m1 * 10^(e1 - e2)
513             # | ----------------- if e1 > e2
514             # | m2
515             # |
516             # m1 * 10^e1 | m1
517             # ---------- = | -- if e1 = e2
518             # m2 * 10^e2 | m2
519             # |
520             # | m1
521             # | ----------------- if e1 < e2
522             # | m2 * 10^(e2 - e1)
523             # \
524              
525 386         32039 $self -> {_n} = $LIB -> _new($m1 -> bstr());
526 386         8900 $self -> {_d} = $LIB -> _new($m2 -> bstr());
527 386         7976 my $ediff = $e1 - $e2;
528 386 100       28425 if ($ediff > 0) {
    100          
529             $self -> {_n} = $LIB -> _lsft($self -> {_n},
530 24         4111 $LIB -> _new($ediff -> bstr()),
531             10);
532             } elsif ($ediff < 0) {
533             $self -> {_d} = $LIB -> _lsft($self -> {_d},
534 22         6523 $LIB -> _new(-$ediff -> bstr()),
535             10);
536             }
537              
538 386         105069 return $self -> bnorm();
539             }
540             }
541              
542 0 0 0     0 return $downgrade -> new($self -> bstr())
543             if defined($downgrade) && $self -> is_int();
544 0         0 return $self;
545             }
546              
547             sub copy {
548 1319     1319 1 67501 my $self = shift;
549 1319         2088 my $selfref = ref $self;
550 1319   33     2720 my $class = $selfref || $self;
551              
552             # If called as a class method, the object to copy is the next argument.
553              
554 1319 50       2281 $self = shift() unless $selfref;
555              
556 1319         2601 my $copy = bless {}, $class;
557              
558 1319         2880 $copy->{sign} = $self->{sign};
559 1319         3497 $copy->{_d} = $LIB->_copy($self->{_d});
560 1319         8582 $copy->{_n} = $LIB->_copy($self->{_n});
561 1319 50       7605 $copy->{_a} = $self->{_a} if defined $self->{_a};
562 1319 50       2182 $copy->{_p} = $self->{_p} if defined $self->{_p};
563              
564             #($copy, $copy->{_a}, $copy->{_p})
565             # = $copy->_find_round_parameters(@_);
566              
567 1319         4634 return $copy;
568             }
569              
570             sub bnan {
571 537     537 1 2346 my $self = shift;
572 537         783 my $selfref = ref $self;
573 537   66     1258 my $class = $selfref || $self;
574              
575 537 100       1044 $self = bless {}, $class unless $selfref;
576              
577 537 100       1014 if ($_trap_nan) {
578 5         724 croak ("Tried to set a variable to NaN in $class->bnan()");
579             }
580              
581 532 100       895 return $downgrade -> bnan() if defined $downgrade;
582              
583 525         1055 $self -> {sign} = $nan;
584 525         1095 $self -> {_n} = $LIB -> _zero();
585 525         2525 $self -> {_d} = $LIB -> _one();
586              
587             ($self, $self->{_a}, $self->{_p})
588 525         2772 = $self->_find_round_parameters(@_);
589              
590 525         16362 return $self;
591             }
592              
593             sub binf {
594 783     783 1 5437 my $self = shift;
595 783         1175 my $selfref = ref $self;
596 783   66     2143 my $class = $selfref || $self;
597              
598 783 100       1671 $self = bless {}, $class unless $selfref;
599              
600 783         1087 my $sign = shift();
601 783 100 100     2831 $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf';
602              
603 783 100       1411 if ($_trap_inf) {
604 12         1381 croak ("Tried to set a variable to +-inf in $class->binf()");
605             }
606              
607 771 100       1337 return $downgrade -> binf($sign) if defined $downgrade;
608              
609 764         1208 $self -> {sign} = $sign;
610 764         1618 $self -> {_n} = $LIB -> _zero();
611 764         3719 $self -> {_d} = $LIB -> _one();
612              
613             ($self, $self->{_a}, $self->{_p})
614 764         3829 = $self->_find_round_parameters(@_);
615              
616 764         24802 return $self;
617             }
618              
619             sub bone {
620 13     13 1 956 my $self = shift;
621 13         25 my $selfref = ref $self;
622 13   66     33 my $class = $selfref || $self;
623              
624 13         21 my $sign = shift();
625 13 100 100     51 $sign = '+' unless defined($sign) && $sign eq '-';
626              
627 13 100       35 return $downgrade -> bone($sign) if defined $downgrade;
628              
629 12 50       23 $self = bless {}, $class unless $selfref;
630 12         18 $self -> {sign} = $sign;
631 12         32 $self -> {_n} = $LIB -> _one();
632 12         65 $self -> {_d} = $LIB -> _one();
633              
634             ($self, $self->{_a}, $self->{_p})
635 12         63 = $self->_find_round_parameters(@_);
636              
637 12         387 return $self;
638             }
639              
640             sub bzero {
641 62     62 1 1701 my $self = shift;
642 62         174 my $selfref = ref $self;
643 62   66     202 my $class = $selfref || $self;
644              
645 62 100       139 return $downgrade -> bzero() if defined $downgrade;
646              
647 61 100       137 $self = bless {}, $class unless $selfref;
648 61         127 $self -> {sign} = '+';
649 61         189 $self -> {_n} = $LIB -> _zero();
650 61         327 $self -> {_d} = $LIB -> _one();
651              
652             ($self, $self->{_a}, $self->{_p})
653 61         372 = $self->_find_round_parameters(@_);
654              
655 61         1876 return $self;
656             }
657              
658             ##############################################################################
659              
660             sub config {
661             # return (later set?) configuration data as hash ref
662 12   50 12 1 3650 my $class = shift() || 'Math::BigRat';
663              
664 12 100 100     49 if (@_ == 1 && ref($_[0]) ne 'HASH') {
665 6         20 my $cfg = $class->SUPER::config();
666 6         276 return $cfg->{$_[0]};
667             }
668              
669 6         31 my $cfg = $class->SUPER::config(@_);
670              
671             # now we need only to override the ones that are different from our parent
672 6         538 $cfg->{class} = $class;
673 6         53 $cfg->{with} = $LIB;
674              
675 6         24 $cfg;
676             }
677              
678             ##############################################################################
679              
680             sub bstr {
681 29743 50   29743 1 12368462 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
682              
683 29743 100       100897 if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
684 1200         1926 my $s = $x->{sign};
685 1200         2414 $s =~ s/^\+//; # +inf => inf
686 1200         7264 return $s;
687             }
688              
689 28543         43519 my $s = '';
690 28543 100       64638 $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
691              
692 28543 100       76598 return $s . $LIB->_str($x->{_n}) if $LIB->_is_one($x->{_d});
693 1823         10357 $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
694             }
695              
696             sub bsstr {
697 8 50   8 1 46 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
698              
699 8 100       30 if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
700 3         5 my $s = $x->{sign};
701 3         5 $s =~ s/^\+//; # +inf => inf
702 3         23 return $s;
703             }
704              
705 5         9 my $s = '';
706 5 100       15 $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
707 5         14 $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
708             }
709              
710             sub bnorm {
711             # reduce the number to the shortest form
712 779 100   779 1 11402 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
713              
714             # Both parts must be objects of whatever we are using today.
715 779 50       2023 if (my $c = $LIB->_check($x->{_n})) {
716 0         0 croak("n did not pass the self-check ($c) in bnorm()");
717             }
718 779 50       24429 if (my $c = $LIB->_check($x->{_d})) {
719 0         0 croak("d did not pass the self-check ($c) in bnorm()");
720             }
721              
722             # no normalize for NaN, inf etc.
723 779 100       19420 if ($x->{sign} !~ /^[+-]$/) {
724 18 100       48 return $downgrade -> new($x) if defined $downgrade;
725 16         114 return $x;
726             }
727              
728             # normalize zeros to 0/1
729 761 100       1721 if ($LIB->_is_zero($x->{_n})) {
730 46 100       226 return $downgrade -> bzero() if defined($downgrade);
731 43         74 $x->{sign} = '+'; # never leave a -0
732 43 100       100 $x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
733 43         348 return $x;
734             }
735              
736             # n/1
737 715 100       3880 if ($LIB->_is_one($x->{_d})) {
738 216 100       1159 return $downgrade -> new($x) if defined($downgrade);
739 205         1837 return $x; # no need to reduce
740             }
741              
742             # Compute the GCD.
743 499         2782 my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
744 499 100       28217 if (!$LIB->_is_one($gcd)) {
745 97         630 $x->{_n} = $LIB->_div($x->{_n}, $gcd);
746 97         1149 $x->{_d} = $LIB->_div($x->{_d}, $gcd);
747             }
748              
749 499         8055 $x;
750             }
751              
752             ##############################################################################
753             # sign manipulation
754              
755             sub bneg {
756             # (BRAT or num_str) return BRAT
757             # negate number or make a negated number from string
758 26 50   26 1 103 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
759              
760 26 50       77 return $x if $x->modify('bneg');
761              
762             # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
763             $x->{sign} =~ tr/+-/-+/
764 26 100 100     112 unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));
765              
766             return $downgrade -> new($x)
767 26 100 100     126 if defined($downgrade) && $LIB -> _is_one($x->{_d});
768 22         196 $x;
769             }
770              
771             ##############################################################################
772             # mul/add/div etc
773              
774             sub badd {
775             # add two rational numbers
776              
777             # set up parameters
778 330     330 1 1470 my ($class, $x, $y, @r) = (ref($_[0]), @_);
779             # objectify is costly, so avoid it
780 330 100 66     1174 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
781 91         234 ($class, $x, $y, @r) = objectify(2, @_);
782             }
783              
784 330 100 100     1360 unless ($x -> is_finite() && $y -> is_finite()) {
785 202 100 100     1556 if ($x -> is_nan() || $y -> is_nan()) {
    100          
    100          
    100          
    50          
786 62         461 return $x -> bnan(@r);
787             } elsif ($x -> is_inf("+")) {
788 41 100       1385 return $x -> bnan(@r) if $y -> is_inf("-");
789 35         668 return $x -> binf("+", @r);
790             } elsif ($x -> is_inf("-")) {
791 41 100       1834 return $x -> bnan(@r) if $y -> is_inf("+");
792 35         722 return $x -> binf("-", @r);
793             } elsif ($y -> is_inf("+")) {
794 30         1840 return $x -> binf("+", @r);
795             } elsif ($y -> is_inf("-")) {
796 28         2209 return $x -> binf("-", @r);
797             }
798             }
799              
800             # 1 1 gcd(3, 4) = 1 1*3 + 1*4 7
801             # - + - = --------- = --
802             # 4 3 4*3 12
803              
804             # we do not compute the gcd() here, but simple do:
805             # 5 7 5*3 + 7*4 43
806             # - + - = --------- = --
807             # 4 3 4*3 12
808              
809             # and bnorm() will then take care of the rest
810              
811             # 5 * 3
812 128         1619 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
813              
814             # 7 * 4
815 128         1356 my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
816              
817             # 5 * 3 + 7 * 4
818 128         1670 ($x->{_n}, $x->{sign}) = $LIB -> _sadd($x->{_n}, $x->{sign}, $m, $y->{sign});
819              
820             # 4 * 3
821 128         4379 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});
822              
823             # normalize result, and possible round
824 128         1021 $x->bnorm()->round(@r);
825             }
826              
827             sub bsub {
828             # subtract two rational numbers
829              
830             # set up parameters
831 96     96 1 601 my ($class, $x, $y, @r) = (ref($_[0]), @_);
832             # objectify is costly, so avoid it
833 96 100 100     374 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
834 10         31 ($class, $x, $y, @r) = objectify(2, @_);
835             }
836              
837             # flip sign of $x, call badd(), then flip sign of result
838             $x->{sign} =~ tr/+-/-+/
839 96 100 100     393 unless $x->{sign} eq '+' && $x -> is_zero(); # not -0
840 96         352 $x = $x->badd($y, @r); # does norm and round
841             $x->{sign} =~ tr/+-/-+/
842 96 100 100     782 unless $x->{sign} eq '+' && $x -> is_zero(); # not -0
843              
844 96         343 $x->bnorm();
845             }
846              
847             sub bmul {
848             # multiply two rational numbers
849              
850             # set up parameters
851 93     93 1 443 my ($class, $x, $y, @r) = (ref($_[0]), @_);
852             # objectify is costly, so avoid it
853 93 100 66     373 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
854 6         18 ($class, $x, $y, @r) = objectify(2, @_);
855             }
856              
857 93 100 100     367 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
858              
859             # inf handling
860 85 100 100     293 if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) {
861 13 50 33     35 return $x->bnan() if $x->is_zero() || $y->is_zero();
862             # result will always be +-inf:
863             # +inf * +/+inf => +inf, -inf * -/-inf => +inf
864             # +inf * -/-inf => -inf, -inf * +/+inf => -inf
865 13 100 100     64 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
866 8 100 100     37 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
867 6         13 return $x->binf('-');
868             }
869              
870             # x == 0 # also: or y == 1 or y == -1
871 72 100       169 if ($x -> is_zero()) {
872 5 100       45 $x = $downgrade -> bzero($x) if defined $downgrade;
873 5 50       117 return wantarray ? ($x, $class->bzero()) : $x;
874             }
875              
876 67 100       137 if ($y -> is_zero()) {
877 3 50       29 $x = defined($downgrade) ? $downgrade -> bzero($x) : $x -> bzero();
878 3 50       35 return wantarray ? ($x, $class->bzero()) : $x;
879             }
880              
881             # According to Knuth, this can be optimized by doing gcd twice (for d
882             # and n) and reducing in one step. This saves us a bnorm() at the end.
883             #
884             # p s p * s (p / gcd(p, r)) * (s / gcd(s, q))
885             # - * - = ----- = ---------------------------------
886             # q r q * r (q / gcd(s, q)) * (r / gcd(p, r))
887              
888 64         156 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d});
889 64         2547 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});
890              
891             $x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
892 64         1885 scalar $LIB -> _div($LIB -> _copy($y->{_n}),
893             $gcd_sq));
894             $x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
895 64         2038 scalar $LIB -> _div($LIB -> _copy($y->{_d}),
896             $gcd_pr));
897              
898             # compute new sign
899 64 100       1476 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
900              
901 64         195 $x->bnorm()->round(@r);
902             }
903              
904             sub bdiv {
905             # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
906             # (BRAT, BRAT) (quo, rem) or BRAT (only rem)
907              
908             # set up parameters
909 87     87 1 522 my ($class, $x, $y, @r) = (ref($_[0]), @_);
910             # objectify is costly, so avoid it
911 87 100 66     351 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
912 7         24 ($class, $x, $y, @r) = objectify(2, @_);
913             }
914              
915 87 50       298 return $x if $x->modify('bdiv');
916              
917 87         137 my $wantarray = wantarray; # call only once
918              
919             # At least one argument is NaN. This is handled the same way as in
920             # Math::BigInt -> bdiv(). See the comments in the code implementing that
921             # method.
922              
923 87 100 100     199 if ($x -> is_nan() || $y -> is_nan()) {
924 5 50       46 if ($wantarray) {
925 0 0       0 return $downgrade -> bnan(), $downgrade -> bnan()
926             if defined($downgrade);
927 0         0 return $x -> bnan(), $class -> bnan();
928             } else {
929 5 50       11 return $downgrade -> bnan()
930             if defined($downgrade);
931 5         11 return $x -> bnan();
932             }
933             }
934              
935             # Divide by zero and modulo zero. This is handled the same way as in
936             # Math::BigInt -> bdiv(). See the comments in the code implementing that
937             # method.
938              
939 82 100       896 if ($y -> is_zero()) {
940 11         74 my ($quo, $rem);
941 11 100       28 if ($wantarray) {
942 3         8 $rem = $x -> copy();
943             }
944 11 100       24 if ($x -> is_zero()) {
945 3         25 $quo = $x -> bnan();
946             } else {
947 8         29 $quo = $x -> binf($x -> {sign});
948             }
949              
950 8 50 33     25 $quo = $downgrade -> new($quo)
951             if defined($downgrade) && $quo -> is_int();
952 8 50 66     27 $rem = $downgrade -> new($rem)
      33        
953             if $wantarray && defined($downgrade) && $rem -> is_int();
954 8 100       82 return $wantarray ? ($quo, $rem) : $quo;
955             }
956              
957             # Numerator (dividend) is +/-inf. This is handled the same way as in
958             # Math::BigInt -> bdiv(). See the comments in the code implementing that
959             # method.
960              
961 71 50       181 if ($x -> is_inf()) {
962 0         0 my ($quo, $rem);
963 0 0       0 $rem = $class -> bnan() if $wantarray;
964 0 0       0 if ($y -> is_inf()) {
965 0         0 $quo = $x -> bnan();
966             } else {
967 0 0       0 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
968 0         0 $quo = $x -> binf($sign);
969             }
970              
971 0 0 0     0 $quo = $downgrade -> new($quo)
972             if defined($downgrade) && $quo -> is_int();
973 0 0 0     0 $rem = $downgrade -> new($rem)
      0        
974             if $wantarray && defined($downgrade) && $rem -> is_int();
975 0 0       0 return $wantarray ? ($quo, $rem) : $quo;
976             }
977              
978             # Denominator (divisor) is +/-inf. This is handled the same way as in
979             # Math::BigFloat -> bdiv(). See the comments in the code implementing that
980             # method.
981              
982 71 100       514 if ($y -> is_inf()) {
983 2         16 my ($quo, $rem);
984 2 50       4 if ($wantarray) {
985 0 0 0     0 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
986 0         0 $rem = $x -> copy();
987 0         0 $quo = $x -> bzero();
988             } else {
989 0         0 $rem = $class -> binf($y -> {sign});
990 0         0 $quo = $x -> bone('-');
991             }
992 0 0 0     0 $quo = $downgrade -> new($quo)
993             if defined($downgrade) && $quo -> is_int();
994 0 0 0     0 $rem = $downgrade -> new($rem)
995             if defined($downgrade) && $rem -> is_int();
996 0         0 return ($quo, $rem);
997             } else {
998 2 50       5 if ($y -> is_inf()) {
999 2 50 33     14 if ($x -> is_nan() || $x -> is_inf()) {
1000 0 0       0 return $downgrade -> bnan() if defined $downgrade;
1001 0         0 return $x -> bnan();
1002             } else {
1003 2 50       26 return $downgrade -> bzero() if defined $downgrade;
1004 2         22 return $x -> bzero();
1005             }
1006             }
1007             }
1008             }
1009              
1010             # At this point, both the numerator and denominator are finite numbers, and
1011             # the denominator (divisor) is non-zero.
1012              
1013             # x == 0?
1014 69 100       416 if ($x->is_zero()) {
1015 3 0       25 return $wantarray ? ($downgrade -> bzero(), $downgrade -> bzero())
    50          
1016             : $downgrade -> bzero() if defined $downgrade;
1017 3 100       31 return $wantarray ? ($x, $class->bzero()) : $x;
1018             }
1019              
1020             # XXX TODO: list context, upgrade
1021             # According to Knuth, this can be optimized by doing gcd twice (for d and n)
1022             # and reducing in one step. This would save us the bnorm() at the end.
1023             #
1024             # p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
1025             # - / - = ----- = ---------------------------------
1026             # q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
1027              
1028 66         222 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
1029 66         937 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_n});
1030              
1031             # compute new sign
1032 66 100       568 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
1033              
1034 66         179 $x -> bnorm();
1035 66 100       132 if (wantarray) {
1036 6         17 my $rem = $x -> copy();
1037 6         21 $x = $x -> bfloor();
1038 6         19 $x = $x -> round(@r);
1039 6         15 $rem = $rem -> bsub($x -> copy()) -> bmul($y);
1040 6 50 33     28 $x = $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
1041 6 50 33     16 $rem = $downgrade -> new($rem) if defined($downgrade) && $rem -> is_int();
1042 6         26 return $x, $rem;
1043             } else {
1044 60         159 return $x -> round(@r);
1045             }
1046             }
1047              
1048             sub bmod {
1049             # compute "remainder" (in Perl way) of $x / $y
1050              
1051             # set up parameters
1052 21     21 1 57 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1053             # objectify is costly, so avoid it
1054 21 50 33     106 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1055 0         0 ($class, $x, $y, @r) = objectify(2, @_);
1056             }
1057              
1058 21 50       81 return $x if $x->modify('bmod');
1059              
1060             # At least one argument is NaN. This is handled the same way as in
1061             # Math::BigInt -> bmod().
1062              
1063 21 100 100     52 if ($x -> is_nan() || $y -> is_nan()) {
1064 2         20 return $x -> bnan();
1065             }
1066              
1067             # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
1068              
1069 19 50       235 if ($y -> is_zero()) {
1070 0 0       0 return $downgrade -> bzero() if defined $downgrade;
1071 0         0 return $x;
1072             }
1073              
1074             # Numerator (dividend) is +/-inf. This is handled the same way as in
1075             # Math::BigInt -> bmod().
1076              
1077 19 50       54 if ($x -> is_inf()) {
1078 0         0 return $x -> bnan();
1079             }
1080              
1081             # Denominator (divisor) is +/-inf. This is handled the same way as in
1082             # Math::BigInt -> bmod().
1083              
1084 19 50       144 if ($y -> is_inf()) {
1085 0 0 0     0 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
1086 0 0 0     0 return $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
1087 0         0 return $x;
1088             } else {
1089 0 0       0 return $downgrade -> binf($y -> sign()) if defined($downgrade);
1090 0         0 return $x -> binf($y -> sign());
1091             }
1092             }
1093              
1094             # At this point, both the numerator and denominator are finite numbers, and
1095             # the denominator (divisor) is non-zero.
1096              
1097 19 50       133 if ($x->is_zero()) { # 0 / 7 = 0, mod 0
1098 0 0       0 return $downgrade -> bzero() if defined $downgrade;
1099 0         0 return $x;
1100             }
1101              
1102             # Compute $x - $y * floor($x/$y). This can probably be optimized by working
1103             # on a lower level.
1104              
1105 19         44 $x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y));
1106 19         61 return $x -> round(@r);
1107             }
1108              
1109             ##############################################################################
1110             # bdec/binc
1111              
1112             sub bdec {
1113             # decrement value (subtract 1)
1114 12 50   12 1 54 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1115              
1116 12 100       53 if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf
1117 3 100       13 return $downgrade -> new($x) if defined $downgrade;
1118 1         10 return $x;
1119             }
1120              
1121 9 100       27 if ($x->{sign} eq '-') {
1122 1         5 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
1123             } else {
1124 8 100       26 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d?
1125             {
1126             # 1/3 -- => -2/3
1127 3         26 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
1128 3         78 $x->{sign} = '-';
1129             } else {
1130 5         48 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
1131             }
1132             }
1133 9         147 $x->bnorm()->round(@r);
1134             }
1135              
1136             sub binc {
1137             # increment value (add 1)
1138 13 50   13 1 54 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1139              
1140 13 100       54 if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf
1141 3 100       16 return $downgrade -> new($x) if defined $downgrade;
1142 1         10 return $x;
1143             }
1144              
1145 10 100       33 if ($x->{sign} eq '-') {
1146 3 100       10 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
1147             # -1/3 ++ => 2/3 (overflow at 0)
1148 2         18 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
1149 2         55 $x->{sign} = '+';
1150             } else {
1151 1         12 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
1152             }
1153             } else {
1154 7         26 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2
1155             }
1156 10         143 $x->bnorm()->round(@r);
1157             }
1158              
1159             sub binv {
1160 20     20 1 80 my $x = shift;
1161 20         33 my @r = @_;
1162              
1163 20 50       54 return $x if $x->modify('binv');
1164              
1165 20 100       42 return $x if $x -> is_nan();
1166 18 100       104 return $x -> bzero() if $x -> is_inf();
1167 14 100       94 return $x -> binf("+") if $x -> is_zero();
1168              
1169 12         24 ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n});
1170 12         26 $x -> round(@r);
1171             }
1172              
1173             ##############################################################################
1174             # is_foo methods (the rest is inherited)
1175              
1176             sub is_int {
1177             # return true if arg (BRAT or num_str) is an integer
1178 9820 50   9820 1 108852 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1179              
1180             return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
1181 9820 100 100     38862 $LIB->_is_one($x->{_d}); # x/y && y != 1 => no integer
1182 31         258 0;
1183             }
1184              
1185             sub is_zero {
1186             # return true if arg (BRAT or num_str) is zero
1187 659 50   659 1 1812 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1188              
1189 659 100 100     1975 return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n});
1190 576         3144 0;
1191             }
1192              
1193             sub is_one {
1194             # return true if arg (BRAT or num_str) is +1 or -1 if signis given
1195 311 50   311 1 1206 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1196              
1197 311 50       574 croak "too many arguments for is_one()" if @_ > 2;
1198 311   100     726 my $sign = $_[1] || '';
1199 311 100       713 $sign = '+' if $sign ne '-';
1200             return 1 if ($x->{sign} eq $sign &&
1201 311 100 100     1008 $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
      100        
1202 274         1733 0;
1203             }
1204              
1205             sub is_odd {
1206             # return true if arg (BFLOAT or num_str) is odd or false if even
1207 25 50   25 1 118 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1208              
1209             return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
1210 25 100 100     113 ($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1
      100        
1211 15         171 0;
1212             }
1213              
1214             sub is_even {
1215             # return true if arg (BINT or num_str) is even or false if odd
1216 18 50   18 1 117 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1217              
1218 18 100       68 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1219             return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never
1220 15 100 100     38 && $LIB->_is_even($x->{_n})); # but 4/1 is
1221 9         124 0;
1222             }
1223              
1224             ##############################################################################
1225             # parts() and friends
1226              
1227             sub numerator {
1228 39 50   39 1 3721 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1229              
1230             # NaN, inf, -inf
1231 39 100       186 return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
1232              
1233 24         73 my $n = Math::BigInt->new($LIB->_str($x->{_n}));
1234 24         1582 $n->{sign} = $x->{sign};
1235 24         77 $n;
1236             }
1237              
1238             sub denominator {
1239 35 50   35 1 5832 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1240              
1241             # NaN
1242 35 100       143 return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
1243             # inf, -inf
1244 26 100       113 return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
1245              
1246 20         65 Math::BigInt->new($LIB->_str($x->{_d}));
1247             }
1248              
1249             sub parts {
1250 11 50   11 1 77 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1251              
1252 11         18 my $c = 'Math::BigInt';
1253              
1254 11 100       31 return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN';
1255 10 100       21 return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf';
1256 9 100       29 return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf';
1257              
1258 8         28 my $n = $c->new($LIB->_str($x->{_n}));
1259 8         525 $n->{sign} = $x->{sign};
1260 8         19 my $d = $c->new($LIB->_str($x->{_d}));
1261 8         499 ($n, $d);
1262             }
1263              
1264             sub dparts {
1265 16     16 1 38 my $x = shift;
1266 16         23 my $class = ref $x;
1267              
1268 16 50       30 croak("dparts() is an instance method") unless $class;
1269              
1270 16 100       44 if ($x -> is_nan()) {
1271 2 100       17 return $class -> bnan(), $class -> bnan() if wantarray;
1272 1         3 return $class -> bnan();
1273             }
1274              
1275 14 100       84 if ($x -> is_inf()) {
1276 4 100       39 return $class -> binf($x -> sign()), $class -> bzero() if wantarray;
1277 2         6 return $class -> binf($x -> sign());
1278             }
1279              
1280             # 355/113 => 3 + 16/113
1281              
1282 10         74 my ($q, $r) = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d});
1283              
1284 10         220 my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q));
1285 10 100       28 return $int unless wantarray;
1286              
1287             my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r),
1288 5         13 $LIB -> _str($x -> {_d}));
1289              
1290 5         17 return $int, $frc;
1291             }
1292              
1293             sub fparts {
1294 14     14 1 91 my $x = shift;
1295 14         36 my $class = ref $x;
1296              
1297 14 50       34 croak("fparts() is an instance method") unless $class;
1298              
1299 14 100       33 return ($class -> bnan(),
1300             $class -> bnan()) if $x -> is_nan();
1301              
1302 13         95 my $numer = $x -> copy();
1303 13         55 my $denom = $class -> bzero();
1304              
1305 13         46 $denom -> {_n} = $numer -> {_d};
1306 13         44 $numer -> {_d} = $LIB -> _one();
1307              
1308 13         76 return ($numer, $denom);
1309             }
1310              
1311             sub length {
1312 5 50   5 1 38 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1313              
1314 5 50       13 return $nan unless $x->is_int();
1315 5         43 $LIB->_len($x->{_n}); # length(-123/1) => length(123)
1316             }
1317              
1318             sub digit {
1319 11 50   11 1 60 my ($class, $x, $n) = ref($_[0]) ? (undef, $_[0], $_[1]) : objectify(1, @_);
1320              
1321 11 50       26 return $nan unless $x->is_int();
1322 11   100     100 $LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2)
1323             }
1324              
1325             ##############################################################################
1326             # special calc routines
1327              
1328             sub bceil {
1329 24 50   24 1 136 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1330              
1331 24 100 100     110 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
1332             $LIB->_is_one($x->{_d})) # integer
1333             {
1334 10 100       71 return $downgrade -> new($x) if defined $downgrade;
1335 8         62 return $x;
1336             }
1337              
1338 14         134 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1339 14         139 $x->{_d} = $LIB->_one(); # d => 1
1340 14 100       105 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1
1341 14 100 100     104 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
1342 14 100       58 return $downgrade -> new($x) if defined $downgrade;
1343 13         100 $x;
1344             }
1345              
1346             sub bfloor {
1347 52 50   52 1 241 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1348              
1349 52 100 100     257 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
1350             $LIB->_is_one($x->{_d})) # integer
1351             {
1352 24 100       151 return $downgrade -> new($x) if defined $downgrade;
1353 22         126 return $x;
1354             }
1355              
1356 28         228 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1357 28         293 $x->{_d} = $LIB->_one(); # d => 1
1358 28 100       270 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1
1359 28 100       152 return $downgrade -> new($x) if defined $downgrade;
1360 27         187 $x;
1361             }
1362              
1363             sub bint {
1364 963 50   963 1 2616 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1365              
1366 963 100 100     4695 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
1367             $LIB->_is_one($x->{_d})) # integer
1368             {
1369 552 100       3503 return $downgrade -> new($x) if defined $downgrade;
1370 550         1655 return $x;
1371             }
1372              
1373 411         3141 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1374 411         3929 $x->{_d} = $LIB->_one(); # d => 1
1375 411 100 66     2563 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
1376 411 100       783 return $downgrade -> new($x) if defined $downgrade;
1377 410         1093 return $x;
1378             }
1379              
1380             sub bfac {
1381 13 50   13 1 58 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1382              
1383             # if $x is not an integer
1384 13 100 66     48 if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) {
1385 3         11 return $x->bnan();
1386             }
1387              
1388 10         72 $x->{_n} = $LIB->_fac($x->{_n});
1389             # since _d is 1, we don't need to reduce/norm the result
1390 10         196 $x->round(@r);
1391             }
1392              
1393             sub bpow {
1394             # power ($x ** $y)
1395              
1396             # set up parameters
1397 190     190 1 1344 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1398              
1399             # objectify is costly, so avoid it
1400 190 100 66     854 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1401 6         16 ($class, $x, $y, @r) = objectify(2, @_);
1402             }
1403              
1404 190 50       687 return $x if $x->modify('bpow');
1405              
1406             # $x and/or $y is a NaN
1407 190 100 100     428 return $x->bnan() if $x->is_nan() || $y->is_nan();
1408              
1409             # $x and/or $y is a +/-Inf
1410 161 100       1785 if ($x->is_inf("-")) {
    100          
    100          
    100          
1411 13 100       242 return $x->bzero() if $y->is_negative();
1412 7 100       195 return $x->bnan() if $y->is_zero();
1413 6 100       16 return $x if $y->is_odd();
1414 4         13 return $x->bneg();
1415             } elsif ($x->is_inf("+")) {
1416 13 100       605 return $x->bzero() if $y->is_negative();
1417 7 100       193 return $x->bnan() if $y->is_zero();
1418 6         61 return $x;
1419             } elsif ($y->is_inf("-")) {
1420 11 100       794 return $x->bnan() if $x -> is_one("-");
1421 10 100 100     35 return $x->binf("+") if $x > -1 && $x < 1;
1422 7 100       24 return $x->bone() if $x -> is_one("+");
1423 6         26 return $x->bzero();
1424             } elsif ($y->is_inf("+")) {
1425 11 100       845 return $x->bnan() if $x -> is_one("-");
1426 10 100 100     37 return $x->bzero() if $x > -1 && $x < 1;
1427 7 100       25 return $x->bone() if $x -> is_one("+");
1428 6         19 return $x->binf("+");
1429             }
1430              
1431 113 100       9064 if ($x -> is_zero()) {
1432 11 100       94 return $x -> bone() if $y -> is_zero();
1433 10 100       75 return $x -> binf() if $y -> is_negative();
1434 5         244 return $x;
1435             }
1436              
1437             # We don't support complex numbers, so upgrade or return NaN.
1438              
1439 102 100 100     688 if ($x -> is_negative() && !$y -> is_int()) {
1440 20 50       54 return $upgrade -> bpow($upgrade -> new($x), $y, @r)
1441             if defined $upgrade;
1442 20         103 return $x -> bnan();
1443             }
1444              
1445 82 100 100     2044 if ($x -> is_one("+") || $y -> is_one()) {
1446 20         490 return $x;
1447             }
1448              
1449 62 100       202 if ($x -> is_one("-")) {
1450 6 100       77 return $x if $y -> is_odd();
1451 3         13 return $x -> bneg();
1452             }
1453              
1454             # (a/b)^-(c/d) = (b/a)^(c/d)
1455 56 100       234 ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();
1456              
1457 56 100       1430 unless ($LIB->_is_one($y->{_n})) {
1458 47         359 $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n});
1459 47         2903 $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n});
1460 47 100 100     2143 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
1461             }
1462              
1463 56 100       289 unless ($LIB->_is_one($y->{_d})) {
1464 2 100       15 return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
1465 1         9 return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N)
1466             }
1467              
1468 54         394 return $x->round(@r);
1469             }
1470              
1471             sub blog {
1472             # Return the logarithm of the operand. If a second operand is defined, that
1473             # value is used as the base, otherwise the base is assumed to be Euler's
1474             # constant.
1475              
1476 20     20 1 80 my ($class, $x, $base, @r);
1477              
1478             # Don't objectify the base, since an undefined base, as in $x->blog() or
1479             # $x->blog(undef) signals that the base is Euler's number.
1480              
1481 20 50 33     65 if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
1482             # E.g., Math::BigRat->blog(256, 2)
1483 0 0       0 ($class, $x, $base, @r) =
1484             defined $_[2] ? objectify(2, @_) : objectify(1, @_);
1485             } else {
1486             # E.g., Math::BigRat::blog(256, 2) or $x->blog(2)
1487 20 100       69 ($class, $x, $base, @r) =
1488             defined $_[1] ? objectify(2, @_) : objectify(1, @_);
1489             }
1490              
1491 20 50       167 return $x if $x->modify('blog');
1492              
1493             # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
1494             # (http://www.wolframalpha.com) as the reference for these cases.
1495              
1496 20 100       45 return $x -> bnan() if $x -> is_nan();
1497              
1498 15 100       96 if (defined $base) {
1499 7 50       19 $base = $class -> new($base) unless ref $base;
1500 7 100 66     329 if ($base -> is_nan() || $base -> is_one()) {
    50 33        
    100          
1501 2         16 return $x -> bnan();
1502             } elsif ($base -> is_inf() || $base -> is_zero()) {
1503 0 0 0     0 return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
1504 0         0 return $x -> bzero();
1505             } elsif ($base -> is_negative()) { # -inf < base < 0
1506 2 50       63 return $x -> bzero() if $x -> is_one(); # x = 1
1507 2 50       4 return $x -> bone() if $x == $base; # x = base
1508 2         8 return $x -> bnan(); # otherwise
1509             }
1510 3 50       104 return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
1511             }
1512              
1513             # We now know that the base is either undefined or positive and finite.
1514              
1515 11 100       29 if ($x -> is_inf()) { # x = +/-inf
    100          
    100          
    100          
1516 2 50 33     21 my $sign = defined $base && $base < 1 ? '-' : '+';
1517 2         7 return $x -> binf($sign);
1518             } elsif ($x -> is_neg()) { # -inf < x < 0
1519 2         84 return $x -> bnan();
1520             } elsif ($x -> is_one()) { # x = 1
1521 1         16 return $x -> bzero();
1522             } elsif ($x -> is_zero()) { # x = 0
1523 3 50 66     31 my $sign = defined $base && $base < 1 ? '+' : '-';
1524 3         13 return $x -> binf($sign);
1525             }
1526              
1527             # Now take care of the cases where $x and/or $base is 1/N.
1528             #
1529             # log(1/N) / log(B) = -log(N)/log(B)
1530             # log(1/N) / log(1/B) = log(N)/log(B)
1531             # log(N) / log(1/B) = -log(N)/log(B)
1532              
1533 3         8 my $neg = 0;
1534 3 50       12 if ($x -> numerator() -> is_one()) {
1535 0         0 $x -> binv();
1536 0         0 $neg = !$neg;
1537             }
1538 3 100 66     58 if (defined(blessed($base)) && $base -> isa($class)) {
1539 2 50       8 if ($base -> numerator() -> is_one()) {
1540 0         0 $base = $base -> copy() -> binv();
1541 0         0 $neg = !$neg;
1542             }
1543             }
1544              
1545             # At this point we are done handling all exception cases and trivial cases.
1546              
1547 3 100       31 $base = Math::BigFloat -> new($base) if defined $base;
1548              
1549 3         81 my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
1550 3         241 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1551              
1552 3         359 my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr());
1553              
1554 3         13 $x -> {sign} = $xtmp -> {sign};
1555 3         9 $x -> {_n} = $xtmp -> {_n};
1556 3         10 $x -> {_d} = $xtmp -> {_d};
1557              
1558 3 50       54 return $neg ? $x -> bneg() : $x;
1559             }
1560              
1561             sub bexp {
1562             # set up parameters
1563 1     1 1 3 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1564              
1565             # objectify is costly, so avoid it
1566 1 50 33     7 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1567 1         21 ($class, $x, $y, @r) = objectify(1, @_);
1568             }
1569              
1570 1 50       15 return $x->binf(@r) if $x->{sign} eq '+inf';
1571 1 50       3 return $x->bzero(@r) if $x->{sign} eq '-inf';
1572              
1573             # we need to limit the accuracy to protect against overflow
1574 1         2 my $fallback = 0;
1575 1         2 my ($scale, @params);
1576 1         6 ($x, @params) = $x->_find_round_parameters(@r);
1577              
1578             # also takes care of the "error in _find_round_parameters?" case
1579 1 50       32 return $x if $x->{sign} eq 'NaN';
1580              
1581             # no rounding at all, so must use fallback
1582 1 50       3 if (scalar @params == 0) {
1583             # simulate old behaviour
1584 1         4 $params[0] = $class->div_scale(); # and round to it as accuracy
1585 1         12 $params[1] = undef; # P = undef
1586 1         1 $scale = $params[0]+4; # at least four more for proper round
1587 1         2 $params[2] = $r[2]; # round mode by caller or undef
1588 1         1 $fallback = 1; # to clear a/p afterwards
1589             } else {
1590             # the 4 below is empirical, and there might be cases where it's not enough...
1591 0   0     0 $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
1592             }
1593              
1594 1 50       2 return $x->bone(@params) if $x->is_zero();
1595              
1596             # See the comments in Math::BigFloat on how this algorithm works.
1597             # Basically we calculate A and B (where B is faculty(N)) so that A/B = e
1598              
1599 1         3 my $x_org = $x->copy();
1600 1 50       3 if ($scale <= 75) {
1601             # set $x directly from a cached string form
1602             $x->{_n} =
1603 1         3 $LIB->_new("90933395208605785401971970164779391644753259799242");
1604             $x->{_d} =
1605 1         31 $LIB->_new("33452526613163807108170062053440751665152000000000");
1606 1         19 $x->{sign} = '+';
1607             } else {
1608             # compute A and B so that e = A / B.
1609              
1610             # After some terms we end up with this, so we use it as a starting point:
1611 0         0 my $A = $LIB->_new("90933395208605785401971970164779391644753259799242");
1612 0         0 my $F = $LIB->_new(42); my $step = 42;
  0         0  
1613              
1614             # Compute how many steps we need to take to get $A and $B sufficiently big
1615 0         0 my $steps = Math::BigFloat::_len_to_steps($scale - 4);
1616             # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
1617 0         0 while ($step++ <= $steps) {
1618             # calculate $a * $f + 1
1619 0         0 $A = $LIB->_mul($A, $F);
1620 0         0 $A = $LIB->_inc($A);
1621             # increment f
1622 0         0 $F = $LIB->_inc($F);
1623             }
1624             # compute $B as factorial of $steps (this is faster than doing it manually)
1625 0         0 my $B = $LIB->_fac($LIB->_new($steps));
1626              
1627             # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
1628              
1629 0         0 $x->{_n} = $A;
1630 0         0 $x->{_d} = $B;
1631 0         0 $x->{sign} = '+';
1632             }
1633              
1634             # $x contains now an estimate of e, with some surplus digits, so we can round
1635 1 50       2 if (!$x_org->is_one()) {
1636             # raise $x to the wanted power and round it in one step:
1637 1         2 $x->bpow($x_org, @params);
1638             } else {
1639             # else just round the already computed result
1640 0         0 delete $x->{_a}; delete $x->{_p};
  0         0  
1641             # shortcut to not run through _find_round_parameters again
1642 0 0       0 if (defined $params[0]) {
1643 0         0 $x->bround($params[0], $params[2]); # then round accordingly
1644             } else {
1645 0         0 $x->bfround($params[1], $params[2]); # then round accordingly
1646             }
1647             }
1648 1 50       2 if ($fallback) {
1649             # clear a/p after round, since user did not request it
1650 1         2 delete $x->{_a}; delete $x->{_p};
  1         1  
1651             }
1652              
1653 1         3 $x;
1654             }
1655              
1656             sub bnok {
1657             # set up parameters
1658 4956     4956 1 34848 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1659              
1660             # objectify is costly, so avoid it
1661 4956 100 66     21640 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1662 2478         7300 ($class, $x, $y, @r) = objectify(2, @_);
1663             }
1664              
1665 4956 100 100     28924 return $x->bnan() if $x->is_nan() || $y->is_nan();
1666 4932 50 66     54387 return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
      66        
      33        
1667             ($y->is_finite() && !$y->is_int()));
1668              
1669 4932         42299 my $xint = Math::BigInt -> new($x -> bstr());
1670 4932         334146 my $yint = Math::BigInt -> new($y -> bstr());
1671 4932         314288 $xint -> bnok($yint);
1672 4932         3157981 my $xrat = Math::BigRat -> new($xint);
1673              
1674 4932         9535 $x -> {sign} = $xrat -> {sign};
1675 4932         9104 $x -> {_n} = $xrat -> {_n};
1676 4932         8436 $x -> {_d} = $xrat -> {_d};
1677              
1678 4932         71064 return $x;
1679             }
1680              
1681             sub broot {
1682             # set up parameters
1683 7     7 1 55 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1684             # objectify is costly, so avoid it
1685 7 100 66     37 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1686 5         36 ($class, $x, $y, @r) = objectify(2, @_);
1687             }
1688              
1689             # Convert $x into a Math::BigFloat.
1690              
1691 7         54 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1692 7         485 my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd);
1693 7         2736 $xflt -> {sign} = $x -> {sign};
1694              
1695             # Convert $y into a Math::BigFloat.
1696              
1697 7         20 my $yd = Math::BigFloat -> new($LIB -> _str($y->{_d}));
1698 7         471 my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd);
1699 7         1585 $yflt -> {sign} = $y -> {sign};
1700              
1701             # Compute the root and convert back to a Math::BigRat.
1702              
1703 7         28 $xflt -> broot($yflt, @r);
1704 7         277229 my $xtmp = Math::BigRat -> new($xflt -> bsstr());
1705              
1706 7         17 $x -> {sign} = $xtmp -> {sign};
1707 7         13 $x -> {_n} = $xtmp -> {_n};
1708 7         16 $x -> {_d} = $xtmp -> {_d};
1709              
1710 7         66 return $x;
1711             }
1712              
1713             sub bmodpow {
1714             # set up parameters
1715 19     19 1 138 my ($class, $x, $y, $m, @r) = (ref($_[0]), @_);
1716             # objectify is costly, so avoid it
1717 19 50 33     92 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1718 0         0 ($class, $x, $y, $m, @r) = objectify(3, @_);
1719             }
1720              
1721             # Convert $x, $y, and $m into Math::BigInt objects.
1722              
1723 19         56 my $xint = Math::BigInt -> new($x -> copy() -> bint());
1724 19         1337 my $yint = Math::BigInt -> new($y -> copy() -> bint());
1725 19         1195 my $mint = Math::BigInt -> new($m -> copy() -> bint());
1726              
1727 19         1151 $xint -> bmodpow($yint, $mint, @r);
1728 19         64115 my $xtmp = Math::BigRat -> new($xint -> bsstr());
1729              
1730 19         44 $x -> {sign} = $xtmp -> {sign};
1731 19         42 $x -> {_n} = $xtmp -> {_n};
1732 19         39 $x -> {_d} = $xtmp -> {_d};
1733 19         268 return $x;
1734             }
1735              
1736             sub bmodinv {
1737             # set up parameters
1738 17     17 1 114 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1739             # objectify is costly, so avoid it
1740 17 50 33     76 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1741 0         0 ($class, $x, $y, @r) = objectify(2, @_);
1742             }
1743              
1744             # Convert $x and $y into Math::BigInt objects.
1745              
1746 17         43 my $xint = Math::BigInt -> new($x -> copy() -> bint());
1747 17         1122 my $yint = Math::BigInt -> new($y -> copy() -> bint());
1748              
1749 17         1068 $xint -> bmodinv($yint, @r);
1750 17         5439 my $xtmp = Math::BigRat -> new($xint -> bsstr());
1751              
1752 17         47 $x -> {sign} = $xtmp -> {sign};
1753 17         34 $x -> {_n} = $xtmp -> {_n};
1754 17         26 $x -> {_d} = $xtmp -> {_d};
1755 17         232 return $x;
1756             }
1757              
1758             sub bsqrt {
1759 20 50   20 1 165 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1760              
1761 20 100       83 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1762 16 100       52 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1763 15 100 100     40 return $x->round(@r) if $x->is_zero() || $x->is_one();
1764              
1765 13         20 my $n = $x -> {_n};
1766 13         31 my $d = $x -> {_d};
1767              
1768             # Look for an exact solution. For the numerator and the denominator, take
1769             # the square root and square it and see if we got the original value. If we
1770             # did, for both the numerator and the denominator, we have an exact
1771             # solution.
1772              
1773             {
1774 13         20 my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n));
  13         34  
1775 13         1106 my $n2 = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt);
1776 13 100       247 if ($LIB -> _acmp($n, $n2) == 0) {
1777 11         95 my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d));
1778 11         152 my $d2 = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt);
1779 11 100       121 if ($LIB -> _acmp($d, $d2) == 0) {
1780 10         66 $x -> {_n} = $nsqrt;
1781 10         15 $x -> {_d} = $dsqrt;
1782 10         25 return $x->round(@r);
1783             }
1784             }
1785             }
1786              
1787 3         34 local $Math::BigFloat::upgrade = undef;
1788 3         21 local $Math::BigFloat::downgrade = undef;
1789 3         7 local $Math::BigFloat::precision = undef;
1790 3         5 local $Math::BigFloat::accuracy = undef;
1791 3         6 local $Math::BigInt::upgrade = undef;
1792 3         5 local $Math::BigInt::precision = undef;
1793 3         7 local $Math::BigInt::accuracy = undef;
1794              
1795 3         11 my $xn = Math::BigFloat -> new($LIB -> _str($n));
1796 3         252 my $xd = Math::BigFloat -> new($LIB -> _str($d));
1797              
1798 3         343 my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());
1799              
1800 3         10 $x -> {sign} = $xtmp -> {sign};
1801 3         7 $x -> {_n} = $xtmp -> {_n};
1802 3         4 $x -> {_d} = $xtmp -> {_d};
1803              
1804 3         20 $x->round(@r);
1805             }
1806              
1807             sub blsft {
1808 0     0 1 0 my ($class, $x, $y, $b) = objectify(2, @_);
1809              
1810 0 0       0 $b = 2 if !defined $b;
1811 0 0 0     0 $b = $class -> new($b) unless ref($b) && $b -> isa($class);
1812              
1813 0 0 0     0 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
      0        
1814              
1815             # shift by a negative amount?
1816 0 0       0 return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
1817              
1818 0         0 $x -> bmul($b -> bpow($y));
1819             }
1820              
1821             sub brsft {
1822 0     0 1 0 my ($class, $x, $y, $b) = objectify(2, @_);
1823              
1824 0 0       0 $b = 2 if !defined $b;
1825 0 0 0     0 $b = $class -> new($b) unless ref($b) && $b -> isa($class);
1826              
1827 0 0 0     0 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
      0        
1828              
1829             # shift by a negative amount?
1830 0 0       0 return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
1831              
1832             # the following call to bdiv() will return either quotient (scalar context)
1833             # or quotient and remainder (list context).
1834 0         0 $x -> bdiv($b -> bpow($y));
1835             }
1836              
1837             sub band {
1838 289     289 1 473 my $x = shift;
1839 289         502 my $xref = ref($x);
1840 289   33     524 my $class = $xref || $x;
1841              
1842 289 50       472 croak 'band() is an instance method, not a class method' unless $xref;
1843 289 50       729 croak 'Not enough arguments for band()' if @_ < 1;
1844              
1845 289         398 my $y = shift;
1846 289 50       588 $y = $class -> new($y) unless ref($y);
1847              
1848 289         501 my @r = @_;
1849              
1850 289         1042 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1851 289         17237 $xtmp -> band($y);
1852 289         35921 $xtmp = $class -> new($xtmp); # back to Math::BigRat
1853              
1854 289         664 $x -> {sign} = $xtmp -> {sign};
1855 289         577 $x -> {_n} = $xtmp -> {_n};
1856 289         506 $x -> {_d} = $xtmp -> {_d};
1857              
1858 289         816 return $x -> round(@r);
1859             }
1860              
1861             sub bior {
1862 289     289 1 445 my $x = shift;
1863 289         656 my $xref = ref($x);
1864 289   33     754 my $class = $xref || $x;
1865              
1866 289 50       547 croak 'bior() is an instance method, not a class method' unless $xref;
1867 289 50       716 croak 'Not enough arguments for bior()' if @_ < 1;
1868              
1869 289         398 my $y = shift;
1870 289 50       558 $y = $class -> new($y) unless ref($y);
1871              
1872 289         498 my @r = @_;
1873              
1874 289         958 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1875 289         16924 $xtmp -> bior($y);
1876 289         37358 $xtmp = $class -> new($xtmp); # back to Math::BigRat
1877              
1878 289         656 $x -> {sign} = $xtmp -> {sign};
1879 289         517 $x -> {_n} = $xtmp -> {_n};
1880 289         512 $x -> {_d} = $xtmp -> {_d};
1881              
1882 289         662 return $x -> round(@r);
1883             }
1884              
1885             sub bxor {
1886 289     289 1 378 my $x = shift;
1887 289         379 my $xref = ref($x);
1888 289   33     485 my $class = $xref || $x;
1889              
1890 289 50       433 croak 'bxor() is an instance method, not a class method' unless $xref;
1891 289 50       486 croak 'Not enough arguments for bxor()' if @_ < 1;
1892              
1893 289         317 my $y = shift;
1894 289 50       482 $y = $class -> new($y) unless ref($y);
1895              
1896 289         464 my @r = @_;
1897              
1898 289         580 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1899 289         16758 $xtmp -> bxor($y);
1900 289         34508 $xtmp = $class -> new($xtmp); # back to Math::BigRat
1901              
1902 289         925 $x -> {sign} = $xtmp -> {sign};
1903 289         444 $x -> {_n} = $xtmp -> {_n};
1904 289         384 $x -> {_d} = $xtmp -> {_d};
1905              
1906 289         534 return $x -> round(@r);
1907             }
1908              
1909             sub bnot {
1910 0     0 1 0 my $x = shift;
1911 0         0 my $xref = ref($x);
1912 0   0     0 my $class = $xref || $x;
1913              
1914 0 0       0 croak 'bnot() is an instance method, not a class method' unless $xref;
1915              
1916 0         0 my @r = @_;
1917              
1918 0         0 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1919 0         0 $xtmp -> bnot();
1920 0         0 $xtmp = $class -> new($xtmp); # back to Math::BigRat
1921              
1922 0         0 $x -> {sign} = $xtmp -> {sign};
1923 0         0 $x -> {_n} = $xtmp -> {_n};
1924 0         0 $x -> {_d} = $xtmp -> {_d};
1925              
1926 0         0 return $x -> round(@r);
1927             }
1928              
1929             ##############################################################################
1930             # round
1931              
1932             sub round {
1933 1252     1252 1 2012 my $x = shift;
1934 1252 0 33     2339 return $downgrade -> new($x) if defined($downgrade) &&
      66        
1935             ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
1936 1250         11340 $x;
1937             }
1938              
1939             sub bround {
1940 4     4 1 6 my $x = shift;
1941 4 50 66     14 return $downgrade -> new($x) if defined($downgrade) &&
      33        
1942             ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
1943 0         0 $x;
1944             }
1945              
1946             sub bfround {
1947 4     4 1 6 my $x = shift;
1948 4 50 66     12 return $downgrade -> new($x) if defined($downgrade) &&
      33        
1949             ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
1950 0         0 $x;
1951             }
1952              
1953             ##############################################################################
1954             # comparing
1955              
1956             sub bcmp {
1957             # compare two signed numbers
1958              
1959             # set up parameters
1960 154     154 1 21893 my ($class, $x, $y) = (ref($_[0]), @_);
1961              
1962             # objectify is costly, so avoid it
1963 154 100 100     486 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1964 136         293 ($class, $x, $y) = objectify(2, @_);
1965             }
1966              
1967 154 100 66     1601 if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
1968             # $x is NaN and/or $y is NaN
1969 16 50 33     51 return if $x->{sign} eq $nan || $y->{sign} eq $nan;
1970             # $x and $y are both either +inf or -inf
1971 16 50 33     118 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1972             # $x = +inf and $y < +inf
1973 0 0       0 return +1 if $x->{sign} eq '+inf';
1974             # $x = -inf and $y > -inf
1975 0 0       0 return -1 if $x->{sign} eq '-inf';
1976             # $x < +inf and $y = +inf
1977 0 0       0 return -1 if $y->{sign} eq '+inf';
1978             # $x > -inf and $y = -inf
1979 0         0 return +1;
1980             }
1981              
1982             # $x >= 0 and $y < 0
1983 138 100 100     477 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';
1984             # $x < 0 and $y >= 0
1985 124 100 100     373 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';
1986              
1987             # At this point, we know that $x and $y have the same sign.
1988              
1989             # shortcut
1990 113         258 my $xz = $LIB->_is_zero($x->{_n});
1991 113         570 my $yz = $LIB->_is_zero($y->{_n});
1992 113 100 100     708 return 0 if $xz && $yz; # 0 <=> 0
1993 58 100 66     143 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1994 55 50 33     131 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1995              
1996 55         152 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
1997 55         846 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
1998              
1999 55         625 my $cmp = $LIB->_acmp($t, $u); # signs are equal
2000 55 100       316 $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
2001 55         186 $cmp;
2002             }
2003              
2004             sub bacmp {
2005             # compare two numbers (as unsigned)
2006              
2007             # set up parameters
2008 50     50 1 314 my ($class, $x, $y) = (ref($_[0]), @_);
2009             # objectify is costly, so avoid it
2010 50 50 33     214 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
2011 0         0 ($class, $x, $y) = objectify(2, @_);
2012             }
2013              
2014 50 100 100     214 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
2015             # handle +-inf and NaN
2016 35 100 100     170 return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
2017 28 100 100     135 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
2018 24 100 66     208 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
2019 12         129 return -1;
2020             }
2021              
2022 15         49 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
2023 15         245 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
2024 15         220 $LIB->_acmp($t, $u); # ignore signs
2025             }
2026              
2027             sub beq {
2028 10     10 1 19 my $self = shift;
2029 10         18 my $selfref = ref $self;
2030             #my $class = $selfref || $self;
2031              
2032 10 50       24 croak 'beq() is an instance method, not a class method' unless $selfref;
2033 10 50       32 croak 'Wrong number of arguments for beq()' unless @_ == 1;
2034              
2035 10         29 my $cmp = $self -> bcmp(shift);
2036 10   66     87 return defined($cmp) && ! $cmp;
2037             }
2038              
2039             sub bne {
2040 0     0 1 0 my $self = shift;
2041 0         0 my $selfref = ref $self;
2042             #my $class = $selfref || $self;
2043              
2044 0 0       0 croak 'bne() is an instance method, not a class method' unless $selfref;
2045 0 0       0 croak 'Wrong number of arguments for bne()' unless @_ == 1;
2046              
2047 0         0 my $cmp = $self -> bcmp(shift);
2048 0 0 0     0 return defined($cmp) && ! $cmp ? '' : 1;
2049             }
2050              
2051             sub blt {
2052 24     24 1 41 my $self = shift;
2053 24         41 my $selfref = ref $self;
2054             #my $class = $selfref || $self;
2055              
2056 24 50       57 croak 'blt() is an instance method, not a class method' unless $selfref;
2057 24 50       68 croak 'Wrong number of arguments for blt()' unless @_ == 1;
2058              
2059 24         46 my $cmp = $self -> bcmp(shift);
2060 24   66     183 return defined($cmp) && $cmp < 0;
2061             }
2062              
2063             sub ble {
2064 0     0 1 0 my $self = shift;
2065 0         0 my $selfref = ref $self;
2066             #my $class = $selfref || $self;
2067              
2068 0 0       0 croak 'ble() is an instance method, not a class method' unless $selfref;
2069 0 0       0 croak 'Wrong number of arguments for ble()' unless @_ == 1;
2070              
2071 0         0 my $cmp = $self -> bcmp(shift);
2072 0   0     0 return defined($cmp) && $cmp <= 0;
2073             }
2074              
2075             sub bgt {
2076 29     29 1 52 my $self = shift;
2077 29         48 my $selfref = ref $self;
2078             #my $class = $selfref || $self;
2079              
2080 29 50       68 croak 'bgt() is an instance method, not a class method' unless $selfref;
2081 29 50       69 croak 'Wrong number of arguments for bgt()' unless @_ == 1;
2082              
2083 29         107 my $cmp = $self -> bcmp(shift);
2084 29   66     228 return defined($cmp) && $cmp > 0;
2085             }
2086              
2087             sub bge {
2088 0     0 1 0 my $self = shift;
2089 0         0 my $selfref = ref $self;
2090             #my $class = $selfref || $self;
2091              
2092 0 0       0 croak 'bge() is an instance method, not a class method'
2093             unless $selfref;
2094 0 0       0 croak 'Wrong number of arguments for bge()' unless @_ == 1;
2095              
2096 0         0 my $cmp = $self -> bcmp(shift);
2097 0   0     0 return defined($cmp) && $cmp >= 0;
2098             }
2099              
2100             ##############################################################################
2101             # output conversion
2102              
2103             sub numify {
2104             # convert 17/8 => float (aka 2.125)
2105 20 50   20 1 86 my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2106              
2107             # Non-finite number.
2108              
2109 20 100       55 if ($x -> is_nan()) {
2110 1         12 require Math::Complex;
2111 1         2 my $inf = $Math::Complex::Inf;
2112 1         3 return $inf - $inf;
2113             }
2114              
2115 19 100       132 if ($x -> is_inf()) {
2116 2         25 require Math::Complex;
2117 2         4 my $inf = $Math::Complex::Inf;
2118 2 100       14 return $x -> is_negative() ? -$inf : $inf;
2119             }
2120              
2121             # Finite number.
2122              
2123             my $abs = $LIB->_is_one($x->{_d})
2124             ? $LIB->_num($x->{_n})
2125             : Math::BigFloat -> new($LIB->_str($x->{_n}))
2126 17 100       121 -> bdiv($LIB->_str($x->{_d}))
2127             -> bstr();
2128 17 100       7134 return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
2129             }
2130              
2131             sub as_int {
2132 883 50   883 1 23147 my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2133              
2134             # NaN, inf etc
2135 883 100       2725 return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
2136              
2137 877         2788 my $u = Math::BigInt->bzero();
2138 877         38610 $u->{value} = $LIB->_div($LIB->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
2139 877 100       12766 $u->bneg if $x->{sign} eq '-'; # no negative zero
2140 877         1960 $u;
2141             }
2142              
2143             sub as_float {
2144             # return N/D as Math::BigFloat
2145              
2146             # set up parameters
2147 3     3 1 19 my ($class, $x, @r) = (ref($_[0]), @_);
2148             # objectify is costly, so avoid it
2149 3 50       8 ($class, $x, @r) = objectify(1, @_) unless ref $_[0];
2150              
2151             # NaN, inf etc
2152 3 50       11 return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
2153              
2154 3         8 my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n}));
2155 3         233 $xflt -> {sign} = $x -> {sign};
2156              
2157 3 100       9 unless ($LIB -> _is_one($x->{_d})) {
2158 2         13 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
2159 2         128 $xflt -> bdiv($xd, @r);
2160             }
2161              
2162 3         1015 return $xflt;
2163             }
2164              
2165             sub as_bin {
2166 2 50   2 1 1144 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2167              
2168 2 50       6 return $x unless $x->is_int();
2169              
2170 2         17 my $s = $x->{sign};
2171 2 50       7 $s = '' if $s eq '+';
2172 2         7 $s . $LIB->_as_bin($x->{_n});
2173             }
2174              
2175             sub as_hex {
2176 2 50   2 1 16 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2177              
2178 2 50       8 return $x unless $x->is_int();
2179              
2180 2 50       16 my $s = $x->{sign}; $s = '' if $s eq '+';
  2         6  
2181 2         9 $s . $LIB->_as_hex($x->{_n});
2182             }
2183              
2184             sub as_oct {
2185 2 50   2 1 1168 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2186              
2187 2 50       7 return $x unless $x->is_int();
2188              
2189 2 50       17 my $s = $x->{sign}; $s = '' if $s eq '+';
  2         6  
2190 2         7 $s . $LIB->_as_oct($x->{_n});
2191             }
2192              
2193             ##############################################################################
2194              
2195             sub from_hex {
2196 3     3 1 1481 my $class = shift;
2197              
2198             # The relationship should probably go the otherway, i.e, that new() calls
2199             # from_hex(). Fixme!
2200 3         8 my ($x, @r) = @_;
2201 3         15 $x =~ s|^\s*(?:0?[Xx]_*)?|0x|;
2202 3         13 $class->new($x, @r);
2203             }
2204              
2205             sub from_bin {
2206 3     3 1 1674 my $class = shift;
2207              
2208             # The relationship should probably go the otherway, i.e, that new() calls
2209             # from_bin(). Fixme!
2210 3         8 my ($x, @r) = @_;
2211 3         16 $x =~ s|^\s*(?:0?[Bb]_*)?|0b|;
2212 3         22 $class->new($x, @r);
2213             }
2214              
2215             sub from_oct {
2216 5     5 1 1654 my $class = shift;
2217              
2218             # Why is this different from from_hex() and from_bin()? Fixme!
2219 5         10 my @parts;
2220 5         10 for my $c (@_) {
2221 5         22 push @parts, Math::BigInt->from_oct($c);
2222             }
2223 5         1957 $class->new (@parts);
2224             }
2225              
2226             ##############################################################################
2227             # import
2228              
2229             sub import {
2230 19     19   1168 my $class = shift;
2231 19         32 my @a; # unrecognized arguments
2232 19         32 my $lib_param = '';
2233 19         31 my $lib_value = '';
2234              
2235 19         97 while (@_) {
2236 4         11 my $param = shift;
2237              
2238             # Enable overloading of constants.
2239              
2240 4 100       22 if ($param eq ':constant') {
2241             overload::constant
2242              
2243             integer => sub {
2244 7     7   24 $class -> new(shift);
2245             },
2246              
2247             float => sub {
2248 7     7   25 $class -> new(shift);
2249             },
2250              
2251             binary => sub {
2252             # E.g., a literal 0377 shall result in an object whose value
2253             # is decimal 255, but new("0377") returns decimal 377.
2254 8 100   8   1733 return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
2255 6         20 $class -> new(shift);
2256 1         9 };
2257 1         53 next;
2258             }
2259              
2260             # Upgrading.
2261              
2262 3 50       8 if ($param eq 'upgrade') {
2263 0         0 $class -> upgrade(shift);
2264 0         0 next;
2265             }
2266              
2267             # Downgrading.
2268              
2269 3 100       17 if ($param eq 'downgrade') {
2270 1         7 $class -> downgrade(shift);
2271 1         15 next;
2272             }
2273              
2274             # Accuracy.
2275              
2276 2 50       5 if ($param eq 'accuracy') {
2277 0         0 $class -> accuracy(shift);
2278 0         0 next;
2279             }
2280              
2281             # Precision.
2282              
2283 2 50       6 if ($param eq 'precision') {
2284 0         0 $class -> precision(shift);
2285 0         0 next;
2286             }
2287              
2288             # Rounding mode.
2289              
2290 2 50       4 if ($param eq 'round_mode') {
2291 0         0 $class -> round_mode(shift);
2292 0         0 next;
2293             }
2294              
2295             # Backend library.
2296              
2297 2 50       15 if ($param =~ /^(lib|try|only)\z/) {
2298             # alternative library
2299 2         4 $lib_param = $param; # "lib", "try", or "only"
2300 2         5 $lib_value = shift;
2301 2         6 next;
2302             }
2303              
2304 0 0       0 if ($param eq 'with') {
2305             # alternative class for our private parts()
2306             # XXX: no longer supported
2307             # $LIB = shift() || 'Calc';
2308             # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
2309 0         0 shift;
2310 0         0 next;
2311             }
2312              
2313             # Unrecognized parameter.
2314              
2315 0         0 push @a, $param;
2316             }
2317              
2318 19         139 require Math::BigInt;
2319              
2320 19         41 my @import = ('objectify');
2321 19 100       83 push @import, $lib_param, $lib_value if $lib_param ne '';
2322 19         134 Math::BigInt -> import(@import);
2323              
2324             # find out which one was actually loaded
2325 19         329490 $LIB = Math::BigInt -> config("lib");
2326              
2327             # any non :constant stuff is handled by Exporter (loaded by parent class)
2328             # even if @_ is empty, to give it a chance
2329 19         1272 $class->SUPER::import(@a); # for subclasses
2330 19         18271 $class->export_to_level(1, $class, @a); # need this, too
2331             }
2332              
2333             1;
2334              
2335             __END__