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
13package Math::BigRat;
14
15use 5.006;
16use strict;
17use warnings;
18
19use Carp         qw< carp croak >;
20use Scalar::Util qw< blessed >;
21
22use Math::BigFloat ();
23
24our $VERSION = '0.2624';
25
26our @ISA = qw(Math::BigFloat);
27
28our ($accuracy, $precision, $round_mode, $div_scale,
29     $upgrade, $downgrade, $_trap_nan, $_trap_inf);
30
31use overload
32
33  # overload key: with_assign
34
35  '+'     =>      sub { $_[0] -> copy() -> badd($_[1]); },
36
37  '-'     =>      sub { my $c = $_[0] -> copy;
38                        $_[2] ? $c -> bneg() -> badd( $_[1])
39                              : $c -> bsub($_[1]); },
40
41  '*'     =>      sub { $_[0] -> copy() -> bmul($_[1]); },
42
43  '/'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
44                              : $_[0] -> copy() -> bdiv($_[1]); },
45
46  '%'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
47                              : $_[0] -> copy() -> bmod($_[1]); },
48
49  '**'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
50                              : $_[0] -> copy() -> bpow($_[1]); },
51
52  '<<'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
53                              : $_[0] -> copy() -> blsft($_[1]); },
54
55  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
56                              : $_[0] -> copy() -> brsft($_[1]); },
57
58  # overload key: assign
59
60  '+='    =>      sub { $_[0]->badd($_[1]); },
61
62  '-='    =>      sub { $_[0]->bsub($_[1]); },
63
64  '*='    =>      sub { $_[0]->bmul($_[1]); },
65
66  '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },
67
68  '%='    =>      sub { $_[0]->bmod($_[1]); },
69
70  '**='   =>      sub { $_[0]->bpow($_[1]); },
71
72  '<<='   =>      sub { $_[0]->blsft($_[1]); },
73
74  '>>='   =>      sub { $_[0]->brsft($_[1]); },
75
76#  'x='    =>      sub { },
77
78#  '.='    =>      sub { },
79
80  # overload key: num_comparison
81
82  '<'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
83                              : $_[0] -> blt($_[1]); },
84
85  '<='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
86                              : $_[0] -> ble($_[1]); },
87
88  '>'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
89                              : $_[0] -> bgt($_[1]); },
90
91  '>='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
92                              : $_[0] -> bge($_[1]); },
93
94  '=='    =>      sub { $_[0] -> beq($_[1]); },
95
96  '!='    =>      sub { $_[0] -> bne($_[1]); },
97
98  # overload key: 3way_comparison
99
100  '<=>'   =>      sub { my $cmp = $_[0] -> bcmp($_[1]);
101                        defined($cmp) && $_[2] ? -$cmp : $cmp; },
102
103  '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  '&'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
127                              : $_[0] -> copy() -> band($_[1]); },
128
129  '&='    =>      sub { $_[0] -> band($_[1]); },
130
131  '|'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
132                              : $_[0] -> copy() -> bior($_[1]); },
133
134  '|='    =>      sub { $_[0] -> bior($_[1]); },
135
136  '^'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
137                              : $_[0] -> copy() -> bxor($_[1]); },
138
139  '^='    =>      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  'neg'   =>      sub { $_[0] -> copy() -> bneg(); },
156
157#  '!'     =>      sub { },
158
159  '~'     =>      sub { $_[0] -> copy() -> bnot(); },
160
161#  '~.'    =>      sub { },
162
163  # overload key: mutators
164
165  '++'    =>      sub { $_[0] -> binc() },
166
167  '--'    =>      sub { $_[0] -> bdec() },
168
169  # overload key: func
170
171  'atan2' =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
172                              : $_[0] -> copy() -> batan2($_[1]); },
173
174  'cos'   =>      sub { $_[0] -> copy() -> bcos(); },
175
176  'sin'   =>      sub { $_[0] -> copy() -> bsin(); },
177
178  'exp'   =>      sub { $_[0] -> copy() -> bexp($_[1]); },
179
180  'abs'   =>      sub { $_[0] -> copy() -> babs(); },
181
182  'log'   =>      sub { $_[0] -> copy() -> blog(); },
183
184  'sqrt'  =>      sub { $_[0] -> copy() -> bsqrt(); },
185
186  'int'   =>      sub { $_[0] -> copy() -> bint(); },
187
188  # overload key: conversion
189
190  'bool'  =>      sub { $_[0] -> is_zero() ? '' : 1; },
191
192  '""'    =>      sub { $_[0] -> bstr(); },
193
194  '0+'    =>      sub { $_[0] -> numify(); },
195
196  '='     =>      sub { $_[0]->copy(); },
197
198  ;
199
200BEGIN {
201    *objectify = \&Math::BigInt::objectify;  # inherit this from BigInt
202    *AUTOLOAD  = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
203    *as_number = \&as_int;
204    *is_pos = \&is_positive;
205    *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
224my $LIB = 'Math::BigInt::Calc';
225
226my $nan   = 'NaN';
227#my $class = 'Math::BigRat';
228
229sub isa {
230    return 0 if $_[1] =~ /^Math::Big(Int|Float)/;       # we aren't
231    UNIVERSAL::isa(@_);
232}
233
234##############################################################################
235
236sub new {
237    my $proto    = shift;
238    my $protoref = ref $proto;
239    my $class    = $protoref || $proto;
240
241    # Check the way we are called.
242
243    if ($protoref) {
244        croak("new() is a class method, not an instance method");
245    }
246
247    if (@_ < 1) {
248        #carp("Using new() with no argument is deprecated;",
249        #           " use bzero() or new(0) instead");
250        return $class -> bzero();
251    }
252
253    if (@_ > 2) {
254        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    my ($n, $d) = @_;
261
262    if (@_ == 1 && !defined $n ||
263        @_ == 2 && (!defined $n || !defined $d))
264    {
265        #carp("Use of uninitialized value in new()");
266        return $class -> bzero();
267    }
268
269    # Initialize a new object.
270
271    my $self = bless {}, $class;
272
273    # One or two input arguments may be given. First handle the numerator $n.
274
275    if (ref($n)) {
276        $n = Math::BigFloat -> new($n, undef, undef)
277          unless ($n -> isa('Math::BigRat') ||
278                  $n -> isa('Math::BigInt') ||
279                  $n -> isa('Math::BigFloat'));
280    } else {
281        if (defined $d) {
282            # If the denominator is defined, the numerator is not a string
283            # fraction, e.g., "355/113".
284            $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            if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) {
289                $n = Math::BigFloat -> new($1, undef, undef);
290                $d = Math::BigFloat -> new($2, undef, undef);
291            } else {
292                $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    unless (defined $d) {
302        #return $n -> copy($n)               if $n -> isa('Math::BigRat');
303        if ($n -> isa('Math::BigRat')) {
304            return $downgrade -> new($n)
305              if defined($downgrade) && $n -> is_int();
306            return $class -> copy($n);
307        }
308
309        if ($n -> is_nan()) {
310            return $class -> bnan();
311        }
312
313        if ($n -> is_inf()) {
314            return $class -> binf($n -> sign());
315        }
316
317        if ($n -> isa('Math::BigInt')) {
318            $self -> {_n}   = $LIB -> _new($n -> copy() -> babs(undef, undef)
319                                              -> bstr());
320            $self -> {_d}   = $LIB -> _one();
321            $self -> {sign} = $n -> sign();
322            return $downgrade -> new($n) if defined $downgrade;
323            return $self;
324        }
325
326        if ($n -> isa('Math::BigFloat')) {
327            my $m = $n -> mantissa(undef, undef) -> babs(undef, undef);
328            my $e = $n -> exponent(undef, undef);
329            $self -> {_n} = $LIB -> _new($m -> bstr());
330            $self -> {_d} = $LIB -> _one();
331
332            if ($e > 0) {
333                $self -> {_n} = $LIB -> _lsft($self -> {_n},
334                                              $LIB -> _new($e -> bstr()), 10);
335            } elsif ($e < 0) {
336                $self -> {_d} = $LIB -> _lsft($self -> {_d},
337                                              $LIB -> _new(-$e -> bstr()), 10);
338
339                my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}),
340                                       $self -> {_d});
341                if (!$LIB -> _is_one($gcd)) {
342                    $self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
343                    $self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
344                }
345            }
346
347            $self -> {sign} = $n -> sign();
348            return $downgrade -> new($n, undef, undef)
349              if defined($downgrade) && $n -> is_int();
350            return $self;
351        }
352
353        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    $d = Math::BigFloat -> new($d, undef, undef)
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    if ($n -> is_nan() || $d -> is_nan()) {
367        return $class -> bnan();
368    }
369
370    # At this point neither $n nor $d is a NaN.
371
372    if ($n -> is_zero()) {
373        if ($d -> is_zero()) {     # 0/0 = NaN
374            return $class -> bnan();
375        }
376        return $class -> bzero();
377    }
378
379    if ($d -> is_zero()) {
380        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    $n = $n -> copy();
388    $d = $d -> copy();
389
390    if ($d < 0) {               # make sure denominator is positive
391        $n -> bneg();
392        $d -> bneg();
393    }
394
395    if ($n -> is_inf()) {
396        return $class -> bnan() if $d -> is_inf();      # Inf/Inf = NaN
397        return $class -> binf($n -> sign());
398    }
399
400    # At this point $n is finite.
401
402    return $class -> bzero()            if $d -> is_inf();
403    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    if ($n < 0) {
408        $n -> bneg();
409        $self -> {sign} = '-';
410    } else {
411        $self -> {sign} = '+';
412    }
413
414    if ($n -> isa('Math::BigRat')) {
415
416        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            my $p = $n -> {_n};
425            my $q = $n -> {_d};
426            my $r = $d -> {_n};
427            my $s = $d -> {_d};
428            my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r);
429            my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q);
430            $self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr),
431                                         $LIB -> _div($LIB -> _copy($s), $gcd_sq));
432            $self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
433                                         $LIB -> _div($LIB -> _copy($r), $gcd_pr));
434
435            return $downgrade -> new($n->bstr())
436              if defined($downgrade) && $self -> is_int();
437            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        my $p = $n -> {_n};
443        my $q = $n -> {_d};
444        my $m = $d -> mantissa();
445        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        $self -> {_n} = $LIB -> _copy($p);
460        $self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m);
461        if ($e > 0) {
462            $self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10);
463        } elsif ($e < 0) {
464            $self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10);
465        }
466
467        return $self -> bnorm();
468
469    } else {
470
471        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            my $m = $n -> mantissa();
477            my $e = $n -> exponent();
478            my $p = $d -> {_n};
479            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            $self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m);
494            $self -> {_d} = $LIB -> _copy($p);
495            if ($e > 0) {
496                $self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10);
497            } elsif ($e < 0) {
498                $self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10);
499            }
500            return $self -> bnorm();
501
502        } else {
503
504            # At this point $n and $d are both a Math::Big(Int|Float)
505
506            my $m1 = $n -> mantissa();
507            my $e1 = $n -> exponent();
508            my $m2 = $d -> mantissa();
509            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            $self -> {_n} = $LIB -> _new($m1 -> bstr());
526            $self -> {_d} = $LIB -> _new($m2 -> bstr());
527            my $ediff = $e1 - $e2;
528            if ($ediff > 0) {
529                $self -> {_n} = $LIB -> _lsft($self -> {_n},
530                                              $LIB -> _new($ediff -> bstr()),
531                                              10);
532            } elsif ($ediff < 0) {
533                $self -> {_d} = $LIB -> _lsft($self -> {_d},
534                                              $LIB -> _new(-$ediff -> bstr()),
535                                              10);
536            }
537
538            return $self -> bnorm();
539        }
540    }
541
542    return $downgrade -> new($self -> bstr())
543      if defined($downgrade) && $self -> is_int();
544    return $self;
545}
546
547sub copy {
548    my $self    = shift;
549    my $selfref = ref $self;
550    my $class   = $selfref || $self;
551
552    # If called as a class method, the object to copy is the next argument.
553
554    $self = shift() unless $selfref;
555
556    my $copy = bless {}, $class;
557
558    $copy->{sign} = $self->{sign};
559    $copy->{_d} = $LIB->_copy($self->{_d});
560    $copy->{_n} = $LIB->_copy($self->{_n});
561    $copy->{_a} = $self->{_a} if defined $self->{_a};
562    $copy->{_p} = $self->{_p} if defined $self->{_p};
563
564    #($copy, $copy->{_a}, $copy->{_p})
565    #  = $copy->_find_round_parameters(@_);
566
567    return $copy;
568}
569
570sub bnan {
571    my $self    = shift;
572    my $selfref = ref $self;
573    my $class   = $selfref || $self;
574
575    $self = bless {}, $class unless $selfref;
576
577    if ($_trap_nan) {
578        croak ("Tried to set a variable to NaN in $class->bnan()");
579    }
580
581    return $downgrade -> bnan() if defined $downgrade;
582
583    $self -> {sign} = $nan;
584    $self -> {_n}   = $LIB -> _zero();
585    $self -> {_d}   = $LIB -> _one();
586
587    ($self, $self->{_a}, $self->{_p})
588      = $self->_find_round_parameters(@_);
589
590    return $self;
591}
592
593sub binf {
594    my $self    = shift;
595    my $selfref = ref $self;
596    my $class   = $selfref || $self;
597
598    $self = bless {}, $class unless $selfref;
599
600    my $sign = shift();
601    $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf';
602
603    if ($_trap_inf) {
604        croak ("Tried to set a variable to +-inf in $class->binf()");
605    }
606
607    return $downgrade -> binf($sign) if defined $downgrade;
608
609    $self -> {sign} = $sign;
610    $self -> {_n}   = $LIB -> _zero();
611    $self -> {_d}   = $LIB -> _one();
612
613    ($self, $self->{_a}, $self->{_p})
614      = $self->_find_round_parameters(@_);
615
616    return $self;
617}
618
619sub bone {
620    my $self    = shift;
621    my $selfref = ref $self;
622    my $class   = $selfref || $self;
623
624    my $sign = shift();
625    $sign = '+' unless defined($sign) && $sign eq '-';
626
627    return $downgrade -> bone($sign) if defined $downgrade;
628
629    $self = bless {}, $class unless $selfref;
630    $self -> {sign} = $sign;
631    $self -> {_n}   = $LIB -> _one();
632    $self -> {_d}   = $LIB -> _one();
633
634    ($self, $self->{_a}, $self->{_p})
635      = $self->_find_round_parameters(@_);
636
637    return $self;
638}
639
640sub bzero {
641    my $self    = shift;
642    my $selfref = ref $self;
643    my $class   = $selfref || $self;
644
645    return $downgrade -> bzero() if defined $downgrade;
646
647    $self = bless {}, $class unless $selfref;
648    $self -> {sign} = '+';
649    $self -> {_n}   = $LIB -> _zero();
650    $self -> {_d}   = $LIB -> _one();
651
652    ($self, $self->{_a}, $self->{_p})
653      = $self->_find_round_parameters(@_);
654
655    return $self;
656}
657
658##############################################################################
659
660sub config {
661    # return (later set?) configuration data as hash ref
662    my $class = shift() || 'Math::BigRat';
663
664    if (@_ == 1 && ref($_[0]) ne 'HASH') {
665        my $cfg = $class->SUPER::config();
666        return $cfg->{$_[0]};
667    }
668
669    my $cfg = $class->SUPER::config(@_);
670
671    # now we need only to override the ones that are different from our parent
672    $cfg->{class} = $class;
673    $cfg->{with}  = $LIB;
674
675    $cfg;
676}
677
678###############################################################################
679# String conversion methods
680###############################################################################
681
682sub bstr {
683    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
684
685    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
686
687    # Inf and NaN
688
689    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
690        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
691        return 'inf';                                  # +inf
692    }
693
694    # Upgrade?
695
696    return $upgrade -> bstr($x, @r)
697      if defined($upgrade) && !$x -> isa($class);
698
699    # Finite number
700
701    my $s = '';
702    $s = $x->{sign} if $x->{sign} ne '+';       # '+3/2' => '3/2'
703
704    my $str = $x->{sign} eq '-' ? '-' : '';
705    $str .= $LIB->_str($x->{_n});
706    $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
707    return $str;
708}
709
710sub bsstr {
711    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
712
713    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
714
715    # Inf and NaN
716
717    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
718        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
719        return 'inf';                                   # +inf
720    }
721
722    # Upgrade?
723
724    return $upgrade -> bsstr($x, @r)
725      if defined($upgrade) && !$x -> isa($class);
726
727    # Finite number
728
729    my $str = $x->{sign} eq '-' ? '-' : '';
730    $str .= $LIB->_str($x->{_n});
731    $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
732    return $str;
733}
734
735sub bfstr {
736    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
737
738    carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
739
740    # Inf and NaN
741
742    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
743        return $x->{sign} unless $x->{sign} eq '+inf';  # -inf, NaN
744        return 'inf';                                   # +inf
745    }
746
747    # Upgrade?
748
749    return $upgrade -> bfstr($x, @r)
750      if defined($upgrade) && !$x -> isa($class);
751
752    # Finite number
753
754    my $str = $x->{sign} eq '-' ? '-' : '';
755    $str .= $LIB->_str($x->{_n});
756    $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
757    return $str;
758}
759
760sub bnorm {
761    # reduce the number to the shortest form
762    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
763
764    # Both parts must be objects of whatever we are using today.
765    if (my $c = $LIB->_check($x->{_n})) {
766        croak("n did not pass the self-check ($c) in bnorm()");
767    }
768    if (my $c = $LIB->_check($x->{_d})) {
769        croak("d did not pass the self-check ($c) in bnorm()");
770    }
771
772    # no normalize for NaN, inf etc.
773    if ($x->{sign} !~ /^[+-]$/) {
774        return $downgrade -> new($x) if defined $downgrade;
775        return $x;
776    }
777
778    # normalize zeros to 0/1
779    if ($LIB->_is_zero($x->{_n})) {
780        return $downgrade -> bzero() if defined($downgrade);
781        $x->{sign} = '+';                               # never leave a -0
782        $x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
783        return $x;
784    }
785
786    # n/1
787    if ($LIB->_is_one($x->{_d})) {
788        return $downgrade -> new($x) if defined($downgrade);
789        return $x;               # no need to reduce
790    }
791
792    # Compute the GCD.
793    my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
794    if (!$LIB->_is_one($gcd)) {
795        $x->{_n} = $LIB->_div($x->{_n}, $gcd);
796        $x->{_d} = $LIB->_div($x->{_d}, $gcd);
797    }
798
799    $x;
800}
801
802##############################################################################
803# sign manipulation
804
805sub bneg {
806    # (BRAT or num_str) return BRAT
807    # negate number or make a negated number from string
808    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
809
810    return $x if $x->modify('bneg');
811
812    # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
813    $x->{sign} =~ tr/+-/-+/
814      unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));
815
816    return $downgrade -> new($x)
817      if defined($downgrade) && $LIB -> _is_one($x->{_d});
818    $x;
819}
820
821##############################################################################
822# mul/add/div etc
823
824sub badd {
825    # add two rational numbers
826
827    # set up parameters
828    my ($class, $x, $y, @r) = (ref($_[0]), @_);
829    # objectify is costly, so avoid it
830    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
831        ($class, $x, $y, @r) = objectify(2, @_);
832    }
833
834    unless ($x -> is_finite() && $y -> is_finite()) {
835        if ($x -> is_nan() || $y -> is_nan()) {
836            return $x -> bnan(@r);
837        } elsif ($x -> is_inf("+")) {
838            return $x -> bnan(@r) if $y -> is_inf("-");
839            return $x -> binf("+", @r);
840        } elsif ($x -> is_inf("-")) {
841            return $x -> bnan(@r) if $y -> is_inf("+");
842            return $x -> binf("-", @r);
843        } elsif ($y -> is_inf("+")) {
844            return $x -> binf("+", @r);
845        } elsif ($y -> is_inf("-")) {
846            return $x -> binf("-", @r);
847        }
848    }
849
850    #  1   1    gcd(3, 4) = 1    1*3 + 1*4    7
851    #  - + -                  = --------- = --
852    #  4   3                      4*3       12
853
854    # we do not compute the gcd() here, but simple do:
855    #  5   7    5*3 + 7*4   43
856    #  - + -  = --------- = --
857    #  4   3       4*3      12
858
859    # and bnorm() will then take care of the rest
860
861    # 5 * 3
862    $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
863
864    # 7 * 4
865    my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
866
867    # 5 * 3 + 7 * 4
868    ($x->{_n}, $x->{sign}) = $LIB -> _sadd($x->{_n}, $x->{sign}, $m, $y->{sign});
869
870    # 4 * 3
871    $x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});
872
873    # normalize result, and possible round
874    $x->bnorm()->round(@r);
875}
876
877sub bsub {
878    # subtract two rational numbers
879
880    # set up parameters
881    my ($class, $x, $y, @r) = (ref($_[0]), @_);
882    # objectify is costly, so avoid it
883    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
884        ($class, $x, $y, @r) = objectify(2, @_);
885    }
886
887    # flip sign of $x, call badd(), then flip sign of result
888    $x->{sign} =~ tr/+-/-+/
889      unless $x->{sign} eq '+' && $x -> is_zero();      # not -0
890    $x = $x->badd($y, @r);           # does norm and round
891    $x->{sign} =~ tr/+-/-+/
892      unless $x->{sign} eq '+' && $x -> is_zero();      # not -0
893
894    $x->bnorm();
895}
896
897sub bmul {
898    # multiply two rational numbers
899
900    # set up parameters
901    my ($class, $x, $y, @r) = (ref($_[0]), @_);
902    # objectify is costly, so avoid it
903    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
904        ($class, $x, $y, @r) = objectify(2, @_);
905    }
906
907    return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
908
909    # inf handling
910    if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) {
911        return $x->bnan() if $x->is_zero() || $y->is_zero();
912        # result will always be +-inf:
913        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
914        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
915        return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
916        return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
917        return $x->binf('-');
918    }
919
920    # x == 0  # also: or y == 1 or y == -1
921    if ($x -> is_zero()) {
922        $x = $downgrade -> bzero($x) if defined $downgrade;
923        return wantarray ? ($x, $class->bzero()) : $x;
924    }
925
926    if ($y -> is_zero()) {
927        $x = defined($downgrade) ? $downgrade -> bzero($x) : $x -> bzero();
928        return wantarray ? ($x, $class->bzero()) : $x;
929    }
930
931    # According to Knuth, this can be optimized by doing gcd twice (for d
932    # and n) and reducing in one step. This saves us a bnorm() at the end.
933    #
934    # p   s    p * s    (p / gcd(p, r)) * (s / gcd(s, q))
935    # - * -  = ----- =  ---------------------------------
936    # q   r    q * r    (q / gcd(s, q)) * (r / gcd(p, r))
937
938    my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d});
939    my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});
940
941    $x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
942                            scalar $LIB -> _div($LIB -> _copy($y->{_n}),
943                                                $gcd_sq));
944    $x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
945                            scalar $LIB -> _div($LIB -> _copy($y->{_d}),
946                                                $gcd_pr));
947
948    # compute new sign
949    $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
950
951    $x->bnorm()->round(@r);
952}
953
954sub bdiv {
955    # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
956    # (BRAT, BRAT) (quo, rem) or BRAT (only rem)
957
958    # set up parameters
959    my ($class, $x, $y, @r) = (ref($_[0]), @_);
960    # objectify is costly, so avoid it
961    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
962        ($class, $x, $y, @r) = objectify(2, @_);
963    }
964
965    return $x if $x->modify('bdiv');
966
967    my $wantarray = wantarray;  # call only once
968
969    # At least one argument is NaN. This is handled the same way as in
970    # Math::BigInt -> bdiv(). See the comments in the code implementing that
971    # method.
972
973    if ($x -> is_nan() || $y -> is_nan()) {
974        if ($wantarray) {
975            return $downgrade -> bnan(), $downgrade -> bnan()
976              if defined($downgrade);
977            return $x -> bnan(), $class -> bnan();
978        } else {
979            return $downgrade -> bnan()
980              if defined($downgrade);
981            return $x -> bnan();
982        }
983    }
984
985    # Divide by zero and modulo zero. This is handled the same way as in
986    # Math::BigInt -> bdiv(). See the comments in the code implementing that
987    # method.
988
989    if ($y -> is_zero()) {
990        my ($quo, $rem);
991        if ($wantarray) {
992            $rem = $x -> copy();
993        }
994        if ($x -> is_zero()) {
995            $quo = $x -> bnan();
996        } else {
997            $quo = $x -> binf($x -> {sign});
998        }
999
1000        $quo = $downgrade -> new($quo)
1001          if defined($downgrade) && $quo -> is_int();
1002        $rem = $downgrade -> new($rem)
1003          if $wantarray && defined($downgrade) && $rem -> is_int();
1004        return $wantarray ? ($quo, $rem) : $quo;
1005    }
1006
1007    # Numerator (dividend) is +/-inf. This is handled the same way as in
1008    # Math::BigInt -> bdiv(). See the comments in the code implementing that
1009    # method.
1010
1011    if ($x -> is_inf()) {
1012        my ($quo, $rem);
1013        $rem = $class -> bnan() if $wantarray;
1014        if ($y -> is_inf()) {
1015            $quo = $x -> bnan();
1016        } else {
1017            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
1018            $quo = $x -> binf($sign);
1019        }
1020
1021        $quo = $downgrade -> new($quo)
1022          if defined($downgrade) && $quo -> is_int();
1023        $rem = $downgrade -> new($rem)
1024          if $wantarray && defined($downgrade) && $rem -> is_int();
1025        return $wantarray ? ($quo, $rem) : $quo;
1026    }
1027
1028    # Denominator (divisor) is +/-inf. This is handled the same way as in
1029    # Math::BigFloat -> bdiv(). See the comments in the code implementing that
1030    # method.
1031
1032    if ($y -> is_inf()) {
1033        my ($quo, $rem);
1034        if ($wantarray) {
1035            if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
1036                $rem = $x -> copy();
1037                $quo = $x -> bzero();
1038            } else {
1039                $rem = $class -> binf($y -> {sign});
1040                $quo = $x -> bone('-');
1041            }
1042            $quo = $downgrade -> new($quo)
1043              if defined($downgrade) && $quo -> is_int();
1044            $rem = $downgrade -> new($rem)
1045              if defined($downgrade) && $rem -> is_int();
1046            return ($quo, $rem);
1047        } else {
1048            if ($y -> is_inf()) {
1049                if ($x -> is_nan() || $x -> is_inf()) {
1050                    return $downgrade -> bnan() if defined $downgrade;
1051                    return $x -> bnan();
1052                } else {
1053                    return $downgrade -> bzero() if defined $downgrade;
1054                    return $x -> bzero();
1055                }
1056            }
1057        }
1058    }
1059
1060    # At this point, both the numerator and denominator are finite numbers, and
1061    # the denominator (divisor) is non-zero.
1062
1063    # x == 0?
1064    if ($x->is_zero()) {
1065        return $wantarray ? ($downgrade -> bzero(), $downgrade -> bzero())
1066                          : $downgrade -> bzero() if defined $downgrade;
1067        return $wantarray ? ($x, $class->bzero()) : $x;
1068    }
1069
1070    # XXX TODO: list context, upgrade
1071    # According to Knuth, this can be optimized by doing gcd twice (for d and n)
1072    # and reducing in one step. This would save us the bnorm() at the end.
1073    #
1074    # p   r    p * s    (p / gcd(p, r)) * (s / gcd(s, q))
1075    # - / -  = ----- =  ---------------------------------
1076    # q   s    q * r    (q / gcd(s, q)) * (r / gcd(p, r))
1077
1078    $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
1079    $x->{_d} = $LIB->_mul($x->{_d}, $y->{_n});
1080
1081    # compute new sign
1082    $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
1083
1084    $x -> bnorm();
1085    if (wantarray) {
1086        my $rem = $x -> copy();
1087        $x = $x -> bfloor();
1088        $x = $x -> round(@r);
1089        $rem = $rem -> bsub($x -> copy()) -> bmul($y);
1090        $x   = $downgrade -> new($x)   if defined($downgrade) && $x -> is_int();
1091        $rem = $downgrade -> new($rem) if defined($downgrade) && $rem -> is_int();
1092        return $x, $rem;
1093    } else {
1094        return $x -> round(@r);
1095    }
1096}
1097
1098sub bmod {
1099    # compute "remainder" (in Perl way) of $x / $y
1100
1101    # set up parameters
1102    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1103    # objectify is costly, so avoid it
1104    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1105        ($class, $x, $y, @r) = objectify(2, @_);
1106    }
1107
1108    return $x if $x->modify('bmod');
1109
1110    # At least one argument is NaN. This is handled the same way as in
1111    # Math::BigInt -> bmod().
1112
1113    if ($x -> is_nan() || $y -> is_nan()) {
1114        return $x -> bnan();
1115    }
1116
1117    # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
1118
1119    if ($y -> is_zero()) {
1120        return $downgrade -> bzero() if defined $downgrade;
1121        return $x;
1122    }
1123
1124    # Numerator (dividend) is +/-inf. This is handled the same way as in
1125    # Math::BigInt -> bmod().
1126
1127    if ($x -> is_inf()) {
1128        return $x -> bnan();
1129    }
1130
1131    # Denominator (divisor) is +/-inf. This is handled the same way as in
1132    # Math::BigInt -> bmod().
1133
1134    if ($y -> is_inf()) {
1135        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
1136            return $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
1137            return $x;
1138        } else {
1139            return $downgrade -> binf($y -> sign()) if defined($downgrade);
1140            return $x -> binf($y -> sign());
1141        }
1142    }
1143
1144    # At this point, both the numerator and denominator are finite numbers, and
1145    # the denominator (divisor) is non-zero.
1146
1147    if ($x->is_zero()) {        # 0 / 7 = 0, mod 0
1148        return $downgrade -> bzero() if defined $downgrade;
1149        return $x;
1150    }
1151
1152    # Compute $x - $y * floor($x/$y). This can probably be optimized by working
1153    # on a lower level.
1154
1155    $x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y));
1156    return $x -> round(@r);
1157}
1158
1159##############################################################################
1160# bdec/binc
1161
1162sub bdec {
1163    # decrement value (subtract 1)
1164    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1165
1166    if ($x->{sign} !~ /^[+-]$/) {       # NaN, inf, -inf
1167        return $downgrade -> new($x) if defined $downgrade;
1168        return $x;
1169    }
1170
1171    if ($x->{sign} eq '-') {
1172        $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
1173    } else {
1174        if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d?
1175        {
1176            # 1/3 -- => -2/3
1177            $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
1178            $x->{sign} = '-';
1179        } else {
1180            $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
1181        }
1182    }
1183    $x->bnorm()->round(@r);
1184}
1185
1186sub binc {
1187    # increment value (add 1)
1188    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1189
1190    if ($x->{sign} !~ /^[+-]$/) {       # NaN, inf, -inf
1191        return $downgrade -> new($x) if defined $downgrade;
1192        return $x;
1193    }
1194
1195    if ($x->{sign} eq '-') {
1196        if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
1197            # -1/3 ++ => 2/3 (overflow at 0)
1198            $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
1199            $x->{sign} = '+';
1200        } else {
1201            $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
1202        }
1203    } else {
1204        $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2
1205    }
1206    $x->bnorm()->round(@r);
1207}
1208
1209sub binv {
1210    my $x = shift;
1211    my @r = @_;
1212
1213    return $x if $x->modify('binv');
1214
1215    return $x              if $x -> is_nan();
1216    return $x -> bzero()   if $x -> is_inf();
1217    return $x -> binf("+") if $x -> is_zero();
1218
1219    ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n});
1220    $x -> round(@r);
1221}
1222
1223##############################################################################
1224# is_foo methods (the rest is inherited)
1225
1226sub is_int {
1227    # return true if arg (BRAT or num_str) is an integer
1228    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1229
1230    return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
1231      $LIB->_is_one($x->{_d});              # x/y && y != 1 => no integer
1232    0;
1233}
1234
1235sub is_zero {
1236    # return true if arg (BRAT or num_str) is zero
1237    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1238
1239    return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n});
1240    0;
1241}
1242
1243sub is_one {
1244    # return true if arg (BRAT or num_str) is +1 or -1 if signis given
1245    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1246
1247    croak "too many arguments for is_one()" if @_ > 2;
1248    my $sign = $_[1] || '';
1249    $sign = '+' if $sign ne '-';
1250    return 1 if ($x->{sign} eq $sign &&
1251                 $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
1252    0;
1253}
1254
1255sub is_odd {
1256    # return true if arg (BFLOAT or num_str) is odd or false if even
1257    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1258
1259    return 1 if ($x->{sign} =~ /^[+-]$/) &&               # NaN & +-inf aren't
1260      ($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1
1261    0;
1262}
1263
1264sub is_even {
1265    # return true if arg (BINT or num_str) is even or false if odd
1266    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1267
1268    return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
1269    return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never
1270                 && $LIB->_is_even($x->{_n})); # but 4/1 is
1271    0;
1272}
1273
1274##############################################################################
1275# parts() and friends
1276
1277sub numerator {
1278    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1279
1280    # NaN, inf, -inf
1281    return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
1282
1283    my $n = Math::BigInt->new($LIB->_str($x->{_n}));
1284    $n->{sign} = $x->{sign};
1285    $n;
1286}
1287
1288sub denominator {
1289    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1290
1291    # NaN
1292    return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
1293    # inf, -inf
1294    return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
1295
1296    Math::BigInt->new($LIB->_str($x->{_d}));
1297}
1298
1299sub parts {
1300    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1301
1302    my $c = 'Math::BigInt';
1303
1304    return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN';
1305    return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf';
1306    return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf';
1307
1308    my $n = $c->new($LIB->_str($x->{_n}));
1309    $n->{sign} = $x->{sign};
1310    my $d = $c->new($LIB->_str($x->{_d}));
1311    ($n, $d);
1312}
1313
1314sub dparts {
1315    my $x = shift;
1316    my $class = ref $x;
1317
1318    croak("dparts() is an instance method") unless $class;
1319
1320    if ($x -> is_nan()) {
1321        return $class -> bnan(), $class -> bnan() if wantarray;
1322        return $class -> bnan();
1323    }
1324
1325    if ($x -> is_inf()) {
1326        return $class -> binf($x -> sign()), $class -> bzero() if wantarray;
1327        return $class -> binf($x -> sign());
1328    }
1329
1330    # 355/113 => 3 + 16/113
1331
1332    my ($q, $r)  = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d});
1333
1334    my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q));
1335    return $int unless wantarray;
1336
1337    my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r),
1338                                  $LIB -> _str($x -> {_d}));
1339
1340    return $int, $frc;
1341}
1342
1343sub fparts {
1344    my $x = shift;
1345    my $class = ref $x;
1346
1347    croak("fparts() is an instance method") unless $class;
1348
1349    return ($class -> bnan(),
1350            $class -> bnan()) if $x -> is_nan();
1351
1352    my $numer = $x -> copy();
1353    my $denom = $class -> bzero();
1354
1355    $denom -> {_n} = $numer -> {_d};
1356    $numer -> {_d} = $LIB -> _one();
1357
1358    return ($numer, $denom);
1359}
1360
1361sub length {
1362    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1363
1364    return $nan unless $x->is_int();
1365    $LIB->_len($x->{_n});       # length(-123/1) => length(123)
1366}
1367
1368sub digit {
1369    my ($class, $x, $n) = ref($_[0]) ? (undef, $_[0], $_[1]) : objectify(1, @_);
1370
1371    return $nan unless $x->is_int();
1372    $LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2)
1373}
1374
1375##############################################################################
1376# special calc routines
1377
1378sub bceil {
1379    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1380
1381    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
1382        $LIB->_is_one($x->{_d}))      # integer
1383    {
1384        return $downgrade -> new($x) if defined $downgrade;
1385        return $x;
1386    }
1387
1388    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
1389    $x->{_d} = $LIB->_one();                    # d => 1
1390    $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+';   # +22/7 => 4/1
1391    $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
1392    return $downgrade -> new($x) if defined $downgrade;
1393    $x;
1394}
1395
1396sub bfloor {
1397    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1398
1399    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
1400        $LIB->_is_one($x->{_d}))      # integer
1401    {
1402        return $downgrade -> new($x) if defined $downgrade;
1403        return $x;
1404    }
1405
1406    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
1407    $x->{_d} = $LIB->_one();                    # d => 1
1408    $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-';   # -22/7 => -4/1
1409    return $downgrade -> new($x) if defined $downgrade;
1410    $x;
1411}
1412
1413sub bint {
1414    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1415
1416    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
1417        $LIB->_is_one($x->{_d}))      # integer
1418    {
1419        return $downgrade -> new($x) if defined $downgrade;
1420        return $x;
1421    }
1422
1423    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
1424    $x->{_d} = $LIB->_one();                    # d => 1
1425    $x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
1426    return $downgrade -> new($x) if defined $downgrade;
1427    return $x;
1428}
1429
1430sub bfac {
1431    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1432
1433    # if $x is not an integer
1434    if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) {
1435        return $x->bnan();
1436    }
1437
1438    $x->{_n} = $LIB->_fac($x->{_n});
1439    # since _d is 1, we don't need to reduce/norm the result
1440    $x->round(@r);
1441}
1442
1443sub bpow {
1444    # power ($x ** $y)
1445
1446    # set up parameters
1447    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1448
1449    # objectify is costly, so avoid it
1450    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1451        ($class, $x, $y, @r) = objectify(2, @_);
1452    }
1453
1454    return $x if $x->modify('bpow');
1455
1456    # $x and/or $y is a NaN
1457    return $x->bnan() if $x->is_nan() || $y->is_nan();
1458
1459    # $x and/or $y is a +/-Inf
1460    if ($x->is_inf("-")) {
1461        return $x->bzero()   if $y->is_negative();
1462        return $x->bnan()    if $y->is_zero();
1463        return $x            if $y->is_odd();
1464        return $x->bneg();
1465    } elsif ($x->is_inf("+")) {
1466        return $x->bzero()   if $y->is_negative();
1467        return $x->bnan()    if $y->is_zero();
1468        return $x;
1469    } elsif ($y->is_inf("-")) {
1470        return $x->bnan()    if $x -> is_one("-");
1471        return $x->binf("+") if $x > -1 && $x < 1;
1472        return $x->bone()    if $x -> is_one("+");
1473        return $x->bzero();
1474    } elsif ($y->is_inf("+")) {
1475        return $x->bnan()    if $x -> is_one("-");
1476        return $x->bzero()   if $x > -1 && $x < 1;
1477        return $x->bone()    if $x -> is_one("+");
1478        return $x->binf("+");
1479    }
1480
1481    if ($x -> is_zero()) {
1482        return $x -> bone() if $y -> is_zero();
1483        return $x -> binf() if $y -> is_negative();
1484        return $x;
1485    }
1486
1487    # We don't support complex numbers, so upgrade or return NaN.
1488
1489    if ($x -> is_negative() && !$y -> is_int()) {
1490        return $upgrade -> bpow($upgrade -> new($x), $y, @r)
1491          if defined $upgrade;
1492        return $x -> bnan();
1493    }
1494
1495    if ($x -> is_one("+") || $y -> is_one()) {
1496        return $x;
1497    }
1498
1499    if ($x -> is_one("-")) {
1500        return $x if $y -> is_odd();
1501        return $x -> bneg();
1502    }
1503
1504    # (a/b)^-(c/d) = (b/a)^(c/d)
1505    ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();
1506
1507    unless ($LIB->_is_one($y->{_n})) {
1508        $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n});
1509        $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n});
1510        $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
1511    }
1512
1513    unless ($LIB->_is_one($y->{_d})) {
1514        return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
1515        return $x->broot($LIB->_str($y->{_d}), @r);      # 1/N => root(N)
1516    }
1517
1518    return $x->round(@r);
1519}
1520
1521sub blog {
1522    # Return the logarithm of the operand. If a second operand is defined, that
1523    # value is used as the base, otherwise the base is assumed to be Euler's
1524    # constant.
1525
1526    my ($class, $x, $base, @r);
1527
1528    # Don't objectify the base, since an undefined base, as in $x->blog() or
1529    # $x->blog(undef) signals that the base is Euler's number.
1530
1531    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
1532        # E.g., Math::BigRat->blog(256, 2)
1533        ($class, $x, $base, @r) =
1534          defined $_[2] ? objectify(2, @_) : objectify(1, @_);
1535    } else {
1536        # E.g., Math::BigRat::blog(256, 2) or $x->blog(2)
1537        ($class, $x, $base, @r) =
1538          defined $_[1] ? objectify(2, @_) : objectify(1, @_);
1539    }
1540
1541    return $x if $x->modify('blog');
1542
1543    # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
1544    # (http://www.wolframalpha.com) as the reference for these cases.
1545
1546    return $x -> bnan() if $x -> is_nan();
1547
1548    if (defined $base) {
1549        $base = $class -> new($base) unless ref $base;
1550        if ($base -> is_nan() || $base -> is_one()) {
1551            return $x -> bnan();
1552        } elsif ($base -> is_inf() || $base -> is_zero()) {
1553            return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
1554            return $x -> bzero();
1555        } elsif ($base -> is_negative()) {        # -inf < base < 0
1556            return $x -> bzero() if $x -> is_one(); #     x = 1
1557            return $x -> bone()  if $x == $base;    #     x = base
1558            return $x -> bnan();                    #     otherwise
1559        }
1560        return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
1561    }
1562
1563    # We now know that the base is either undefined or positive and finite.
1564
1565    if ($x -> is_inf()) {       # x = +/-inf
1566        my $sign = defined $base && $base < 1 ? '-' : '+';
1567        return $x -> binf($sign);
1568    } elsif ($x -> is_neg()) {  # -inf < x < 0
1569        return $x -> bnan();
1570    } elsif ($x -> is_one()) {  # x = 1
1571        return $x -> bzero();
1572    } elsif ($x -> is_zero()) { # x = 0
1573        my $sign = defined $base && $base < 1 ? '+' : '-';
1574        return $x -> binf($sign);
1575    }
1576
1577    # Now take care of the cases where $x and/or $base is 1/N.
1578    #
1579    #   log(1/N) / log(B)   = -log(N)/log(B)
1580    #   log(1/N) / log(1/B) =  log(N)/log(B)
1581    #   log(N)   / log(1/B) = -log(N)/log(B)
1582
1583    my $neg = 0;
1584    if ($x -> numerator() -> is_one()) {
1585        $x -> binv();
1586        $neg = !$neg;
1587    }
1588    if (defined(blessed($base)) && $base -> isa($class)) {
1589        if ($base -> numerator() -> is_one()) {
1590            $base = $base -> copy() -> binv();
1591            $neg = !$neg;
1592        }
1593    }
1594
1595    # disable upgrading and downgrading
1596
1597    require Math::BigFloat;
1598    my $upg = Math::BigFloat -> upgrade();
1599    my $dng = Math::BigFloat -> downgrade();
1600    Math::BigFloat -> upgrade(undef);
1601    Math::BigFloat -> downgrade(undef);
1602
1603    # At this point we are done handling all exception cases and trivial cases.
1604
1605    $base = Math::BigFloat -> new($base) if defined $base;
1606    my $xnum = Math::BigFloat -> new($LIB -> _str($x->{_n}));
1607    my $xden = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1608    my $xstr = $xnum -> bdiv($xden) -> blog($base, @r) -> bsstr();
1609
1610    # reset upgrading and downgrading
1611
1612    Math::BigFloat -> upgrade($upg);
1613    Math::BigFloat -> downgrade($dng);
1614
1615    my $xobj = Math::BigRat -> new($xstr);
1616    $x -> {sign} = $xobj -> {sign};
1617    $x -> {_n}   = $xobj -> {_n};
1618    $x -> {_d}   = $xobj -> {_d};
1619
1620    return $neg ? $x -> bneg() : $x;
1621}
1622
1623sub bexp {
1624    # set up parameters
1625    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1626
1627    # objectify is costly, so avoid it
1628    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1629        ($class, $x, $y, @r) = objectify(1, @_);
1630    }
1631
1632    return $x->binf(@r)  if $x->{sign} eq '+inf';
1633    return $x->bzero(@r) if $x->{sign} eq '-inf';
1634
1635    # we need to limit the accuracy to protect against overflow
1636    my $fallback = 0;
1637    my ($scale, @params);
1638    ($x, @params) = $x->_find_round_parameters(@r);
1639
1640    # also takes care of the "error in _find_round_parameters?" case
1641    return $x if $x->{sign} eq 'NaN';
1642
1643    # no rounding at all, so must use fallback
1644    if (scalar @params == 0) {
1645        # simulate old behaviour
1646        $params[0] = $class->div_scale(); # and round to it as accuracy
1647        $params[1] = undef;              # P = undef
1648        $scale = $params[0]+4;           # at least four more for proper round
1649        $params[2] = $r[2];              # round mode by caller or undef
1650        $fallback = 1;                   # to clear a/p afterwards
1651    } else {
1652        # the 4 below is empirical, and there might be cases where it's not enough...
1653        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
1654    }
1655
1656    return $x->bone(@params) if $x->is_zero();
1657
1658    # See the comments in Math::BigFloat on how this algorithm works.
1659    # Basically we calculate A and B (where B is faculty(N)) so that A/B = e
1660
1661    my $x_org = $x->copy();
1662    if ($scale <= 75) {
1663        # set $x directly from a cached string form
1664        $x->{_n} =
1665          $LIB->_new("90933395208605785401971970164779391644753259799242");
1666        $x->{_d} =
1667          $LIB->_new("33452526613163807108170062053440751665152000000000");
1668        $x->{sign} = '+';
1669    } else {
1670        # compute A and B so that e = A / B.
1671
1672        # After some terms we end up with this, so we use it as a starting point:
1673        my $A = $LIB->_new("90933395208605785401971970164779391644753259799242");
1674        my $F = $LIB->_new(42); my $step = 42;
1675
1676        # Compute how many steps we need to take to get $A and $B sufficiently big
1677        my $steps = Math::BigFloat::_len_to_steps($scale - 4);
1678        #    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
1679        while ($step++ <= $steps) {
1680            # calculate $a * $f + 1
1681            $A = $LIB->_mul($A, $F);
1682            $A = $LIB->_inc($A);
1683            # increment f
1684            $F = $LIB->_inc($F);
1685        }
1686        # compute $B as factorial of $steps (this is faster than doing it manually)
1687        my $B = $LIB->_fac($LIB->_new($steps));
1688
1689        #  print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
1690
1691        $x->{_n} = $A;
1692        $x->{_d} = $B;
1693        $x->{sign} = '+';
1694    }
1695
1696    # $x contains now an estimate of e, with some surplus digits, so we can round
1697    if (!$x_org->is_one()) {
1698        # raise $x to the wanted power and round it in one step:
1699        $x->bpow($x_org, @params);
1700    } else {
1701        # else just round the already computed result
1702        delete $x->{_a}; delete $x->{_p};
1703        # shortcut to not run through _find_round_parameters again
1704        if (defined $params[0]) {
1705            $x->bround($params[0], $params[2]); # then round accordingly
1706        } else {
1707            $x->bfround($params[1], $params[2]); # then round accordingly
1708        }
1709    }
1710    if ($fallback) {
1711        # clear a/p after round, since user did not request it
1712        delete $x->{_a}; delete $x->{_p};
1713    }
1714
1715    $x;
1716}
1717
1718sub bnok {
1719    # set up parameters
1720    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1721
1722    # objectify is costly, so avoid it
1723    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1724        ($class, $x, $y, @r) = objectify(2, @_);
1725    }
1726
1727    return $x->bnan() if $x->is_nan() || $y->is_nan();
1728    return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
1729                          ($y->is_finite() && !$y->is_int()));
1730
1731    my $xint = Math::BigInt -> new($x -> bstr());
1732    my $yint = Math::BigInt -> new($y -> bstr());
1733    $xint -> bnok($yint);
1734    my $xrat = Math::BigRat -> new($xint);
1735
1736    $x -> {sign} = $xrat -> {sign};
1737    $x -> {_n}   = $xrat -> {_n};
1738    $x -> {_d}   = $xrat -> {_d};
1739
1740    return $x;
1741}
1742
1743sub broot {
1744    # set up parameters
1745    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1746    # objectify is costly, so avoid it
1747    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1748        ($class, $x, $y, @r) = objectify(2, @_);
1749    }
1750
1751    # Convert $x into a Math::BigFloat.
1752
1753    my $xd   = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1754    my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd);
1755    $xflt -> {sign} = $x -> {sign};
1756
1757    # Convert $y into a Math::BigFloat.
1758
1759    my $yd   = Math::BigFloat -> new($LIB -> _str($y->{_d}));
1760    my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd);
1761    $yflt -> {sign} = $y -> {sign};
1762
1763    # Compute the root and convert back to a Math::BigRat.
1764
1765    $xflt -> broot($yflt, @r);
1766    my $xtmp = Math::BigRat -> new($xflt -> bsstr());
1767
1768    $x -> {sign} = $xtmp -> {sign};
1769    $x -> {_n}   = $xtmp -> {_n};
1770    $x -> {_d}   = $xtmp -> {_d};
1771
1772    return $x;
1773}
1774
1775sub bmodpow {
1776    # set up parameters
1777    my ($class, $x, $y, $m, @r) = (ref($_[0]), @_);
1778    # objectify is costly, so avoid it
1779    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1780        ($class, $x, $y, $m, @r) = objectify(3, @_);
1781    }
1782
1783    # Convert $x, $y, and $m into Math::BigInt objects.
1784
1785    my $xint = Math::BigInt -> new($x -> copy() -> bint());
1786    my $yint = Math::BigInt -> new($y -> copy() -> bint());
1787    my $mint = Math::BigInt -> new($m -> copy() -> bint());
1788
1789    $xint -> bmodpow($yint, $mint, @r);
1790    my $xtmp = Math::BigRat -> new($xint -> bsstr());
1791
1792    $x -> {sign} = $xtmp -> {sign};
1793    $x -> {_n}   = $xtmp -> {_n};
1794    $x -> {_d}   = $xtmp -> {_d};
1795    return $x;
1796}
1797
1798sub bmodinv {
1799    # set up parameters
1800    my ($class, $x, $y, @r) = (ref($_[0]), @_);
1801    # objectify is costly, so avoid it
1802    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1803        ($class, $x, $y, @r) = objectify(2, @_);
1804    }
1805
1806    # Convert $x and $y into Math::BigInt objects.
1807
1808    my $xint = Math::BigInt -> new($x -> copy() -> bint());
1809    my $yint = Math::BigInt -> new($y -> copy() -> bint());
1810
1811    $xint -> bmodinv($yint, @r);
1812    my $xtmp = Math::BigRat -> new($xint -> bsstr());
1813
1814    $x -> {sign} = $xtmp -> {sign};
1815    $x -> {_n}   = $xtmp -> {_n};
1816    $x -> {_d}   = $xtmp -> {_d};
1817    return $x;
1818}
1819
1820sub bsqrt {
1821    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1822
1823    return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1824    return $x if $x->{sign} eq '+inf';         # sqrt(inf) == inf
1825    return $x->round(@r) if $x->is_zero() || $x->is_one();
1826
1827    my $n = $x -> {_n};
1828    my $d = $x -> {_d};
1829
1830    # Look for an exact solution. For the numerator and the denominator, take
1831    # the square root and square it and see if we got the original value. If we
1832    # did, for both the numerator and the denominator, we have an exact
1833    # solution.
1834
1835    {
1836        my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n));
1837        my $n2    = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt);
1838        if ($LIB -> _acmp($n, $n2) == 0) {
1839            my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d));
1840            my $d2    = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt);
1841            if ($LIB -> _acmp($d, $d2) == 0) {
1842                $x -> {_n} = $nsqrt;
1843                $x -> {_d} = $dsqrt;
1844                return $x->round(@r);
1845            }
1846        }
1847    }
1848
1849    local $Math::BigFloat::upgrade   = undef;
1850    local $Math::BigFloat::downgrade = undef;
1851    local $Math::BigFloat::precision = undef;
1852    local $Math::BigFloat::accuracy  = undef;
1853    local $Math::BigInt::upgrade     = undef;
1854    local $Math::BigInt::precision   = undef;
1855    local $Math::BigInt::accuracy    = undef;
1856
1857    my $xn = Math::BigFloat -> new($LIB -> _str($n));
1858    my $xd = Math::BigFloat -> new($LIB -> _str($d));
1859
1860    my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());
1861
1862    $x -> {sign} = $xtmp -> {sign};
1863    $x -> {_n}   = $xtmp -> {_n};
1864    $x -> {_d}   = $xtmp -> {_d};
1865
1866    $x->round(@r);
1867}
1868
1869sub blsft {
1870    my ($class, $x, $y, $b) = objectify(2, @_);
1871
1872    $b = 2 if !defined $b;
1873    $b = $class -> new($b) unless ref($b) && $b -> isa($class);
1874
1875    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
1876
1877    # shift by a negative amount?
1878    return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
1879
1880    $x -> bmul($b -> bpow($y));
1881}
1882
1883sub brsft {
1884    my ($class, $x, $y, $b) = objectify(2, @_);
1885
1886    $b = 2 if !defined $b;
1887    $b = $class -> new($b) unless ref($b) && $b -> isa($class);
1888
1889    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
1890
1891    # shift by a negative amount?
1892    return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
1893
1894    # the following call to bdiv() will return either quotient (scalar context)
1895    # or quotient and remainder (list context).
1896    $x -> bdiv($b -> bpow($y));
1897}
1898
1899sub band {
1900    my $x     = shift;
1901    my $xref  = ref($x);
1902    my $class = $xref || $x;
1903
1904    croak 'band() is an instance method, not a class method' unless $xref;
1905    croak 'Not enough arguments for band()' if @_ < 1;
1906
1907    my $y = shift;
1908    $y = $class -> new($y) unless ref($y);
1909
1910    my @r = @_;
1911
1912    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
1913    $xtmp -> band($y);
1914    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat
1915
1916    $x -> {sign} = $xtmp -> {sign};
1917    $x -> {_n}   = $xtmp -> {_n};
1918    $x -> {_d}   = $xtmp -> {_d};
1919
1920    return $x -> round(@r);
1921}
1922
1923sub bior {
1924    my $x     = shift;
1925    my $xref  = ref($x);
1926    my $class = $xref || $x;
1927
1928    croak 'bior() is an instance method, not a class method' unless $xref;
1929    croak 'Not enough arguments for bior()' if @_ < 1;
1930
1931    my $y = shift;
1932    $y = $class -> new($y) unless ref($y);
1933
1934    my @r = @_;
1935
1936    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
1937    $xtmp -> bior($y);
1938    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat
1939
1940    $x -> {sign} = $xtmp -> {sign};
1941    $x -> {_n}   = $xtmp -> {_n};
1942    $x -> {_d}   = $xtmp -> {_d};
1943
1944    return $x -> round(@r);
1945}
1946
1947sub bxor {
1948    my $x     = shift;
1949    my $xref  = ref($x);
1950    my $class = $xref || $x;
1951
1952    croak 'bxor() is an instance method, not a class method' unless $xref;
1953    croak 'Not enough arguments for bxor()' if @_ < 1;
1954
1955    my $y = shift;
1956    $y = $class -> new($y) unless ref($y);
1957
1958    my @r = @_;
1959
1960    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
1961    $xtmp -> bxor($y);
1962    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat
1963
1964    $x -> {sign} = $xtmp -> {sign};
1965    $x -> {_n}   = $xtmp -> {_n};
1966    $x -> {_d}   = $xtmp -> {_d};
1967
1968    return $x -> round(@r);
1969}
1970
1971sub bnot {
1972    my $x     = shift;
1973    my $xref  = ref($x);
1974    my $class = $xref || $x;
1975
1976    croak 'bnot() is an instance method, not a class method' unless $xref;
1977
1978    my @r = @_;
1979
1980    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
1981    $xtmp -> bnot();
1982    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat
1983
1984    $x -> {sign} = $xtmp -> {sign};
1985    $x -> {_n}   = $xtmp -> {_n};
1986    $x -> {_d}   = $xtmp -> {_d};
1987
1988    return $x -> round(@r);
1989}
1990
1991##############################################################################
1992# round
1993
1994sub round {
1995    my $x = shift;
1996    return $downgrade -> new($x) if defined($downgrade) &&
1997      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
1998    $x;
1999}
2000
2001sub bround {
2002    my $x = shift;
2003    return $downgrade -> new($x) if defined($downgrade) &&
2004      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
2005    $x;
2006}
2007
2008sub bfround {
2009    my $x = shift;
2010    return $downgrade -> new($x) if defined($downgrade) &&
2011      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
2012    $x;
2013}
2014
2015##############################################################################
2016# comparing
2017
2018sub bcmp {
2019    # compare two signed numbers
2020
2021    # set up parameters
2022    my ($class, $x, $y) = (ref($_[0]), @_);
2023
2024    # objectify is costly, so avoid it
2025    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
2026        ($class, $x, $y) = objectify(2, @_);
2027    }
2028
2029    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
2030        # $x is NaN and/or $y is NaN
2031        return       if $x->{sign} eq $nan || $y->{sign} eq $nan;
2032        # $x and $y are both either +inf or -inf
2033        return  0    if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
2034        # $x = +inf and $y < +inf
2035        return +1    if $x->{sign} eq '+inf';
2036        # $x = -inf and $y > -inf
2037        return -1    if $x->{sign} eq '-inf';
2038        # $x < +inf and $y = +inf
2039        return -1    if $y->{sign} eq '+inf';
2040        # $x > -inf and $y = -inf
2041        return +1;
2042    }
2043
2044    # $x >= 0 and $y < 0
2045    return  1 if $x->{sign} eq '+' && $y->{sign} eq '-';
2046    # $x < 0 and $y >= 0
2047    return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';
2048
2049    # At this point, we know that $x and $y have the same sign.
2050
2051    # shortcut
2052    my $xz = $LIB->_is_zero($x->{_n});
2053    my $yz = $LIB->_is_zero($y->{_n});
2054    return  0 if $xz && $yz;               # 0 <=> 0
2055    return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
2056    return  1 if $yz && $x->{sign} eq '+'; # +x <=> 0
2057
2058    my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
2059    my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
2060
2061    my $cmp = $LIB->_acmp($t, $u);     # signs are equal
2062    $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
2063    $cmp;
2064}
2065
2066sub bacmp {
2067    # compare two numbers (as unsigned)
2068
2069    # set up parameters
2070    my ($class, $x, $y) = (ref($_[0]), @_);
2071    # objectify is costly, so avoid it
2072    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
2073        ($class, $x, $y) = objectify(2, @_);
2074    }
2075
2076    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
2077        # handle +-inf and NaN
2078        return    if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
2079        return  0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
2080        return  1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
2081        return -1;
2082    }
2083
2084    my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
2085    my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
2086    $LIB->_acmp($t, $u);        # ignore signs
2087}
2088
2089sub beq {
2090    my $self    = shift;
2091    my $selfref = ref $self;
2092    #my $class   = $selfref || $self;
2093
2094    croak 'beq() is an instance method, not a class method' unless $selfref;
2095    croak 'Wrong number of arguments for beq()' unless @_ == 1;
2096
2097    my $cmp = $self -> bcmp(shift);
2098    return defined($cmp) && ! $cmp;
2099}
2100
2101sub bne {
2102    my $self    = shift;
2103    my $selfref = ref $self;
2104    #my $class   = $selfref || $self;
2105
2106    croak 'bne() is an instance method, not a class method' unless $selfref;
2107    croak 'Wrong number of arguments for bne()' unless @_ == 1;
2108
2109    my $cmp = $self -> bcmp(shift);
2110    return defined($cmp) && ! $cmp ? '' : 1;
2111}
2112
2113sub blt {
2114    my $self    = shift;
2115    my $selfref = ref $self;
2116    #my $class   = $selfref || $self;
2117
2118    croak 'blt() is an instance method, not a class method' unless $selfref;
2119    croak 'Wrong number of arguments for blt()' unless @_ == 1;
2120
2121    my $cmp = $self -> bcmp(shift);
2122    return defined($cmp) && $cmp < 0;
2123}
2124
2125sub ble {
2126    my $self    = shift;
2127    my $selfref = ref $self;
2128    #my $class   = $selfref || $self;
2129
2130    croak 'ble() is an instance method, not a class method' unless $selfref;
2131    croak 'Wrong number of arguments for ble()' unless @_ == 1;
2132
2133    my $cmp = $self -> bcmp(shift);
2134    return defined($cmp) && $cmp <= 0;
2135}
2136
2137sub bgt {
2138    my $self    = shift;
2139    my $selfref = ref $self;
2140    #my $class   = $selfref || $self;
2141
2142    croak 'bgt() is an instance method, not a class method' unless $selfref;
2143    croak 'Wrong number of arguments for bgt()' unless @_ == 1;
2144
2145    my $cmp = $self -> bcmp(shift);
2146    return defined($cmp) && $cmp > 0;
2147}
2148
2149sub bge {
2150    my $self    = shift;
2151    my $selfref = ref $self;
2152    #my $class   = $selfref || $self;
2153
2154    croak 'bge() is an instance method, not a class method'
2155        unless $selfref;
2156    croak 'Wrong number of arguments for bge()' unless @_ == 1;
2157
2158    my $cmp = $self -> bcmp(shift);
2159    return defined($cmp) && $cmp >= 0;
2160}
2161
2162##############################################################################
2163# output conversion
2164
2165sub numify {
2166    # convert 17/8 => float (aka 2.125)
2167    my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2168
2169    # Non-finite number.
2170
2171    if ($x -> is_nan()) {
2172        require Math::Complex;
2173        my $inf = $Math::Complex::Inf;
2174        return $inf - $inf;
2175    }
2176
2177    if ($x -> is_inf()) {
2178        require Math::Complex;
2179        my $inf = $Math::Complex::Inf;
2180        return $x -> is_negative() ? -$inf : $inf;
2181    }
2182
2183    # Finite number.
2184
2185    my $abs = $LIB->_is_one($x->{_d})
2186            ? $LIB->_num($x->{_n})
2187            : Math::BigFloat -> new($LIB->_str($x->{_n}))
2188                             -> bdiv($LIB->_str($x->{_d}))
2189                             -> bstr();
2190    return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
2191}
2192
2193sub as_int {
2194    my ($class, $x) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
2195
2196    return $x -> copy() if $x -> isa("Math::BigInt");
2197
2198    # disable upgrading and downgrading
2199
2200    require Math::BigInt;
2201    my $upg = Math::BigInt -> upgrade();
2202    my $dng = Math::BigInt -> downgrade();
2203    Math::BigInt -> upgrade(undef);
2204    Math::BigInt -> downgrade(undef);
2205
2206    my $y;
2207    if ($x -> is_inf()) {
2208        $y = Math::BigInt -> binf($x->sign());
2209    } elsif ($x -> is_nan()) {
2210        $y = Math::BigInt -> bnan();
2211    } else {
2212        my $int = $LIB -> _div($LIB -> _copy($x->{_n}), $x->{_d});  # 22/7 => 3
2213        $y = Math::BigInt -> new($LIB -> _str($int));
2214        $y = $y -> bneg() if $x -> is_neg();
2215    }
2216
2217    # reset upgrading and downgrading
2218
2219    Math::BigInt -> upgrade($upg);
2220    Math::BigInt -> downgrade($dng);
2221
2222    return $y;
2223}
2224
2225sub as_float {
2226    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
2227
2228    return $x -> copy() if $x -> isa("Math::BigFloat");
2229
2230    # disable upgrading and downgrading
2231
2232    require Math::BigFloat;
2233    my $upg = Math::BigFloat -> upgrade();
2234    my $dng = Math::BigFloat -> downgrade();
2235    Math::BigFloat -> upgrade(undef);
2236    Math::BigFloat -> downgrade(undef);
2237
2238    my $y;
2239    if ($x -> is_inf()) {
2240        $y = Math::BigFloat -> binf($x->sign());
2241    } elsif ($x -> is_nan()) {
2242        $y = Math::BigFloat -> bnan();
2243    } else {
2244        $y = Math::BigFloat -> new($LIB -> _str($x->{_n}));
2245        $y -> {sign} = $x -> {sign};
2246        unless ($LIB -> _is_one($x->{_d})) {
2247            my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
2248            $y -> bdiv($xd, @r);
2249        }
2250    }
2251
2252    # reset upgrading and downgrading
2253
2254    Math::BigFloat -> upgrade($upg);
2255    Math::BigFloat -> downgrade($dng);
2256
2257    return $y;
2258}
2259
2260sub as_bin {
2261    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2262
2263    return $x unless $x->is_int();
2264
2265    my $s = $x->{sign};
2266    $s = '' if $s eq '+';
2267    $s . $LIB->_as_bin($x->{_n});
2268}
2269
2270sub as_hex {
2271    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2272
2273    return $x unless $x->is_int();
2274
2275    my $s = $x->{sign}; $s = '' if $s eq '+';
2276    $s . $LIB->_as_hex($x->{_n});
2277}
2278
2279sub as_oct {
2280    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
2281
2282    return $x unless $x->is_int();
2283
2284    my $s = $x->{sign}; $s = '' if $s eq '+';
2285    $s . $LIB->_as_oct($x->{_n});
2286}
2287
2288##############################################################################
2289
2290sub from_hex {
2291    my $class = shift;
2292
2293    # The relationship should probably go the otherway, i.e, that new() calls
2294    # from_hex(). Fixme!
2295    my ($x, @r) = @_;
2296    $x =~ s|^\s*(?:0?[Xx]_*)?|0x|;
2297    $class->new($x, @r);
2298}
2299
2300sub from_bin {
2301    my $class = shift;
2302
2303    # The relationship should probably go the otherway, i.e, that new() calls
2304    # from_bin(). Fixme!
2305    my ($x, @r) = @_;
2306    $x =~ s|^\s*(?:0?[Bb]_*)?|0b|;
2307    $class->new($x, @r);
2308}
2309
2310sub from_oct {
2311    my $class = shift;
2312
2313    # Why is this different from from_hex() and from_bin()? Fixme!
2314    my @parts;
2315    for my $c (@_) {
2316        push @parts, Math::BigInt->from_oct($c);
2317    }
2318    $class->new (@parts);
2319}
2320
2321##############################################################################
2322# import
2323
2324sub import {
2325    my $class = shift;
2326    my @a;                      # unrecognized arguments
2327    my $lib_param = '';
2328    my $lib_value = '';
2329
2330    while (@_) {
2331        my $param = shift;
2332
2333        # Enable overloading of constants.
2334
2335        if ($param eq ':constant') {
2336            overload::constant
2337
2338                integer => sub {
2339                    $class -> new(shift);
2340                },
2341
2342                float   => sub {
2343                    $class -> new(shift);
2344                },
2345
2346                binary  => sub {
2347                    # E.g., a literal 0377 shall result in an object whose value
2348                    # is decimal 255, but new("0377") returns decimal 377.
2349                    return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
2350                    $class -> new(shift);
2351                };
2352            next;
2353        }
2354
2355        # Upgrading.
2356
2357        if ($param eq 'upgrade') {
2358            $class -> upgrade(shift);
2359            next;
2360        }
2361
2362        # Downgrading.
2363
2364        if ($param eq 'downgrade') {
2365            $class -> downgrade(shift);
2366            next;
2367        }
2368
2369        # Accuracy.
2370
2371        if ($param eq 'accuracy') {
2372            $class -> accuracy(shift);
2373            next;
2374        }
2375
2376        # Precision.
2377
2378        if ($param eq 'precision') {
2379            $class -> precision(shift);
2380            next;
2381        }
2382
2383        # Rounding mode.
2384
2385        if ($param eq 'round_mode') {
2386            $class -> round_mode(shift);
2387            next;
2388        }
2389
2390        # Backend library.
2391
2392        if ($param =~ /^(lib|try|only)\z/) {
2393            # alternative library
2394            $lib_param = $param;        # "lib", "try", or "only"
2395            $lib_value = shift;
2396            next;
2397        }
2398
2399        if ($param eq 'with') {
2400            # alternative class for our private parts()
2401            # XXX: no longer supported
2402            # $LIB = shift() || 'Calc';
2403            # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
2404            shift;
2405            next;
2406        }
2407
2408        # Unrecognized parameter.
2409
2410        push @a, $param;
2411    }
2412
2413    require Math::BigInt;
2414
2415    my @import = ('objectify');
2416    push @import, $lib_param, $lib_value if $lib_param ne '';
2417    Math::BigInt -> import(@import);
2418
2419    # find out which one was actually loaded
2420    $LIB = Math::BigInt -> config("lib");
2421
2422    # any non :constant stuff is handled by Exporter (loaded by parent class)
2423    # even if @_ is empty, to give it a chance
2424    $class->SUPER::import(@a);           # for subclasses
2425    $class->export_to_level(1, $class, @a); # need this, too
2426}
2427
24281;
2429
2430__END__
2431
2432=pod
2433
2434=head1 NAME
2435
2436Math::BigRat - arbitrary size rational number math package
2437
2438=head1 SYNOPSIS
2439
2440    use Math::BigRat;
2441
2442    my $x = Math::BigRat->new('3/7'); $x += '5/9';
2443
2444    print $x->bstr(), "\n";
2445    print $x ** 2, "\n";
2446
2447    my $y = Math::BigRat->new('inf');
2448    print "$y ", ($y->is_inf ? 'is' : 'is not'), " infinity\n";
2449
2450    my $z = Math::BigRat->new(144); $z->bsqrt();
2451
2452=head1 DESCRIPTION
2453
2454Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
2455for arbitrary big rational numbers.
2456
2457=head2 MATH LIBRARY
2458
2459You can change the underlying module that does the low-level
2460math operations by using:
2461
2462    use Math::BigRat try => 'GMP';
2463
2464Note: This needs Math::BigInt::GMP installed.
2465
2466The following would first try to find Math::BigInt::Foo, then
2467Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
2468
2469    use Math::BigRat try => 'Foo,Math::BigInt::Bar';
2470
2471If you want to get warned when the fallback occurs, replace "try" with "lib":
2472
2473    use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
2474
2475If you want the code to die instead, replace "try" with "only":
2476
2477    use Math::BigRat only => 'Foo,Math::BigInt::Bar';
2478
2479=head1 METHODS
2480
2481Any methods not listed here are derived from Math::BigFloat (or
2482Math::BigInt), so make sure you check these two modules for further
2483information.
2484
2485=over
2486
2487=item new()
2488
2489    $x = Math::BigRat->new('1/3');
2490
2491Create a new Math::BigRat object. Input can come in various forms:
2492
2493    $x = Math::BigRat->new(123);                            # scalars
2494    $x = Math::BigRat->new('inf');                          # infinity
2495    $x = Math::BigRat->new('123.3');                        # float
2496    $x = Math::BigRat->new('1/3');                          # simple string
2497    $x = Math::BigRat->new('1 / 3');                        # spaced
2498    $x = Math::BigRat->new('1 / 0.1');                      # w/ floats
2499    $x = Math::BigRat->new(Math::BigInt->new(3));           # BigInt
2500    $x = Math::BigRat->new(Math::BigFloat->new('3.1'));     # BigFloat
2501    $x = Math::BigRat->new(Math::BigInt::Lite->new('2'));   # BigLite
2502
2503    # You can also give D and N as different objects:
2504    $x = Math::BigRat->new(
2505            Math::BigInt->new(-123),
2506            Math::BigInt->new(7),
2507         );                      # => -123/7
2508
2509=item numerator()
2510
2511    $n = $x->numerator();
2512
2513Returns a copy of the numerator (the part above the line) as signed BigInt.
2514
2515=item denominator()
2516
2517    $d = $x->denominator();
2518
2519Returns a copy of the denominator (the part under the line) as positive BigInt.
2520
2521=item parts()
2522
2523    ($n, $d) = $x->parts();
2524
2525Return a list consisting of (signed) numerator and (unsigned) denominator as
2526BigInts.
2527
2528=item dparts()
2529
2530Returns the integer part and the fraction part.
2531
2532=item fparts()
2533
2534Returns the smallest possible numerator and denominator so that the numerator
2535divided by the denominator gives back the original value. For finite numbers,
2536both values are integers. Mnemonic: fraction.
2537
2538=item numify()
2539
2540    my $y = $x->numify();
2541
2542Returns the object as a scalar. This will lose some data if the object
2543cannot be represented by a normal Perl scalar (integer or float), so
2544use L</as_int()> or L</as_float()> instead.
2545
2546This routine is automatically used whenever a scalar is required:
2547
2548    my $x = Math::BigRat->new('3/1');
2549    @array = (0, 1, 2, 3);
2550    $y = $array[$x];                # set $y to 3
2551
2552=item as_int()
2553
2554=item as_number()
2555
2556    $x = Math::BigRat->new('13/7');
2557    print $x->as_int(), "\n";               # '1'
2558
2559Returns a copy of the object as BigInt, truncated to an integer.
2560
2561C<as_number()> is an alias for C<as_int()>.
2562
2563=item as_float()
2564
2565    $x = Math::BigRat->new('13/7');
2566    print $x->as_float(), "\n";             # '1'
2567
2568    $x = Math::BigRat->new('2/3');
2569    print $x->as_float(5), "\n";            # '0.66667'
2570
2571Returns a copy of the object as BigFloat, preserving the
2572accuracy as wanted, or the default of 40 digits.
2573
2574This method was added in v0.22 of Math::BigRat (April 2008).
2575
2576=item as_hex()
2577
2578    $x = Math::BigRat->new('13');
2579    print $x->as_hex(), "\n";               # '0xd'
2580
2581Returns the BigRat as hexadecimal string. Works only for integers.
2582
2583=item as_bin()
2584
2585    $x = Math::BigRat->new('13');
2586    print $x->as_bin(), "\n";               # '0x1101'
2587
2588Returns the BigRat as binary string. Works only for integers.
2589
2590=item as_oct()
2591
2592    $x = Math::BigRat->new('13');
2593    print $x->as_oct(), "\n";               # '015'
2594
2595Returns the BigRat as octal string. Works only for integers.
2596
2597=item from_hex()
2598
2599    my $h = Math::BigRat->from_hex('0x10');
2600
2601Create a BigRat from a hexadecimal number in string form.
2602
2603=item from_oct()
2604
2605    my $o = Math::BigRat->from_oct('020');
2606
2607Create a BigRat from an octal number in string form.
2608
2609=item from_bin()
2610
2611    my $b = Math::BigRat->from_bin('0b10000000');
2612
2613Create a BigRat from an binary number in string form.
2614
2615=item bnan()
2616
2617    $x = Math::BigRat->bnan();
2618
2619Creates a new BigRat object representing NaN (Not A Number).
2620If used on an object, it will set it to NaN:
2621
2622    $x->bnan();
2623
2624=item bzero()
2625
2626    $x = Math::BigRat->bzero();
2627
2628Creates a new BigRat object representing zero.
2629If used on an object, it will set it to zero:
2630
2631    $x->bzero();
2632
2633=item binf()
2634
2635    $x = Math::BigRat->binf($sign);
2636
2637Creates a new BigRat object representing infinity. The optional argument is
2638either '-' or '+', indicating whether you want infinity or minus infinity.
2639If used on an object, it will set it to infinity:
2640
2641    $x->binf();
2642    $x->binf('-');
2643
2644=item bone()
2645
2646    $x = Math::BigRat->bone($sign);
2647
2648Creates a new BigRat object representing one. The optional argument is
2649either '-' or '+', indicating whether you want one or minus one.
2650If used on an object, it will set it to one:
2651
2652    $x->bone();                 # +1
2653    $x->bone('-');              # -1
2654
2655=item length()
2656
2657    $len = $x->length();
2658
2659Return the length of $x in digits for integer values.
2660
2661=item digit()
2662
2663    print Math::BigRat->new('123/1')->digit(1);     # 1
2664    print Math::BigRat->new('123/1')->digit(-1);    # 3
2665
2666Return the N'ths digit from X when X is an integer value.
2667
2668=item bnorm()
2669
2670    $x->bnorm();
2671
2672Reduce the number to the shortest form. This routine is called
2673automatically whenever it is needed.
2674
2675=item bfac()
2676
2677    $x->bfac();
2678
2679Calculates the factorial of $x. For instance:
2680
2681    print Math::BigRat->new('3/1')->bfac(), "\n";   # 1*2*3
2682    print Math::BigRat->new('5/1')->bfac(), "\n";   # 1*2*3*4*5
2683
2684Works currently only for integers.
2685
2686=item bround()/round()/bfround()
2687
2688Are not yet implemented.
2689
2690=item bmod()
2691
2692    $x->bmod($y);
2693
2694Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
2695result is identical to the remainder after floored division (F-division). If,
2696in addition, both $x and $y are integers, the result is identical to the result
2697from Perl's % operator.
2698
2699=item bmodinv()
2700
2701    $x->bmodinv($mod);          # modular multiplicative inverse
2702
2703Returns the multiplicative inverse of C<$x> modulo C<$mod>. If
2704
2705    $y = $x -> copy() -> bmodinv($mod)
2706
2707then C<$y> is the number closest to zero, and with the same sign as C<$mod>,
2708satisfying
2709
2710    ($x * $y) % $mod = 1 % $mod
2711
2712If C<$x> and C<$y> are non-zero, they must be relative primes, i.e.,
2713C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative
2714inverse exists.
2715
2716=item bmodpow()
2717
2718    $num->bmodpow($exp,$mod);           # modular exponentiation
2719                                        # ($num**$exp % $mod)
2720
2721Returns the value of C<$num> taken to the power C<$exp> in the modulus
2722C<$mod> using binary exponentiation.  C<bmodpow> is far superior to
2723writing
2724
2725    $num ** $exp % $mod
2726
2727because it is much faster - it reduces internal variables into
2728the modulus whenever possible, so it operates on smaller numbers.
2729
2730C<bmodpow> also supports negative exponents.
2731
2732    bmodpow($num, -1, $mod)
2733
2734is exactly equivalent to
2735
2736    bmodinv($num, $mod)
2737
2738=item bneg()
2739
2740    $x->bneg();
2741
2742Used to negate the object in-place.
2743
2744=item is_one()
2745
2746    print "$x is 1\n" if $x->is_one();
2747
2748Return true if $x is exactly one, otherwise false.
2749
2750=item is_zero()
2751
2752    print "$x is 0\n" if $x->is_zero();
2753
2754Return true if $x is exactly zero, otherwise false.
2755
2756=item is_pos()/is_positive()
2757
2758    print "$x is >= 0\n" if $x->is_positive();
2759
2760Return true if $x is positive (greater than or equal to zero), otherwise
2761false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
2762
2763C<is_positive()> is an alias for C<is_pos()>.
2764
2765=item is_neg()/is_negative()
2766
2767    print "$x is < 0\n" if $x->is_negative();
2768
2769Return true if $x is negative (smaller than zero), otherwise false. Please
2770note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
2771
2772C<is_negative()> is an alias for C<is_neg()>.
2773
2774=item is_int()
2775
2776    print "$x is an integer\n" if $x->is_int();
2777
2778Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
2779false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
2780
2781=item is_odd()
2782
2783    print "$x is odd\n" if $x->is_odd();
2784
2785Return true if $x is odd, otherwise false.
2786
2787=item is_even()
2788
2789    print "$x is even\n" if $x->is_even();
2790
2791Return true if $x is even, otherwise false.
2792
2793=item bceil()
2794
2795    $x->bceil();
2796
2797Set $x to the next bigger integer value (e.g. truncate the number to integer
2798and then increment it by one).
2799
2800=item bfloor()
2801
2802    $x->bfloor();
2803
2804Truncate $x to an integer value.
2805
2806=item bint()
2807
2808    $x->bint();
2809
2810Round $x towards zero.
2811
2812=item bsqrt()
2813
2814    $x->bsqrt();
2815
2816Calculate the square root of $x.
2817
2818=item broot()
2819
2820    $x->broot($n);
2821
2822Calculate the N'th root of $x.
2823
2824=item badd()
2825
2826    $x->badd($y);
2827
2828Adds $y to $x and returns the result.
2829
2830=item bmul()
2831
2832    $x->bmul($y);
2833
2834Multiplies $y to $x and returns the result.
2835
2836=item bsub()
2837
2838    $x->bsub($y);
2839
2840Subtracts $y from $x and returns the result.
2841
2842=item bdiv()
2843
2844    $q = $x->bdiv($y);
2845    ($q, $r) = $x->bdiv($y);
2846
2847In scalar context, divides $x by $y and returns the result. In list context,
2848does floored division (F-division), returning an integer $q and a remainder $r
2849so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned
2850by C<< $x->bmod($y) >>.
2851
2852=item binv()
2853
2854    $x->binv();
2855
2856Inverse of $x.
2857
2858=item bdec()
2859
2860    $x->bdec();
2861
2862Decrements $x by 1 and returns the result.
2863
2864=item binc()
2865
2866    $x->binc();
2867
2868Increments $x by 1 and returns the result.
2869
2870=item copy()
2871
2872    my $z = $x->copy();
2873
2874Makes a deep copy of the object.
2875
2876Please see the documentation in L<Math::BigInt> for further details.
2877
2878=item bstr()/bsstr()
2879
2880    my $x = Math::BigRat->new('8/4');
2881    print $x->bstr(), "\n";             # prints 1/2
2882    print $x->bsstr(), "\n";            # prints 1/2
2883
2884Return a string representing this object.
2885
2886=item bcmp()
2887
2888    $x->bcmp($y);
2889
2890Compares $x with $y and takes the sign into account.
2891Returns -1, 0, 1 or undef.
2892
2893=item bacmp()
2894
2895    $x->bacmp($y);
2896
2897Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef.
2898
2899=item beq()
2900
2901    $x -> beq($y);
2902
2903Returns true if and only if $x is equal to $y, and false otherwise.
2904
2905=item bne()
2906
2907    $x -> bne($y);
2908
2909Returns true if and only if $x is not equal to $y, and false otherwise.
2910
2911=item blt()
2912
2913    $x -> blt($y);
2914
2915Returns true if and only if $x is equal to $y, and false otherwise.
2916
2917=item ble()
2918
2919    $x -> ble($y);
2920
2921Returns true if and only if $x is less than or equal to $y, and false
2922otherwise.
2923
2924=item bgt()
2925
2926    $x -> bgt($y);
2927
2928Returns true if and only if $x is greater than $y, and false otherwise.
2929
2930=item bge()
2931
2932    $x -> bge($y);
2933
2934Returns true if and only if $x is greater than or equal to $y, and false
2935otherwise.
2936
2937=item blsft()/brsft()
2938
2939Used to shift numbers left/right.
2940
2941Please see the documentation in L<Math::BigInt> for further details.
2942
2943=item band()
2944
2945    $x->band($y);               # bitwise and
2946
2947=item bior()
2948
2949    $x->bior($y);               # bitwise inclusive or
2950
2951=item bxor()
2952
2953    $x->bxor($y);               # bitwise exclusive or
2954
2955=item bnot()
2956
2957    $x->bnot();                 # bitwise not (two's complement)
2958
2959=item bpow()
2960
2961    $x->bpow($y);
2962
2963Compute $x ** $y.
2964
2965Please see the documentation in L<Math::BigInt> for further details.
2966
2967=item blog()
2968
2969    $x->blog($base, $accuracy);         # logarithm of x to the base $base
2970
2971If C<$base> is not defined, Euler's number (e) is used:
2972
2973    print $x->blog(undef, 100);         # log(x) to 100 digits
2974
2975=item bexp()
2976
2977    $x->bexp($accuracy);        # calculate e ** X
2978
2979Calculates two integers A and B so that A/B is equal to C<e ** $x>, where C<e> is
2980Euler's number.
2981
2982This method was added in v0.20 of Math::BigRat (May 2007).
2983
2984See also C<blog()>.
2985
2986=item bnok()
2987
2988    $x->bnok($y);               # x over y (binomial coefficient n over k)
2989
2990Calculates the binomial coefficient n over k, also called the "choose"
2991function. The result is equivalent to:
2992
2993    ( n )      n!
2994    | - |  = -------
2995    ( k )    k!(n-k)!
2996
2997This method was added in v0.20 of Math::BigRat (May 2007).
2998
2999=item config()
3000
3001    Math::BigRat->config("trap_nan" => 1);      # set
3002    $accu = Math::BigRat->config("accuracy");   # get
3003
3004Set or get configuration parameter values. Read-only parameters are marked as
3005RO. Read-write parameters are marked as RW. The following parameters are
3006supported.
3007
3008    Parameter       RO/RW   Description
3009                            Example
3010    ============================================================
3011    lib             RO      Name of the math backend library
3012                            Math::BigInt::Calc
3013    lib_version     RO      Version of the math backend library
3014                            0.30
3015    class           RO      The class of config you just called
3016                            Math::BigRat
3017    version         RO      version number of the class you used
3018                            0.10
3019    upgrade         RW      To which class numbers are upgraded
3020                            undef
3021    downgrade       RW      To which class numbers are downgraded
3022                            undef
3023    precision       RW      Global precision
3024                            undef
3025    accuracy        RW      Global accuracy
3026                            undef
3027    round_mode      RW      Global round mode
3028                            even
3029    div_scale       RW      Fallback accuracy for div, sqrt etc.
3030                            40
3031    trap_nan        RW      Trap NaNs
3032                            undef
3033    trap_inf        RW      Trap +inf/-inf
3034                            undef
3035
3036=back
3037
3038=head1 NUMERIC LITERALS
3039
3040After C<use Math::BigRat ':constant'> all numeric literals in the given scope
3041are converted to C<Math::BigRat> objects. This conversion happens at compile
3042time. Every non-integer is convert to a NaN.
3043
3044For example,
3045
3046    perl -MMath::BigRat=:constant -le 'print 2**150'
3047
3048prints the exact value of C<2**150>. Note that without conversion of constants
3049to objects the expression C<2**150> is calculated using Perl scalars, which
3050leads to an inaccurate result.
3051
3052Please note that strings are not affected, so that
3053
3054    use Math::BigRat qw/:constant/;
3055
3056    $x = "1234567890123456789012345678901234567890"
3057            + "123456789123456789";
3058
3059does give you what you expect. You need an explicit Math::BigRat->new() around
3060at least one of the operands. You should also quote large constants to prevent
3061loss of precision:
3062
3063    use Math::BigRat;
3064
3065    $x = Math::BigRat->new("1234567889123456789123456789123456789");
3066
3067Without the quotes Perl first converts the large number to a floating point
3068constant at compile time, and then converts the result to a Math::BigRat object
3069at run time, which results in an inaccurate result.
3070
3071=head2 Hexadecimal, octal, and binary floating point literals
3072
3073Perl (and this module) accepts hexadecimal, octal, and binary floating point
3074literals, but use them with care with Perl versions before v5.32.0, because some
3075versions of Perl silently give the wrong result. Below are some examples of
3076different ways to write the number decimal 314.
3077
3078Hexadecimal floating point literals:
3079
3080    0x1.3ap+8         0X1.3AP+8
3081    0x1.3ap8          0X1.3AP8
3082    0x13a0p-4         0X13A0P-4
3083
3084Octal floating point literals (with "0" prefix):
3085
3086    01.164p+8         01.164P+8
3087    01.164p8          01.164P8
3088    011640p-4         011640P-4
3089
3090Octal floating point literals (with "0o" prefix) (requires v5.34.0):
3091
3092    0o1.164p+8        0O1.164P+8
3093    0o1.164p8         0O1.164P8
3094    0o11640p-4        0O11640P-4
3095
3096Binary floating point literals:
3097
3098    0b1.0011101p+8    0B1.0011101P+8
3099    0b1.0011101p8     0B1.0011101P8
3100    0b10011101000p-2  0B10011101000P-2
3101
3102=head1 BUGS
3103
3104Please report any bugs or feature requests to
3105C<bug-math-bigrat at rt.cpan.org>, or through the web interface at
3106L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigRat>
3107(requires login).
3108We will be notified, and then you'll automatically be notified of progress on
3109your bug as I make changes.
3110
3111=head1 SUPPORT
3112
3113You can find documentation for this module with the perldoc command.
3114
3115    perldoc Math::BigRat
3116
3117You can also look for information at:
3118
3119=over 4
3120
3121=item * GitHub
3122
3123L<https://github.com/pjacklam/p5-Math-BigRat>
3124
3125=item * RT: CPAN's request tracker
3126
3127L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigRat>
3128
3129=item * MetaCPAN
3130
3131L<https://metacpan.org/release/Math-BigRat>
3132
3133=item * CPAN Testers Matrix
3134
3135L<http://matrix.cpantesters.org/?dist=Math-BigRat>
3136
3137=item * CPAN Ratings
3138
3139L<https://cpanratings.perl.org/dist/Math-BigRat>
3140
3141=back
3142
3143=head1 LICENSE
3144
3145This program is free software; you may redistribute it and/or modify it under
3146the same terms as Perl itself.
3147
3148=head1 SEE ALSO
3149
3150L<bigrat>, L<Math::BigFloat> and L<Math::BigInt> as well as the backends
3151L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>.
3152
3153=head1 AUTHORS
3154
3155=over 4
3156
3157=item *
3158
3159Tels L<http://bloodgate.com/> 2001-2009.
3160
3161=item *
3162
3163Maintained by Peter John Acklam <pjacklam@gmail.com> 2011-
3164
3165=back
3166
3167=cut
3168