This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update Math-BigRat to CPAN version 0.2613
[perl5.git] / cpan / Math-BigRat / lib / Math / BigRat.pm
CommitLineData
a4e2b1c6 1#
7d341013 2# "Tax the rat farms." - Lord Vetinari
a4e2b1c6 3#
184f15d5
JH		 4
5# The following hash values are used:
6# sign : +,-,NaN,+inf,-inf
7# _d : denominator
c4a6f826 8# _n : numerator (value = _n/_d)
184f15d5
JH		 9# _a : accuracy
10# _p : precision
7afd7a91 11# You should not look at the innards of a BigRat - use the methods for this.
184f15d5
JH		 12
13package Math::BigRat;
14
08a3f4a9 15use 5.006;
184f15d5 16use strict;
11c955be
SH		 17use warnings;
18
9aa0b648 19use Carp ();
184f15d5 20
92c15a49 21use Math::BigFloat 1.999718;
11c955be 22
92c15a49 23our $VERSION = '0.2613';
184f15d5 24
6320cdc0
SH		 25our @ISA = qw(Math::BigFloat);
26
27our ($accuracy, $precision, $round_mode, $div_scale,
28 $upgrade, $downgrade, $_trap_nan, $_trap_inf);
9aa0b648
FR		 29
30use overload
6320cdc0
SH		 31
32 # overload key: with_assign
33
34 '+' => sub { $_[0] -> copy() -> badd($_[1]); },
35
36 '-' => sub { my $c = $_[0] -> copy;
37 $_[2] ? $c -> bneg() -> badd( $_[1])
38 : $c -> bsub($_[1]); },
39
40 '*' => sub { $_[0] -> copy() -> bmul($_[1]); },
41
42 '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
43 : $_[0] -> copy() -> bdiv($_[1]); },
44
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
73 '<<=' => sub { $_[0]->blsft($_[1]); },
74
75 '>>=' => sub { $_[0]->brsft($_[1]); },
76
77# 'x=' => sub { },
78
79# '.=' => sub { },
80
81 # overload key: num_comparison
82
83 '<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
84 : $_[0] -> blt($_[1]); },
85
86 '<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
87 : $_[0] -> ble($_[1]); },
88
89 '>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
90 : $_[0] -> bgt($_[1]); },
91
92 '>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
93 : $_[0] -> bge($_[1]); },
94
95 '==' => sub { $_[0] -> beq($_[1]); },
96
97 '!=' => sub { $_[0] -> bne($_[1]); },
98
99 # overload key: 3way_comparison
100
101 '<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]);
102 defined($cmp) && $_[2] ? -$cmp : $cmp; },
103
104 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
105 : $_[0] -> bstr() cmp "$_[1]"; },
106
107 # overload key: str_comparison
108
109# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
110# : $_[0] -> bstrlt($_[1]); },
111#
112# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
113# : $_[0] -> bstrle($_[1]); },
114#
115# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
116# : $_[0] -> bstrgt($_[1]); },
117#
118# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
119# : $_[0] -> bstrge($_[1]); },
120#
121# 'eq' => sub { $_[0] -> bstreq($_[1]); },
122#
123# 'ne' => sub { $_[0] -> bstrne($_[1]); },
124
125 # overload key: binary
126
127 '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
128 : $_[0] -> copy() -> band($_[1]); },
129
130 '&=' => sub { $_[0] -> band($_[1]); },
131
132 '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
133 : $_[0] -> copy() -> bior($_[1]); },
134
135 '|=' => sub { $_[0] -> bior($_[1]); },
136
137 '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
138 : $_[0] -> copy() -> bxor($_[1]); },
139
140 '^=' => sub { $_[0] -> bxor($_[1]); },
141
142# '&.' => sub { },
143
144# '&.=' => sub { },
145
146# '|.' => sub { },
147
148# '|.=' => sub { },
149
150# '^.' => sub { },
151
152# '^.=' => sub { },
153
154 # overload key: unary
155
156 'neg' => sub { $_[0] -> copy() -> bneg(); },
157
158# '!' => sub { },
159
160 '~' => sub { $_[0] -> copy() -> bnot(); },
161
162# '~.' => sub { },
163
164 # overload key: mutators
165
166 '++' => sub { $_[0] -> binc() },
167
168 '--' => sub { $_[0] -> bdec() },
169
170 # overload key: func
171
172 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
173 : $_[0] -> copy() -> batan2($_[1]); },
174
175 'cos' => sub { $_[0] -> copy() -> bcos(); },
176
177 'sin' => sub { $_[0] -> copy() -> bsin(); },
178
179 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); },
180
181 'abs' => sub { $_[0] -> copy() -> babs(); },
182
183 'log' => sub { $_[0] -> copy() -> blog(); },
184
185 'sqrt' => sub { $_[0] -> copy() -> bsqrt(); },
186
187 'int' => sub { $_[0] -> copy() -> bint(); },
188
189 # overload key: conversion
190
191 'bool' => sub { $_[0] -> is_zero() ? '' : 1; },
192
193 '""' => sub { $_[0] -> bstr(); },
194
195 '0+' => sub { $_[0] -> numify(); },
196
197 '=' => sub { $_[0]->copy(); },
198
199 ;
11c955be
SH		 200
201BEGIN {
202 *objectify = \&Math::BigInt::objectify; # inherit this from BigInt
203 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
0c2fbbe3
CBW		 204 # We inherit these from BigFloat because currently it is not possible that
205 # Math::BigFloat has a different $LIB variable than we, because
206 # Math::BigFloat also uses Math::BigInt::config->('lib') (there is always
207 # only one library loaded)
11c955be
SH		 208 *_e_add = \&Math::BigFloat::_e_add;
209 *_e_sub = \&Math::BigFloat::_e_sub;
210 *as_int = \&as_number;
211 *is_pos = \&is_positive;
212 *is_neg = \&is_negative;
213}
9b924220 214
184f15d5 215##############################################################################
12fc2493 216# Global constants and flags. Access these only via the accessor methods!
184f15d5 217
6320cdc0 218$accuracy = $precision = undef;
184f15d5 219$round_mode = 'even';
6320cdc0
SH		 220$div_scale = 40;
221$upgrade = undef;
222$downgrade = undef;
184f15d5 223
12fc2493 224# These are internally, and not to be used from the outside at all!
990fb837
RGS		 225
226$_trap_nan = 0; # are NaNs ok? set w/ config()
227$_trap_inf = 0; # are infs ok? set w/ config()
228
12fc2493
AMS		 229# the package we are using for our private parts, defaults to:
230# Math::BigInt->config()->{lib}
6320cdc0 231
0c2fbbe3 232my $LIB = 'Math::BigInt::Calc';
12fc2493 233
11c955be 234my $nan = 'NaN';
6320cdc0 235#my $class = 'Math::BigRat';
184f15d5 236
11c955be 237sub isa {
6320cdc0 238 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
11c955be
SH		 239 UNIVERSAL::isa(@_);
240}
8f675a64 241
12fc2493 242##############################################################################
9b924220 243
6320cdc0
SH		 244sub new {
245 my $proto = shift;
246 my $protoref = ref $proto;
247 my $class = $protoref || $proto;
184f15d5 248
6320cdc0 249 # Check the way we are called.
184f15d5 250
6320cdc0
SH		 251 if ($protoref) {
252 Carp::croak("new() is a class method, not an instance method");
184f15d5 253 }
6320cdc0
SH		 254
255 if (@_ < 1) {
256 #Carp::carp("Using new() with no argument is deprecated;",
257 # " use bzero() or new(0) instead");
258 return $class -> bzero();
184f15d5 259 }
184f15d5 260
6320cdc0
SH		 261 if (@_ > 2) {
262 Carp::carp("Superfluous arguments to new() ignored.");
263 }
184f15d5 264
6320cdc0
SH		 265 # Get numerator and denominator. If any of the arguments is undefined,
266 # return zero.
184f15d5 267
6320cdc0 268 my ($n, $d) = @_;
ccbfef19 269
6320cdc0
SH		 270 if (@_ == 1 && !defined $n ||
271 @_ == 2 && (!defined $n || !defined $d))
272 {
273 #Carp::carp("Use of uninitialized value in new()");
274 return $class -> bzero();
275 }
b68b7ab1 276
6320cdc0 277 # Initialize a new object.
184f15d5 278
6320cdc0 279 my $self = bless {}, $class;
11c955be 280
6320cdc0 281 # One or two input arguments may be given. First handle the numerator $n.
11c955be 282
6320cdc0
SH		 283 if (ref($n)) {
284 $n = Math::BigFloat -> new($n, undef, undef)
285 unless ($n -> isa('Math::BigRat') ||
286 $n -> isa('Math::BigInt') ||
287 $n -> isa('Math::BigFloat'));
288 } else {
289 if (defined $d) {
290 # If the denominator is defined, the numerator is not a string
291 # fraction, e.g., "355/113".
292 $n = Math::BigFloat -> new($n, undef, undef);
293 } else {
294 # If the denominator is undefined, the numerator might be a string
295 # fraction, e.g., "355/113".
296 if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) {
297 $n = Math::BigFloat -> new($1, undef, undef);
298 $d = Math::BigFloat -> new($2, undef, undef);
299 } else {
300 $n = Math::BigFloat -> new($n, undef, undef);
301 }
302 }
303 }
11c955be 304
6320cdc0
SH		 305 # At this point $n is an object and $d is either an object or undefined. An
306 # undefined $d means that $d was not specified by the caller (not that $d
307 # was specified as an undefined value).
11c955be 308
6320cdc0
SH		 309 unless (defined $d) {
310 #return $n -> copy($n) if $n -> isa('Math::BigRat');
311 return $class -> copy($n) if $n -> isa('Math::BigRat');
312 return $class -> bnan() if $n -> is_nan();
313 return $class -> binf($n -> sign()) if $n -> is_inf();
11c955be 314
6320cdc0 315 if ($n -> isa('Math::BigInt')) {
0c2fbbe3
CBW		 316 $self -> {_n} = $LIB -> _new($n -> copy() -> babs() -> bstr());
317 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 318 $self -> {sign} = $n -> sign();
319 return $self;
11c955be 320 }
6320cdc0
SH		 321
322 if ($n -> isa('Math::BigFloat')) {
323 my $m = $n -> mantissa() -> babs();
324 my $e = $n -> exponent();
0c2fbbe3
CBW		 325 $self -> {_n} = $LIB -> _new($m -> bstr());
326 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 327
328 if ($e > 0) {
0c2fbbe3
CBW		 329 $self -> {_n} = $LIB -> _lsft($self -> {_n},
330 $LIB -> _new($e -> bstr()), 10);
6320cdc0 331 } elsif ($e < 0) {
0c2fbbe3
CBW		 332 $self -> {_d} = $LIB -> _lsft($self -> {_d},
333 $LIB -> _new(-$e -> bstr()), 10);
6320cdc0 334
0c2fbbe3
CBW		 335 my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}), $self -> {_d});
336 if (!$LIB -> _is_one($gcd)) {
337 $self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
338 $self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
6320cdc0
SH		 339 }
340 }
341
342 $self -> {sign} = $n -> sign();
343 return $self;
11c955be 344 }
6320cdc0
SH		 345
346 die "I don't know how to handle this"; # should never get here
184f15d5 347 }
12fc2493 348
6320cdc0
SH		 349 # At the point we know that both $n and $d are defined. We know that $n is
350 # an object, but $d might still be a scalar. Now handle $d.
11c955be 351
6320cdc0
SH		 352 $d = Math::BigFloat -> new($d, undef, undef)
353 unless ref($d) && ($d -> isa('Math::BigRat') ||
354 $d -> isa('Math::BigInt') ||
355 $d -> isa('Math::BigFloat'));
12fc2493 356
6320cdc0
SH		 357 # At this point both $n and $d are objects.
358
359 return $class -> bnan() if $n -> is_nan() || $d -> is_nan();
360
361 # At this point neither $n nor $d is a NaN.
12fc2493 362
6320cdc0
SH		 363 if ($n -> is_zero()) {
364 return $class -> bnan() if $d -> is_zero(); # 0/0 = NaN
365 return $class -> bzero();
11c955be
SH		 366 }
367
6320cdc0 368 return $class -> binf($d -> sign()) if $d -> is_zero();
11c955be 369
6320cdc0
SH		 370 # At this point, neither $n nor $d is a NaN or a zero.
371
372 if ($d < 0) { # make sure denominator is positive
373 $n -> bneg();
374 $d -> bneg();
11c955be
SH		 375 }
376
6320cdc0
SH		 377 if ($n -> is_inf()) {
378 return $class -> bnan() if $d -> is_inf(); # Inf/Inf = NaN
379 return $class -> binf($n -> sign());
380 }
11c955be 381
6320cdc0 382 # At this point $n is finite.
11c955be 383
6320cdc0
SH		 384 return $class -> bzero() if $d -> is_inf();
385 return $class -> binf($d -> sign()) if $d -> is_zero();
11c955be 386
6320cdc0 387 # At this point both $n and $d are finite and non-zero.
990fb837 388
6320cdc0
SH		 389 if ($n < 0) {
390 $n -> bneg();
391 $self -> {sign} = '-';
392 } else {
393 $self -> {sign} = '+';
11c955be
SH		 394 }
395
6320cdc0
SH		 396 if ($n -> isa('Math::BigRat')) {
397
398 if ($d -> isa('Math::BigRat')) {
399
400 # At this point both $n and $d is a Math::BigRat.
401
402 # p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
403 # - / - = ----- = ---------------------------------
404 # q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
405
406 my $p = $n -> {_n};
407 my $q = $n -> {_d};
408 my $r = $d -> {_n};
409 my $s = $d -> {_d};
0c2fbbe3
CBW		 410 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r);
411 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q);
412 $self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr),
413 $LIB -> _div($LIB -> _copy($s), $gcd_sq));
414 $self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
415 $LIB -> _div($LIB -> _copy($r), $gcd_pr));
6320cdc0
SH		 416
417 return $self; # no need for $self -> bnorm() here
11c955be 418 }
6320cdc0
SH		 419
420 # At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float).
421
422 my $p = $n -> {_n};
423 my $q = $n -> {_d};
424 my $m = $d -> mantissa();
425 my $e = $d -> exponent();
426
427 # / p
428 # | ------------ if e > 0
429 # | q * m * 10^e
430 # |
431 # p | p
432 # - / (m * 10^e) = | ----- if e == 0
433 # q | q * m
434 # |
435 # | p * 10^-e
436 # | -------- if e < 0
437 # \ q * m
438
0c2fbbe3
CBW		 439 $self -> {_n} = $LIB -> _copy($p);
440 $self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m);
6320cdc0 441 if ($e > 0) {
0c2fbbe3 442 $self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10);
6320cdc0 443 } elsif ($e < 0) {
0c2fbbe3 444 $self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10);
11c955be 445 }
184f15d5 446
6320cdc0
SH		 447 return $self -> bnorm();
448
449 } else {
450
451 if ($d -> isa('Math::BigRat')) {
452
453 # At this point $n is a Math::Big(Int|Float) and $d is a
454 # Math::BigRat.
455
456 my $m = $n -> mantissa();
457 my $e = $n -> exponent();
458 my $p = $d -> {_n};
459 my $q = $d -> {_d};
460
461 # / q * m * 10^e
462 # | ------------ if e > 0
463 # | p
464 # |
465 # p | m * q
466 # (m * 10^e) / - = | ----- if e == 0
467 # q | p
468 # |
469 # | q * m
470 # | --------- if e < 0
471 # \ p * 10^-e
472
0c2fbbe3
CBW		 473 $self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m);
474 $self -> {_d} = $LIB -> _copy($p);
6320cdc0 475 if ($e > 0) {
0c2fbbe3 476 $self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10);
6320cdc0 477 } elsif ($e < 0) {
0c2fbbe3 478 $self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10);
6320cdc0
SH		 479 }
480 return $self -> bnorm();
481
482 } else {
483
484 # At this point $n and $d are both a Math::Big(Int|Float)
485
486 my $m1 = $n -> mantissa();
487 my $e1 = $n -> exponent();
488 my $m2 = $d -> mantissa();
489 my $e2 = $d -> exponent();
490
491 # /
492 # | m1 * 10^(e1 - e2)
493 # | ----------------- if e1 > e2
494 # | m2
495 # |
496 # m1 * 10^e1 | m1
497 # ---------- = | -- if e1 = e2
498 # m2 * 10^e2 | m2
499 # |
500 # | m1
501 # | ----------------- if e1 < e2
502 # | m2 * 10^(e2 - e1)
503 # \
504
0c2fbbe3
CBW		 505 $self -> {_n} = $LIB -> _new($m1 -> bstr());
506 $self -> {_d} = $LIB -> _new($m2 -> bstr());
6320cdc0
SH		 507 my $ediff = $e1 - $e2;
508 if ($ediff > 0) {
0c2fbbe3
CBW		 509 $self -> {_n} = $LIB -> _lsft($self -> {_n},
510 $LIB -> _new($ediff -> bstr()),
6320cdc0
SH		 511 10);
512 } elsif ($ediff < 0) {
0c2fbbe3
CBW		 513 $self -> {_d} = $LIB -> _lsft($self -> {_d},
514 $LIB -> _new(-$ediff -> bstr()),
6320cdc0
SH		 515 10);
516 }
517
518 return $self -> bnorm();
11c955be 519 }
184f15d5 520 }
184f15d5 521
6320cdc0 522 return $self;
11c955be 523}
b68b7ab1 524
11c955be
SH		 525sub copy {
526 my $self = shift;
527 my $selfref = ref $self;
528 my $class = $selfref || $self;
9b924220 529
11c955be 530 # If called as a class method, the object to copy is the next argument.
9b924220 531
11c955be
SH		 532 $self = shift() unless $selfref;
533
534 my $copy = bless {}, $class;
535
536 $copy->{sign} = $self->{sign};
0c2fbbe3
CBW		 537 $copy->{_d} = $LIB->_copy($self->{_d});
538 $copy->{_n} = $LIB->_copy($self->{_n});
11c955be
SH		 539 $copy->{_a} = $self->{_a} if defined $self->{_a};
540 $copy->{_p} = $self->{_p} if defined $self->{_p};
541
6320cdc0
SH		 542 #($copy, $copy->{_a}, $copy->{_p})
543 # = $copy->_find_round_parameters(@_);
544
545 return $copy;
546}
547
548sub bnan {
549 my $self = shift;
550 my $selfref = ref $self;
551 my $class = $selfref || $self;
552
553 $self = bless {}, $class unless $selfref;
554
555 if ($_trap_nan) {
556 Carp::croak ("Tried to set a variable to NaN in $class->bnan()");
557 }
558
559 $self -> {sign} = $nan;
0c2fbbe3
CBW		 560 $self -> {_n} = $LIB -> _zero();
561 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 562
563 ($self, $self->{_a}, $self->{_p})
564 = $self->_find_round_parameters(@_);
565
566 return $self;
567}
568
569sub binf {
570 my $self = shift;
571 my $selfref = ref $self;
572 my $class = $selfref || $self;
573
574 $self = bless {}, $class unless $selfref;
575
576 my $sign = shift();
577 $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf';
578
579 if ($_trap_inf) {
580 Carp::croak ("Tried to set a variable to +-inf in $class->binf()");
581 }
582
583 $self -> {sign} = $sign;
0c2fbbe3
CBW		 584 $self -> {_n} = $LIB -> _zero();
585 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 586
587 ($self, $self->{_a}, $self->{_p})
588 = $self->_find_round_parameters(@_);
589
590 return $self;
591}
592
593sub bone {
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 = '+' unless defined($sign) && $sign eq '-';
602
603 $self -> {sign} = $sign;
0c2fbbe3
CBW		 604 $self -> {_n} = $LIB -> _one();
605 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 606
607 ($self, $self->{_a}, $self->{_p})
608 = $self->_find_round_parameters(@_);
609
610 return $self;
611}
612
613sub bzero {
614 my $self = shift;
615 my $selfref = ref $self;
616 my $class = $selfref || $self;
617
618 $self = bless {}, $class unless $selfref;
619
620 $self -> {sign} = '+';
0c2fbbe3
CBW		 621 $self -> {_n} = $LIB -> _zero();
622 $self -> {_d} = $LIB -> _one();
6320cdc0
SH		 623
624 ($self, $self->{_a}, $self->{_p})
625 = $self->_find_round_parameters(@_);
626
627 return $self;
11c955be 628}
9b924220 629
990fb837
RGS		 630##############################################################################
631
6320cdc0
SH		 632sub config {
633 # return (later set?) configuration data as hash ref
634 my $class = shift() || 'Math::BigRat';
990fb837 635
6320cdc0
SH		 636 if (@_ == 1 && ref($_[0]) ne 'HASH') {
637 my $cfg = $class->SUPER::config();
638 return $cfg->{$_[0]};
116a1b2f
SP		 639 }
640
6320cdc0 641 my $cfg = $class->SUPER::config(@_);
990fb837 642
6320cdc0
SH		 643 # now we need only to override the ones that are different from our parent
644 $cfg->{class} = $class;
0c2fbbe3 645 $cfg->{with} = $LIB;
6320cdc0
SH		 646
647 $cfg;
648}
990fb837
RGS		 649
650##############################################################################
8f675a64 651
6320cdc0
SH		 652sub bstr {
653 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
184f15d5 654
6320cdc0
SH		 655 if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
656 my $s = $x->{sign};
657 $s =~ s/^\+//; # +inf => inf
658 return $s;
184f15d5
JH		 659 }
660
6320cdc0
SH		 661 my $s = '';
662 $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
184f15d5 663
0c2fbbe3
CBW		 664 return $s . $LIB->_str($x->{_n}) if $LIB->_is_one($x->{_d});
665 $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
6320cdc0 666}
184f15d5 667
6320cdc0
SH		 668sub bsstr {
669 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
184f15d5 670
6320cdc0 671 if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
15f1cdaa 672 my $s = $x->{sign};
6320cdc0
SH		 673 $s =~ s/^\+//; # +inf => inf
674 return $s;
184f15d5 675 }
ccbfef19 676
6320cdc0
SH		 677 my $s = '';
678 $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
0c2fbbe3 679 $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
6320cdc0 680}
184f15d5 681
6320cdc0
SH		 682sub bnorm {
683 # reduce the number to the shortest form
684 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
184f15d5 685
6320cdc0 686 # Both parts must be objects of whatever we are using today.
0c2fbbe3 687 if (my $c = $LIB->_check($x->{_n})) {
11c955be 688 Carp::croak("n did not pass the self-check ($c) in bnorm()");
990fb837 689 }
0c2fbbe3 690 if (my $c = $LIB->_check($x->{_d})) {
11c955be 691 Carp::croak("d did not pass the self-check ($c) in bnorm()");
990fb837 692 }
6de7f0cc 693
6320cdc0
SH		 694 # no normalize for NaN, inf etc.
695 return $x if $x->{sign} !~ /^[+-]$/;
6de7f0cc 696
6320cdc0 697 # normalize zeros to 0/1
0c2fbbe3 698 if ($LIB->_is_zero($x->{_n})) {
6320cdc0 699 $x->{sign} = '+'; # never leave a -0
0c2fbbe3 700 $x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
6320cdc0 701 return $x;
184f15d5
JH		 702 }
703
0c2fbbe3 704 return $x if $LIB->_is_one($x->{_d}); # no need to reduce
6de7f0cc 705
6320cdc0 706 # Compute the GCD.
0c2fbbe3
CBW		 707 my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
708 if (!$LIB->_is_one($gcd)) {
709 $x->{_n} = $LIB->_div($x->{_n}, $gcd);
710 $x->{_d} = $LIB->_div($x->{_d}, $gcd);
184f15d5 711 }
6320cdc0
SH		 712
713 $x;
714}
184f15d5
JH		 715
716##############################################################################
b68b7ab1
T		 717# sign manipulation
718
6320cdc0
SH		 719sub bneg {
720 # (BRAT or num_str) return BRAT
721 # negate number or make a negated number from string
722 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
b68b7ab1 723
6320cdc0 724 return $x if $x->modify('bneg');
b68b7ab1 725
6320cdc0
SH		 726 # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
727 $x->{sign} =~ tr/+-/-+/
0c2fbbe3 728 unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));
6320cdc0
SH		 729 $x;
730}
b68b7ab1
T		 731
732##############################################################################
184f15d5
JH		 733# special values
734
6320cdc0
SH		 735sub _bnan {
736 # used by parent class bnan() to initialize number to NaN
737 my $self = shift;
990fb837 738
6320cdc0
SH		 739 if ($_trap_nan) {
740 my $class = ref($self);
741 # "$self" below will stringify the object, this blows up if $self is a
742 # partial object (happens under trap_nan), so fix it beforehand
0c2fbbe3
CBW		 743 $self->{_d} = $LIB->_zero() unless defined $self->{_d};
744 $self->{_n} = $LIB->_zero() unless defined $self->{_n};
6320cdc0 745 Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
990fb837 746 }
0c2fbbe3
CBW		 747 $self->{_n} = $LIB->_zero();
748 $self->{_d} = $LIB->_zero();
6320cdc0 749}
184f15d5 750
6320cdc0
SH		 751sub _binf {
752 # used by parent class bone() to initialize number to +inf/-inf
753 my $self = shift;
990fb837 754
6320cdc0
SH		 755 if ($_trap_inf) {
756 my $class = ref($self);
757 # "$self" below will stringify the object, this blows up if $self is a
758 # partial object (happens under trap_nan), so fix it beforehand
0c2fbbe3
CBW		 759 $self->{_d} = $LIB->_zero() unless defined $self->{_d};
760 $self->{_n} = $LIB->_zero() unless defined $self->{_n};
6320cdc0 761 Carp::croak ("Tried to set $self to inf in $class\::_binf()");
990fb837 762 }
0c2fbbe3
CBW		 763 $self->{_n} = $LIB->_zero();
764 $self->{_d} = $LIB->_zero();
6320cdc0
SH		 765}
766
767sub _bone {
768 # used by parent class bone() to initialize number to +1/-1
769 my $self = shift;
0c2fbbe3
CBW		 770 $self->{_n} = $LIB->_one();
771 $self->{_d} = $LIB->_one();
6320cdc0
SH		 772}
773
774sub _bzero {
775 # used by parent class bzero() to initialize number to 0
776 my $self = shift;
0c2fbbe3
CBW		 777 $self->{_n} = $LIB->_zero();
778 $self->{_d} = $LIB->_one();
6320cdc0 779}
184f15d5
JH		 780
781##############################################################################
782# mul/add/div etc
783
6320cdc0
SH		 784sub badd {
785 # add two rational numbers
7d341013 786
6320cdc0
SH		 787 # set up parameters
788 my ($class, $x, $y, @r) = (ref($_[0]), @_);
789 # objectify is costly, so avoid it
790 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
791 ($class, $x, $y, @r) = objectify(2, @_);
7d341013 792 }
184f15d5 793
6320cdc0
SH		 794 # +inf + +inf => +inf, -inf + -inf => -inf
795 return $x->binf(substr($x->{sign}, 0, 1))
796 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
184f15d5 797
6320cdc0
SH		 798 # +inf + -inf or -inf + +inf => NaN
799 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
184f15d5 800
6320cdc0
SH		 801 # 1 1 gcd(3, 4) = 1 1*3 + 1*4 7
802 # - + - = --------- = --
803 # 4 3 4*3 12
184f15d5 804
6320cdc0
SH		 805 # we do not compute the gcd() here, but simple do:
806 # 5 7 5*3 + 7*4 43
807 # - + - = --------- = --
808 # 4 3 4*3 12
ccbfef19 809
6320cdc0 810 # and bnorm() will then take care of the rest
184f15d5 811
6320cdc0 812 # 5 * 3
0c2fbbe3 813 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
7d341013 814
6320cdc0 815 # 7 * 4
0c2fbbe3 816 my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
184f15d5 817
6320cdc0
SH		 818 # 5 * 3 + 7 * 4
819 ($x->{_n}, $x->{sign}) = _e_add($x->{_n}, $m, $x->{sign}, $y->{sign});
184f15d5 820
6320cdc0 821 # 4 * 3
0c2fbbe3 822 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});
184f15d5 823
6320cdc0
SH		 824 # normalize result, and possible round
825 $x->bnorm()->round(@r);
826}
184f15d5 827
6320cdc0
SH		 828sub bsub {
829 # subtract two rational numbers
7d341013 830
6320cdc0
SH		 831 # set up parameters
832 my ($class, $x, $y, @r) = (ref($_[0]), @_);
833 # objectify is costly, so avoid it
834 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
835 ($class, $x, $y, @r) = objectify(2, @_);
7d341013 836 }
184f15d5 837
6320cdc0
SH		 838 # flip sign of $x, call badd(), then flip sign of result
839 $x->{sign} =~ tr/+-/-+/
0c2fbbe3 840 unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
6320cdc0
SH		 841 $x->badd($y, @r); # does norm and round
842 $x->{sign} =~ tr/+-/-+/
0c2fbbe3 843 unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
6320cdc0
SH		 844
845 $x;
846}
847
848sub bmul {
849 # multiply two rational numbers
850
851 # set up parameters
852 my ($class, $x, $y, @r) = (ref($_[0]), @_);
853 # objectify is costly, so avoid it
854 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
855 ($class, $x, $y, @r) = objectify(2, @_);
7d341013 856 }
184f15d5 857
0c2fbbe3 858 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
184f15d5 859
6320cdc0 860 # inf handling
0c2fbbe3 861 if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) {
6320cdc0
SH		 862 return $x->bnan() if $x->is_zero() || $y->is_zero();
863 # result will always be +-inf:
864 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
865 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
866 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
867 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
868 return $x->binf('-');
184f15d5
JH		 869 }
870
0c2fbbe3
CBW		 871 # x == 0 # also: or y == 1 or y == -1
872 return wantarray ? ($x, $class->bzero()) : $x if $x -> is_zero();
184f15d5 873
0c2fbbe3
CBW		 874 if ($y -> is_zero()) {
875 $x -> bzero();
876 return wantarray ? ($x, $class->bzero()) : $x;
877 }
184f15d5 878
0c2fbbe3
CBW		 879 # According to Knuth, this can be optimized by doing gcd twice (for d
880 # and n) and reducing in one step. This saves us a bnorm() at the end.
881 #
882 # p s p * s (p / gcd(p, r)) * (s / gcd(s, q))
883 # - * - = ----- = ---------------------------------
884 # q r q * r (q / gcd(s, q)) * (r / gcd(p, r))
ccbfef19 885
0c2fbbe3
CBW		 886 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d});
887 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});
888
889 $x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
92c15a49
EH		 890 scalar $LIB -> _div($LIB -> _copy($y->{_n}),
891 $gcd_sq));
0c2fbbe3 892 $x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
92c15a49
EH		 893 scalar $LIB -> _div($LIB -> _copy($y->{_d}),
894 $gcd_pr));
184f15d5 895
6320cdc0
SH		 896 # compute new sign
897 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
184f15d5 898
0c2fbbe3 899 $x->round(@r);
6320cdc0 900}
184f15d5 901
6320cdc0
SH		 902sub bdiv {
903 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
904 # (BRAT, BRAT) (quo, rem) or BRAT (only rem)
7d341013 905
6320cdc0
SH		 906 # set up parameters
907 my ($class, $x, $y, @r) = (ref($_[0]), @_);
908 # objectify is costly, so avoid it
909 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
910 ($class, $x, $y, @r) = objectify(2, @_);
7d341013 911 }
184f15d5 912
6320cdc0 913 return $x if $x->modify('bdiv');
184f15d5 914
6320cdc0 915 my $wantarray = wantarray; # call only once
3f185657
PJA		 916
917 # At least one argument is NaN. This is handled the same way as in
918 # Math::BigInt -> bdiv(). See the comments in the code implementing that
919 # method.
920
921 if ($x -> is_nan() || $y -> is_nan()) {
6320cdc0 922 return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
3f185657
PJA		 923 }
924
925 # Divide by zero and modulo zero. This is handled the same way as in
926 # Math::BigInt -> bdiv(). See the comments in the code implementing that
927 # method.
928
929 if ($y -> is_zero()) {
930 my ($quo, $rem);
931 if ($wantarray) {
932 $rem = $x -> copy();
933 }
934 if ($x -> is_zero()) {
935 $quo = $x -> bnan();
936 } else {
937 $quo = $x -> binf($x -> {sign});
938 }
939 return $wantarray ? ($quo, $rem) : $quo;
940 }
941
942 # Numerator (dividend) is +/-inf. This is handled the same way as in
943 # Math::BigInt -> bdiv(). See the comments in the code implementing that
944 # method.
945
946 if ($x -> is_inf()) {
947 my ($quo, $rem);
6320cdc0 948 $rem = $class -> bnan() if $wantarray;
3f185657
PJA		 949 if ($y -> is_inf()) {
950 $quo = $x -> bnan();
951 } else {
952 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
953 $quo = $x -> binf($sign);
954 }
6320cdc0
SH		 955 return $wantarray ? ($quo, $rem) : $quo;
956 }
957
958 # Denominator (divisor) is +/-inf. This is handled the same way as in
959 # Math::BigFloat -> bdiv(). See the comments in the code implementing that
960 # method.
961
962 if ($y -> is_inf()) {
963 my ($quo, $rem);
964 if ($wantarray) {
965 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
966 $rem = $x -> copy();
967 $quo = $x -> bzero();
968 } else {
969 $rem = $class -> binf($y -> {sign});
970 $quo = $x -> bone('-');
971 }
972 return ($quo, $rem);
973 } else {
974 if ($y -> is_inf()) {
975 if ($x -> is_nan() || $x -> is_inf()) {
976 return $x -> bnan();
977 } else {
978 return $x -> bzero();
979 }
980 }
981 }
982 }
983
984 # At this point, both the numerator and denominator are finite numbers, and
985 # the denominator (divisor) is non-zero.
986
987 # x == 0?
988 return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero();
989
990 # XXX TODO: list context, upgrade
991 # According to Knuth, this can be optimized by doing gcd twice (for d and n)
992 # and reducing in one step. This would save us the bnorm() at the end.
0c2fbbe3
CBW		 993 #
994 # p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
995 # - / - = ----- = ---------------------------------
996 # q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
6320cdc0 997
0c2fbbe3
CBW		 998 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
999 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_n});
6320cdc0
SH		 1000
1001 # compute new sign
1002 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
1003
1004 $x -> bnorm();
1005 if (wantarray) {
1006 my $rem = $x -> copy();
1007 $x -> bfloor();
1008 $x -> round(@r);
1009 $rem -> bsub($x -> copy()) -> bmul($y);
1010 return $x, $rem;
1011 } else {
1012 $x -> round(@r);
1013 return $x;
1014 }
1015}
1016
1017sub bmod {
1018 # compute "remainder" (in Perl way) of $x / $y
1019
1020 # set up parameters
1021 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1022 # objectify is costly, so avoid it
1023 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1024 ($class, $x, $y, @r) = objectify(2, @_);
1025 }
1026
1027 return $x if $x->modify('bmod');
1028
1029 # At least one argument is NaN. This is handled the same way as in
1030 # Math::BigInt -> bmod().
1031
1032 if ($x -> is_nan() || $y -> is_nan()) {
1033 return $x -> bnan();
1034 }
1035
1036 # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
1037
1038 if ($y -> is_zero()) {
1039 return $x;
1040 }
1041
1042 # Numerator (dividend) is +/-inf. This is handled the same way as in
1043 # Math::BigInt -> bmod().
1044
1045 if ($x -> is_inf()) {
1046 return $x -> bnan();
1047 }
1048
1049 # Denominator (divisor) is +/-inf. This is handled the same way as in
1050 # Math::BigInt -> bmod().
1051
1052 if ($y -> is_inf()) {
1053 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
1054 return $x;
1055 } else {
1056 return $x -> binf($y -> sign());
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 return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
1064
1065 # Compute $x - $y * floor($x/$y). This can probably be optimized by working
1066 # on a lower level.
1067
1068 $x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y));
1069 return $x -> round(@r);
1070}
1071
1072##############################################################################
1073# bdec/binc
1074
1075sub bdec {
1076 # decrement value (subtract 1)
1077 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1078
1079 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
1080
1081 if ($x->{sign} eq '-') {
0c2fbbe3 1082 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
6320cdc0 1083 } else {
0c2fbbe3 1084 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d?
6320cdc0
SH		 1085 {
1086 # 1/3 -- => -2/3
0c2fbbe3 1087 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
6320cdc0
SH		 1088 $x->{sign} = '-';
1089 } else {
0c2fbbe3 1090 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
6320cdc0
SH		 1091 }
1092 }
1093 $x->bnorm()->round(@r);
1094}
1095
1096sub binc {
1097 # increment value (add 1)
1098 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1099
1100 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
1101
1102 if ($x->{sign} eq '-') {
0c2fbbe3 1103 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
6320cdc0 1104 # -1/3 ++ => 2/3 (overflow at 0)
0c2fbbe3 1105 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
6320cdc0
SH		 1106 $x->{sign} = '+';
1107 } else {
0c2fbbe3 1108 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
6320cdc0
SH		 1109 }
1110 } else {
0c2fbbe3 1111 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2
6320cdc0
SH		 1112 }
1113 $x->bnorm()->round(@r);
1114}
1115
1116##############################################################################
1117# is_foo methods (the rest is inherited)
1118
1119sub is_int {
1120 # return true if arg (BRAT or num_str) is an integer
1121 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1122
1123 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
0c2fbbe3 1124 $LIB->_is_one($x->{_d}); # x/y && y != 1 => no integer
6320cdc0
SH		 1125 0;
1126}
1127
1128sub is_zero {
1129 # return true if arg (BRAT or num_str) is zero
1130 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1131
0c2fbbe3 1132 return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n});
6320cdc0
SH		 1133 0;
1134}
1135
1136sub is_one {
1137 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
1138 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1139
1140 my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
1141 return 1
0c2fbbe3 1142 if ($x->{sign} eq $sign && $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
6320cdc0
SH		 1143 0;
1144}
1145
1146sub is_odd {
1147 # return true if arg (BFLOAT or num_str) is odd or false if even
1148 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1149
1150 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
0c2fbbe3 1151 ($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1
6320cdc0
SH		 1152 0;
1153}
1154
1155sub is_even {
1156 # return true if arg (BINT or num_str) is even or false if odd
1157 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1158
1159 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
0c2fbbe3
CBW		 1160 return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never
1161 && $LIB->_is_even($x->{_n})); # but 4/1 is
6320cdc0
SH		 1162 0;
1163}
1164
1165##############################################################################
1166# parts() and friends
1167
1168sub numerator {
1169 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1170
1171 # NaN, inf, -inf
1172 return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
1173
0c2fbbe3 1174 my $n = Math::BigInt->new($LIB->_str($x->{_n}));
6320cdc0
SH		 1175 $n->{sign} = $x->{sign};
1176 $n;
1177}
1178
1179sub denominator {
1180 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1181
1182 # NaN
1183 return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
1184 # inf, -inf
1185 return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
1186
0c2fbbe3 1187 Math::BigInt->new($LIB->_str($x->{_d}));
6320cdc0
SH		 1188}
1189
1190sub parts {
1191 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1192
1193 my $c = 'Math::BigInt';
1194
1195 return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN';
1196 return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf';
1197 return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf';
1198
0c2fbbe3 1199 my $n = $c->new($LIB->_str($x->{_n}));
6320cdc0 1200 $n->{sign} = $x->{sign};
0c2fbbe3 1201 my $d = $c->new($LIB->_str($x->{_d}));
6320cdc0
SH		 1202 ($n, $d);
1203}
1204
1205sub length {
1206 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
1207
1208 return $nan unless $x->is_int();
0c2fbbe3 1209 $LIB->_len($x->{_n}); # length(-123/1) => length(123)
6320cdc0
SH		 1210}
1211
1212sub digit {
1213 my ($class, $x, $n) = ref($_[0]) ? (undef, $_[0], $_[1]) : objectify(1, @_);
1214
1215 return $nan unless $x->is_int();
0c2fbbe3 1216 $LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2)
6320cdc0
SH		 1217}
1218
1219##############################################################################
1220# special calc routines
1221
1222sub bceil {
1223 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1224
1225 return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
0c2fbbe3 1226 $LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
6320cdc0 1227
0c2fbbe3
CBW		 1228 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1229 $x->{_d} = $LIB->_one(); # d => 1
1230 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1
1231 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
6320cdc0
SH		 1232 $x;
1233}
1234
1235sub bfloor {
1236 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1237
1238 return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
0c2fbbe3 1239 $LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
6320cdc0 1240
0c2fbbe3
CBW		 1241 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1242 $x->{_d} = $LIB->_one(); # d => 1
1243 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1
6320cdc0
SH		 1244 $x;
1245}
1246
1247sub bint {
1248 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
1249
1250 return $x if ($x->{sign} !~ /^[+-]$/ || # +/-inf or NaN
0c2fbbe3 1251 $LIB -> _is_one($x->{_d})); # already an integer
6320cdc0 1252
0c2fbbe3
CBW		 1253 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
1254 $x->{_d} = $LIB->_one(); # d => 1
1255 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
6320cdc0
SH		 1256 return $x;
1257}
1258
1259sub bfac {
1260 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
1261
1262 # if $x is not an integer
0c2fbbe3 1263 if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) {
6320cdc0
SH		 1264 return $x->bnan();
1265 }
1266
0c2fbbe3 1267 $x->{_n} = $LIB->_fac($x->{_n});
6320cdc0
SH		 1268 # since _d is 1, we don't need to reduce/norm the result
1269 $x->round(@r);
1270}
1271
1272sub bpow {
1273 # power ($x ** $y)
1274
1275 # set up parameters
1276 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1277
1278 # objectify is costly, so avoid it
1279 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1280 ($class, $x, $y, @r) = objectify(2, @_);
1281 }
1282
1283 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
1284 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
1285 return $x->bone(@r) if $y->is_zero();
1286 return $x->round(@r) if $x->is_one() || $y->is_one();
1287
0c2fbbe3 1288 if ($x->{sign} eq '-' && $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d})) {
6320cdc0
SH		 1289 # if $x == -1 and odd/even y => +1/-1
1290 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
1291 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
1292 }
1293 # 1 ** -y => 1 / (1 ** |y|)
1294 # so do test for negative $y after above's clause
1295
1296 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
1297
1298 # shortcut if y == 1/N (is then sqrt() respective broot())
0c2fbbe3
CBW		 1299 if ($LIB->_is_one($y->{_n})) {
1300 return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
1301 return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N)
6320cdc0
SH		 1302 }
1303
1304 # shortcut y/1 (and/or x/1)
0c2fbbe3 1305 if ($LIB->_is_one($y->{_d})) {
6320cdc0 1306 # shortcut for x/1 and y/1
0c2fbbe3
CBW		 1307 if ($LIB->_is_one($x->{_d})) {
1308 $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); # x/1 ** y/1 => (x ** y)/1
6320cdc0
SH		 1309 if ($y->{sign} eq '-') {
1310 # 0.2 ** -3 => 1/(0.2 ** 3)
1311 ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}); # swap
1312 }
1313 # correct sign; + ** + => +
1314 if ($x->{sign} eq '-') {
1315 # - * - => +, - * - * - => -
0c2fbbe3 1316 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
6320cdc0
SH		 1317 }
1318 return $x->round(@r);
1319 }
1320
1321 # x/z ** y/1
0c2fbbe3
CBW		 1322 $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
1323 $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n});
6320cdc0
SH		 1324 if ($y->{sign} eq '-') {
1325 # 0.2 ** -3 => 1/(0.2 ** 3)
1326 ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}); # swap
1327 }
1328 # correct sign; + ** + => +
15f1cdaa 1329
0c2fbbe3 1330 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
6320cdc0
SH		 1331 return $x->round(@r);
1332 }
1333
1334 # print STDERR "# $x $y\n";
1335
1336 # otherwise:
1337
1338 # n/d n ______________
1339 # a/b = -\/ (a/b) ** d
1340
1341 # (a/b) ** n == (a ** n) / (b ** n)
0c2fbbe3
CBW		 1342 $LIB->_pow($x->{_n}, $y->{_n});
1343 $LIB->_pow($x->{_d}, $y->{_n});
6320cdc0 1344
0c2fbbe3 1345 return $x->broot($LIB->_str($y->{_d}), @r); # n/d => root(n)
6320cdc0
SH		 1346}
1347
1348sub blog {
1349 # Return the logarithm of the operand. If a second operand is defined, that
1350 # value is used as the base, otherwise the base is assumed to be Euler's
1351 # constant.
1352
92c15a49
EH		 1353 my ($class, $x, $base, @r);
1354
6320cdc0
SH		 1355 # Don't objectify the base, since an undefined base, as in $x->blog() or
1356 # $x->blog(undef) signals that the base is Euler's number.
1357
92c15a49
EH		 1358 if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
1359 # E.g., Math::BigFloat->blog(256, 2)
1360 ($class, $x, $base, @r) =
1361 defined $_[2] ? objectify(2, @_) : objectify(1, @_);
1362 } else {
1363 # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2)
1364 ($class, $x, $base, @r) =
1365 defined $_[1] ? objectify(2, @_) : objectify(1, @_);
6320cdc0
SH		 1366 }
1367
1368 return $x if $x->modify('blog');
1369
1370 # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
1371 # (http://www.wolframalpha.com) as the reference for these cases.
1372
1373 return $x -> bnan() if $x -> is_nan();
1374
1375 if (defined $base) {
1376 $base = $class -> new($base) unless ref $base;
1377 if ($base -> is_nan() || $base -> is_one()) {
1378 return $x -> bnan();
1379 } elsif ($base -> is_inf() || $base -> is_zero()) {
1380 return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
1381 return $x -> bzero();
1382 } elsif ($base -> is_negative()) { # -inf < base < 0
1383 return $x -> bzero() if $x -> is_one(); # x = 1
1384 return $x -> bone() if $x == $base; # x = base
1385 return $x -> bnan(); # otherwise
1386 }
1387 return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
1388 }
1389
1390 # We now know that the base is either undefined or positive and finite.
1391
1392 if ($x -> is_inf()) { # x = +/-inf
1393 my $sign = defined $base && $base < 1 ? '-' : '+';
1394 return $x -> binf($sign);
1395 } elsif ($x -> is_neg()) { # -inf < x < 0
1396 return $x -> bnan();
1397 } elsif ($x -> is_one()) { # x = 1
1398 return $x -> bzero();
1399 } elsif ($x -> is_zero()) { # x = 0
1400 my $sign = defined $base && $base < 1 ? '+' : '-';
1401 return $x -> binf($sign);
1402 }
1403
1404 # At this point we are done handling all exception cases and trivial cases.
1405
1406 $base = Math::BigFloat -> new($base) if defined $base;
1407
0c2fbbe3
CBW		 1408 my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
1409 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
6320cdc0
SH		 1410
1411 my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr());
1412
1413 $x -> {sign} = $xtmp -> {sign};
1414 $x -> {_n} = $xtmp -> {_n};
1415 $x -> {_d} = $xtmp -> {_d};
1416
1417 return $x;
1418}
1419
1420sub bexp {
1421 # set up parameters
1422 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1423
1424 # objectify is costly, so avoid it
1425 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
92c15a49 1426 ($class, $x, $y, @r) = objectify(1, @_);
6320cdc0
SH		 1427 }
1428
1429 return $x->binf(@r) if $x->{sign} eq '+inf';
1430 return $x->bzero(@r) if $x->{sign} eq '-inf';
1431
1432 # we need to limit the accuracy to protect against overflow
1433 my $fallback = 0;
1434 my ($scale, @params);
1435 ($x, @params) = $x->_find_round_parameters(@r);
1436
1437 # also takes care of the "error in _find_round_parameters?" case
1438 return $x if $x->{sign} eq 'NaN';
1439
1440 # no rounding at all, so must use fallback
1441 if (scalar @params == 0) {
1442 # simulate old behaviour
1443 $params[0] = $class->div_scale(); # and round to it as accuracy
1444 $params[1] = undef; # P = undef
1445 $scale = $params[0]+4; # at least four more for proper round
1446 $params[2] = $r[2]; # round mode by caller or undef
1447 $fallback = 1; # to clear a/p afterwards
1448 } else {
1449 # the 4 below is empirical, and there might be cases where it's not enough...
1450 $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
1451 }
1452
1453 return $x->bone(@params) if $x->is_zero();
1454
1455 # See the comments in Math::BigFloat on how this algorithm works.
1456 # Basically we calculate A and B (where B is faculty(N)) so that A/B = e
1457
1458 my $x_org = $x->copy();
1459 if ($scale <= 75) {
1460 # set $x directly from a cached string form
1461 $x->{_n} =
0c2fbbe3 1462 $LIB->_new("90933395208605785401971970164779391644753259799242");
6320cdc0 1463 $x->{_d} =
0c2fbbe3 1464 $LIB->_new("33452526613163807108170062053440751665152000000000");
6320cdc0
SH		 1465 $x->{sign} = '+';
1466 } else {
1467 # compute A and B so that e = A / B.
1468
1469 # After some terms we end up with this, so we use it as a starting point:
0c2fbbe3
CBW		 1470 my $A = $LIB->_new("90933395208605785401971970164779391644753259799242");
1471 my $F = $LIB->_new(42); my $step = 42;
6320cdc0
SH		 1472
1473 # Compute how many steps we need to take to get $A and $B sufficiently big
1474 my $steps = Math::BigFloat::_len_to_steps($scale - 4);
1475 # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
1476 while ($step++ <= $steps) {
1477 # calculate $a * $f + 1
0c2fbbe3
CBW		 1478 $A = $LIB->_mul($A, $F);
1479 $A = $LIB->_inc($A);
6320cdc0 1480 # increment f
0c2fbbe3 1481 $F = $LIB->_inc($F);
6320cdc0
SH		 1482 }
1483 # compute $B as factorial of $steps (this is faster than doing it manually)
0c2fbbe3 1484 my $B = $LIB->_fac($LIB->_new($steps));
6320cdc0 1485
0c2fbbe3 1486 # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
6320cdc0
SH		 1487
1488 $x->{_n} = $A;
1489 $x->{_d} = $B;
1490 $x->{sign} = '+';
3f185657
PJA		 1491 }
1492
6320cdc0
SH		 1493 # $x contains now an estimate of e, with some surplus digits, so we can round
1494 if (!$x_org->is_one()) {
1495 # raise $x to the wanted power and round it in one step:
1496 $x->bpow($x_org, @params);
1497 } else {
1498 # else just round the already computed result
1499 delete $x->{_a}; delete $x->{_p};
1500 # shortcut to not run through _find_round_parameters again
1501 if (defined $params[0]) {
1502 $x->bround($params[0], $params[2]); # then round accordingly
1503 } else {
1504 $x->bfround($params[1], $params[2]); # then round accordingly
1505 }
1506 }
1507 if ($fallback) {
1508 # clear a/p after round, since user did not request it
1509 delete $x->{_a}; delete $x->{_p};
990fb837
RGS		 1510 }
1511
6320cdc0
SH		 1512 $x;
1513}
990fb837 1514
6320cdc0
SH		 1515sub bnok {
1516 # set up parameters
1517 my ($class, $x, $y, @r) = (ref($_[0]), @_);
990fb837 1518
6320cdc0
SH		 1519 # objectify is costly, so avoid it
1520 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1521 ($class, $x, $y, @r) = objectify(2, @_);
3f185657 1522 }
990fb837 1523
6320cdc0
SH		 1524 my $xint = Math::BigInt -> new($x -> bint() -> bsstr());
1525 my $yint = Math::BigInt -> new($y -> bint() -> bsstr());
1526 $xint -> bnok($yint);
ccbfef19 1527
6320cdc0
SH		 1528 $x -> {sign} = $xint -> {sign};
1529 $x -> {_n} = $xint -> {_n};
1530 $x -> {_d} = $xint -> {_d};
ccbfef19 1531
6320cdc0
SH		 1532 return $x;
1533}
990fb837 1534
6320cdc0
SH		 1535sub broot {
1536 # set up parameters
1537 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1538 # objectify is costly, so avoid it
1539 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1540 ($class, $x, $y, @r) = objectify(2, @_);
3f185657 1541 }
990fb837 1542
6320cdc0 1543 # Convert $x into a Math::BigFloat.
3f185657 1544
0c2fbbe3
CBW		 1545 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1546 my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd);
6320cdc0 1547 $xflt -> {sign} = $x -> {sign};
3f185657 1548
6320cdc0 1549 # Convert $y into a Math::BigFloat.
3f185657 1550
0c2fbbe3
CBW		 1551 my $yd = Math::BigFloat -> new($LIB -> _str($y->{_d}));
1552 my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd);
6320cdc0 1553 $yflt -> {sign} = $y -> {sign};
3f185657 1554
6320cdc0 1555 # Compute the root and convert back to a Math::BigRat.
990fb837 1556
6320cdc0
SH		 1557 $xflt -> broot($yflt, @r);
1558 my $xtmp = Math::BigRat -> new($xflt -> bsstr());
a4e2b1c6 1559
6320cdc0
SH		 1560 $x -> {sign} = $xtmp -> {sign};
1561 $x -> {_n} = $xtmp -> {_n};
1562 $x -> {_d} = $xtmp -> {_d};
a4e2b1c6 1563
6320cdc0
SH		 1564 return $x;
1565}
a4e2b1c6 1566
6320cdc0
SH		 1567sub bmodpow {
1568 # set up parameters
1569 my ($class, $x, $y, $m, @r) = (ref($_[0]), @_);
1570 # objectify is costly, so avoid it
1571 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1572 ($class, $x, $y, $m, @r) = objectify(3, @_);
a4e2b1c6 1573 }
a4e2b1c6 1574
6320cdc0 1575 # Convert $x, $y, and $m into Math::BigInt objects.
ccbfef19 1576
6320cdc0
SH		 1577 my $xint = Math::BigInt -> new($x -> copy() -> bint());
1578 my $yint = Math::BigInt -> new($y -> copy() -> bint());
1579 my $mint = Math::BigInt -> new($m -> copy() -> bint());
a4e2b1c6 1580
6320cdc0
SH		 1581 $xint -> bmodpow($y, $m, @r);
1582 my $xtmp = Math::BigRat -> new($xint -> bsstr());
a4e2b1c6 1583
6320cdc0
SH		 1584 $x -> {sign} = $xtmp -> {sign};
1585 $x -> {_n} = $xtmp -> {_n};
1586 $x -> {_d} = $xtmp -> {_d};
1587 return $x;
1588}
184f15d5 1589
6320cdc0
SH		 1590sub bmodinv {
1591 # set up parameters
1592 my ($class, $x, $y, @r) = (ref($_[0]), @_);
1593 # objectify is costly, so avoid it
1594 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1595 ($class, $x, $y, @r) = objectify(2, @_);
1596 }
184f15d5 1597
6320cdc0 1598 # Convert $x and $y into Math::BigInt objects.
184f15d5 1599
6320cdc0
SH		 1600 my $xint = Math::BigInt -> new($x -> copy() -> bint());
1601 my $yint = Math::BigInt -> new($y -> copy() -> bint());
a4e2b1c6 1602
6320cdc0
SH		 1603 $xint -> bmodinv($y, @r);
1604 my $xtmp = Math::BigRat -> new($xint -> bsstr());
a4e2b1c6 1605
6320cdc0
SH		 1606 $x -> {sign} = $xtmp -> {sign};
1607 $x -> {_n} = $xtmp -> {_n};
1608 $x -> {_d} = $xtmp -> {_d};
1609 return $x;
1610}
184f15d5 1611
6320cdc0
SH		 1612sub bsqrt {
1613 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
184f15d5 1614
6320cdc0
SH		 1615 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1616 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1617 return $x->round(@r) if $x->is_zero() || $x->is_one();
ccbfef19 1618
6320cdc0
SH		 1619 local $Math::BigFloat::upgrade = undef;
1620 local $Math::BigFloat::downgrade = undef;
1621 local $Math::BigFloat::precision = undef;
1622 local $Math::BigFloat::accuracy = undef;
1623 local $Math::BigInt::upgrade = undef;
1624 local $Math::BigInt::precision = undef;
1625 local $Math::BigInt::accuracy = undef;
184f15d5 1626
0c2fbbe3
CBW		 1627 my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
1628 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
184f15d5 1629
6320cdc0 1630 my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());
12fc2493 1631
6320cdc0
SH		 1632 $x -> {sign} = $xtmp -> {sign};
1633 $x -> {_n} = $xtmp -> {_n};
1634 $x -> {_d} = $xtmp -> {_d};
a4e2b1c6 1635
6320cdc0
SH		 1636 $x->round(@r);
1637}
184f15d5 1638
6320cdc0
SH		 1639sub blsft {
1640 my ($class, $x, $y, $b, @r) = objectify(2, @_);
9b924220 1641
6320cdc0
SH		 1642 $b = 2 if !defined $b;
1643 $b = $class -> new($b) unless ref($b) && $b -> isa($class);
184f15d5 1644
6320cdc0 1645 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
9b924220 1646
6320cdc0
SH		 1647 # shift by a negative amount?
1648 return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
184f15d5 1649
6320cdc0
SH		 1650 $x -> bmul($b -> bpow($y));
1651}
184f15d5 1652
6320cdc0
SH		 1653sub brsft {
1654 my ($class, $x, $y, $b, @r) = objectify(2, @_);
12fc2493 1655
6320cdc0
SH		 1656 $b = 2 if !defined $b;
1657 $b = $class -> new($b) unless ref($b) && $b -> isa($class);
184f15d5 1658
6320cdc0 1659 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
7d341013 1660
6320cdc0
SH		 1661 # shift by a negative amount?
1662 return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
184f15d5 1663
6320cdc0
SH		 1664 # the following call to bdiv() will return either quotient (scalar context)
1665 # or quotient and remainder (list context).
1666 $x -> bdiv($b -> bpow($y));
1667}
12fc2493 1668
6320cdc0
SH		 1669sub band {
1670 my $x = shift;
1671 my $xref = ref($x);
1672 my $class = $xref || $x;
12fc2493 1673
6320cdc0
SH		 1674 Carp::croak 'band() is an instance method, not a class method' unless $xref;
1675 Carp::croak 'Not enough arguments for band()' if @_ < 1;
184f15d5 1676
6320cdc0
SH		 1677 my $y = shift;
1678 $y = $class -> new($y) unless ref($y);
4de3d162 1679
6320cdc0 1680 my @r = @_;
a4e2b1c6 1681
6320cdc0
SH		 1682 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1683 $xtmp -> band($y);
1684 $xtmp = $class -> new($xtmp); # back to Math::BigRat
12fc2493 1685
6320cdc0
SH		 1686 $x -> {sign} = $xtmp -> {sign};
1687 $x -> {_n} = $xtmp -> {_n};
1688 $x -> {_d} = $xtmp -> {_d};
4de3d162 1689
6320cdc0
SH		 1690 return $x -> round(@r);
1691}
4de3d162 1692
6320cdc0
SH		 1693sub bior {
1694 my $x = shift;
1695 my $xref = ref($x);
1696 my $class = $xref || $x;
4de3d162 1697
6320cdc0
SH		 1698 Carp::croak 'bior() is an instance method, not a class method' unless $xref;
1699 Carp::croak 'Not enough arguments for bior()' if @_ < 1;
184f15d5 1700
6320cdc0
SH		 1701 my $y = shift;
1702 $y = $class -> new($y) unless ref($y);
11c955be 1703
6320cdc0 1704 my @r = @_;
11c955be 1705
6320cdc0
SH		 1706 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1707 $xtmp -> bior($y);
1708 $xtmp = $class -> new($xtmp); # back to Math::BigRat
7afd7a91 1709
6320cdc0
SH		 1710 $x -> {sign} = $xtmp -> {sign};
1711 $x -> {_n} = $xtmp -> {_n};
1712 $x -> {_d} = $xtmp -> {_d};
7afd7a91 1713
6320cdc0
SH		 1714 return $x -> round(@r);
1715}
116a1b2f 1716
6320cdc0
SH		 1717sub bxor {
1718 my $x = shift;
1719 my $xref = ref($x);
1720 my $class = $xref || $x;
116a1b2f 1721
6320cdc0
SH		 1722 Carp::croak 'bxor() is an instance method, not a class method' unless $xref;
1723 Carp::croak 'Not enough arguments for bxor()' if @_ < 1;
116a1b2f 1724
6320cdc0
SH		 1725 my $y = shift;
1726 $y = $class -> new($y) unless ref($y);
116a1b2f 1727
6320cdc0 1728 my @r = @_;
116a1b2f 1729
6320cdc0
SH		 1730 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1731 $xtmp -> bxor($y);
1732 $xtmp = $class -> new($xtmp); # back to Math::BigRat
116a1b2f 1733
6320cdc0
SH		 1734 $x -> {sign} = $xtmp -> {sign};
1735 $x -> {_n} = $xtmp -> {_n};
1736 $x -> {_d} = $xtmp -> {_d};
116a1b2f 1737
6320cdc0
SH		 1738 return $x -> round(@r);
1739}
116a1b2f 1740
6320cdc0
SH		 1741sub bnot {
1742 my $x = shift;
1743 my $xref = ref($x);
1744 my $class = $xref || $x;
116a1b2f 1745
6320cdc0 1746 Carp::croak 'bnot() is an instance method, not a class method' unless $xref;
116a1b2f 1747
6320cdc0 1748 my @r = @_;
116a1b2f 1749
6320cdc0
SH		 1750 my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
1751 $xtmp -> bnot();
1752 $xtmp = $class -> new($xtmp); # back to Math::BigRat
116a1b2f 1753
6320cdc0
SH		 1754 $x -> {sign} = $xtmp -> {sign};
1755 $x -> {_n} = $xtmp -> {_n};
1756 $x -> {_d} = $xtmp -> {_d};
116a1b2f 1757
6320cdc0
SH		 1758 return $x -> round(@r);
1759}
12fc2493 1760
6320cdc0
SH		 1761##############################################################################
1762# round
12fc2493 1763
6320cdc0
SH		 1764sub round {
1765 $_[0];
1766}
12fc2493 1767
6320cdc0
SH		 1768sub bround {
1769 $_[0];
1770}
9b924220 1771
6320cdc0
SH		 1772sub bfround {
1773 $_[0];
1774}
12fc2493 1775
6320cdc0
SH		 1776##############################################################################
1777# comparing
7afd7a91 1778
6320cdc0
SH		 1779sub bcmp {
1780 # compare two signed numbers
9b924220 1781
6320cdc0
SH		 1782 # set up parameters
1783 my ($class, $x, $y) = (ref($_[0]), @_);
7afd7a91 1784
6320cdc0
SH		 1785 # objectify is costly, so avoid it
1786 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1787 ($class, $x, $y) = objectify(2, @_);
7afd7a91
T		 1788 }
1789
6320cdc0
SH		 1790 if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
1791 # $x is NaN and/or $y is NaN
1792 return undef if $x->{sign} eq $nan || $y->{sign} eq $nan;
1793 # $x and $y are both either +inf or -inf
1794 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1795 # $x = +inf and $y < +inf
1796 return +1 if $x->{sign} eq '+inf';
1797 # $x = -inf and $y > -inf
1798 return -1 if $x->{sign} eq '-inf';
1799 # $x < +inf and $y = +inf
1800 return -1 if $y->{sign} eq '+inf';
1801 # $x > -inf and $y = -inf
1802 return +1;
7afd7a91
T		 1803 }
1804
6320cdc0
SH		 1805 # $x >= 0 and $y < 0
1806 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';
1807 # $x < 0 and $y >= 0
1808 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';
7afd7a91 1809
6320cdc0 1810 # At this point, we know that $x and $y have the same sign.
7afd7a91 1811
6320cdc0 1812 # shortcut
0c2fbbe3
CBW		 1813 my $xz = $LIB->_is_zero($x->{_n});
1814 my $yz = $LIB->_is_zero($y->{_n});
6320cdc0
SH		 1815 return 0 if $xz && $yz; # 0 <=> 0
1816 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1817 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
7afd7a91 1818
0c2fbbe3
CBW		 1819 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
1820 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
7afd7a91 1821
0c2fbbe3 1822 my $cmp = $LIB->_acmp($t, $u); # signs are equal
6320cdc0
SH		 1823 $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
1824 $cmp;
1825}
184f15d5 1826
6320cdc0
SH		 1827sub bacmp {
1828 # compare two numbers (as unsigned)
990fb837 1829
6320cdc0
SH		 1830 # set up parameters
1831 my ($class, $x, $y) = (ref($_[0]), @_);
1832 # objectify is costly, so avoid it
1833 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
1834 ($class, $x, $y) = objectify(2, @_);
1835 }
990fb837 1836
6320cdc0
SH		 1837 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
1838 # handle +-inf and NaN
1839 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1840 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1841 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1842 return -1;
1843 }
9b924220 1844
0c2fbbe3
CBW		 1845 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
1846 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
1847 $LIB->_acmp($t, $u); # ignore signs
6320cdc0 1848}
12fc2493 1849
6320cdc0
SH		 1850sub beq {
1851 my $self = shift;
1852 my $selfref = ref $self;
1853 my $class = $selfref || $self;
184f15d5 1854
6320cdc0
SH		 1855 Carp::croak 'beq() is an instance method, not a class method' unless $selfref;
1856 Carp::croak 'Wrong number of arguments for beq()' unless @_ == 1;
12fc2493 1857
6320cdc0
SH		 1858 my $cmp = $self -> bcmp(shift);
1859 return defined($cmp) && ! $cmp;
1860}
12fc2493 1861
6320cdc0
SH		 1862sub bne {
1863 my $self = shift;
1864 my $selfref = ref $self;
1865 my $class = $selfref || $self;
184f15d5 1866
6320cdc0
SH		 1867 Carp::croak 'bne() is an instance method, not a class method' unless $selfref;
1868 Carp::croak 'Wrong number of arguments for bne()' unless @_ == 1;
ccbfef19 1869
6320cdc0
SH		 1870 my $cmp = $self -> bcmp(shift);
1871 return defined($cmp) && ! $cmp ? '' : 1;
1872}
184f15d5 1873
6320cdc0
SH		 1874sub blt {
1875 my $self = shift;
1876 my $selfref = ref $self;
1877 my $class = $selfref || $self;
184f15d5 1878
6320cdc0
SH		 1879 Carp::croak 'blt() is an instance method, not a class method' unless $selfref;
1880 Carp::croak 'Wrong number of arguments for blt()' unless @_ == 1;
184f15d5 1881
6320cdc0
SH		 1882 my $cmp = $self -> bcmp(shift);
1883 return defined($cmp) && $cmp < 0;
1884}
184f15d5 1885
6320cdc0
SH		 1886sub ble {
1887 my $self = shift;
1888 my $selfref = ref $self;
1889 my $class = $selfref || $self;
184f15d5 1890
6320cdc0
SH		 1891 Carp::croak 'ble() is an instance method, not a class method' unless $selfref;
1892 Carp::croak 'Wrong number of arguments for ble()' unless @_ == 1;
184f15d5 1893
6320cdc0
SH		 1894 my $cmp = $self -> bcmp(shift);
1895 return defined($cmp) && $cmp <= 0;
1896}
184f15d5 1897
6320cdc0
SH		 1898sub bgt {
1899 my $self = shift;
1900 my $selfref = ref $self;
1901 my $class = $selfref || $self;
184f15d5 1902
6320cdc0
SH		 1903 Carp::croak 'bgt() is an instance method, not a class method' unless $selfref;
1904 Carp::croak 'Wrong number of arguments for bgt()' unless @_ == 1;
ccbfef19 1905
6320cdc0
SH		 1906 my $cmp = $self -> bcmp(shift);
1907 return defined($cmp) && $cmp > 0;
1908}
184f15d5 1909
6320cdc0
SH		 1910sub bge {
1911 my $self = shift;
1912 my $selfref = ref $self;
1913 my $class = $selfref || $self;
184f15d5 1914
6320cdc0
SH		 1915 Carp::croak 'bge() is an instance method, not a class method'
1916 unless $selfref;
1917 Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1;
184f15d5 1918
6320cdc0
SH		 1919 my $cmp = $self -> bcmp(shift);
1920 return defined($cmp) && $cmp >= 0;
1921}
184f15d5
JH		 1922
1923##############################################################################
6320cdc0 1924# output conversion
184f15d5 1925
6320cdc0
SH		 1926sub numify {
1927 # convert 17/8 => float (aka 2.125)
1928 my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
ccbfef19 1929
6320cdc0 1930 # Non-finite number.
7d341013 1931
6320cdc0 1932 return $x->bstr() if $x->{sign} !~ /^[+-]$/;
93c87d9d 1933
6320cdc0 1934 # Finite number.
7d341013 1935
0c2fbbe3
CBW		 1936 my $abs = $LIB->_is_one($x->{_d})
1937 ? $LIB->_num($x->{_n})
1938 : Math::BigFloat -> new($LIB->_str($x->{_n}))
1939 -> bdiv($LIB->_str($x->{_d}))
6320cdc0
SH		 1940 -> bstr();
1941 return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
1942}
1943
1944sub as_number {
1945 my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
184f15d5 1946
6320cdc0
SH		 1947 # NaN, inf etc
1948 return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
1949
1950 my $u = Math::BigInt->bzero();
0c2fbbe3 1951 $u->{value} = $LIB->_div($LIB->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
6320cdc0
SH		 1952 $u->bneg if $x->{sign} eq '-'; # no negative zero
1953 $u;
1954}
ccbfef19 1955
6320cdc0
SH		 1956sub as_float {
1957 # return N/D as Math::BigFloat
184f15d5 1958
6320cdc0
SH		 1959 # set up parameters
1960 my ($class, $x, @r) = (ref($_[0]), @_);
1961 # objectify is costly, so avoid it
1962 ($class, $x, @r) = objectify(1, @_) unless ref $_[0];
4de3d162 1963
6320cdc0
SH		 1964 # NaN, inf etc
1965 return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
4de3d162 1966
0c2fbbe3
CBW		 1967 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
1968 my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n}));
6320cdc0
SH		 1969 $xflt -> {sign} = $x -> {sign};
1970 $xflt -> bdiv($xd, @r);
ccbfef19 1971
6320cdc0
SH		 1972 return $xflt;
1973}
4de3d162 1974
6320cdc0
SH		 1975sub as_bin {
1976 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
9b924220 1977
6320cdc0 1978 return $x unless $x->is_int();
9b924220 1979
6320cdc0
SH		 1980 my $s = $x->{sign};
1981 $s = '' if $s eq '+';
0c2fbbe3 1982 $s . $LIB->_as_bin($x->{_n});
6320cdc0 1983}
9b924220 1984
6320cdc0
SH		 1985sub as_hex {
1986 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
9b924220 1987
6320cdc0 1988 return $x unless $x->is_int();
9b924220 1989
6320cdc0 1990 my $s = $x->{sign}; $s = '' if $s eq '+';
0c2fbbe3 1991 $s . $LIB->_as_hex($x->{_n});
6320cdc0 1992}
9b924220 1993
6320cdc0
SH		 1994sub as_oct {
1995 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
b8884ce4 1996
6320cdc0 1997 return $x unless $x->is_int();
b8884ce4 1998
6320cdc0 1999 my $s = $x->{sign}; $s = '' if $s eq '+';
0c2fbbe3 2000 $s . $LIB->_as_oct($x->{_n});
6320cdc0 2001}
b8884ce4
T		 2002
2003##############################################################################
2004
6320cdc0
SH		 2005sub from_hex {
2006 my $class = shift;
b8884ce4 2007
6320cdc0
SH		 2008 $class->new(@_);
2009}
b8884ce4 2010
6320cdc0
SH		 2011sub from_bin {
2012 my $class = shift;
b8884ce4 2013
6320cdc0
SH		 2014 $class->new(@_);
2015}
b8884ce4 2016
6320cdc0
SH		 2017sub from_oct {
2018 my $class = shift;
b8884ce4 2019
6320cdc0
SH		 2020 my @parts;
2021 for my $c (@_) {
2022 push @parts, Math::BigInt->from_oct($c);
b8884ce4 2023 }
6320cdc0
SH		 2024 $class->new (@parts);
2025}
b8884ce4 2026
b68b7ab1
T		 2027##############################################################################
2028# import
2029
6320cdc0
SH		 2030sub import {
2031 my $class = shift;
2032 my $l = scalar @_;
2033 my $lib = ''; my @a;
2034 my $try = 'try';
9b924220 2035
6320cdc0
SH		 2036 for (my $i = 0; $i < $l ; $i++) {
2037 if ($_[$i] eq ':constant') {
2038 # this rest causes overlord er load to step in
2039 overload::constant float => sub { $class->new(shift); };
2040 }
2041 # elsif ($_[$i] eq 'upgrade')
2042 # {
2043 # # this causes upgrading
2044 # $upgrade = $_[$i+1]; # or undef to disable
2045 # $i++;
2046 # }
2047 elsif ($_[$i] eq 'downgrade') {
2048 # this causes downgrading
2049 $downgrade = $_[$i+1]; # or undef to disable
2050 $i++;
2051 } elsif ($_[$i] =~ /^(lib|try|only)\z/) {
2052 $lib = $_[$i+1] || ''; # default Calc
2053 $try = $1; # lib, try or only
2054 $i++;
2055 } elsif ($_[$i] eq 'with') {
2056 # this argument is no longer used
0c2fbbe3 2057 #$LIB = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
6320cdc0
SH		 2058 $i++;
2059 } else {
2060 push @a, $_[$i];
2061 }
6de7f0cc 2062 }
6320cdc0 2063 require Math::BigInt;
6de7f0cc 2064
6320cdc0
SH		 2065 # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
2066 if ($lib ne '') {
2067 my @c = split /\s*,\s*/, $lib;
2068 foreach (@c) {
2069 $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
2070 }
2071 $lib = join(",", @c);
93c87d9d 2072 }
6320cdc0
SH		 2073 my @import = ('objectify');
2074 push @import, $try => $lib if $lib ne '';
233f7bc0 2075
0c2fbbe3 2076 # LIB already loaded, so feed it our lib arguments
6320cdc0 2077 Math::BigInt->import(@import);
6de7f0cc 2078
0c2fbbe3 2079 $LIB = Math::BigFloat->config()->{lib};
b68b7ab1 2080
0c2fbbe3
CBW		 2081 # register us with LIB to get notified of future lib changes
2082 Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
ccbfef19 2083
6320cdc0
SH		 2084 # any non :constant stuff is handled by our parent, Exporter (loaded
2085 # by Math::BigFloat, even if @_ is empty, to give it a chance
2086 $class->SUPER::import(@a); # for subclasses
2087 $class->export_to_level(1, $class, @a); # need this, too
2088}
184f15d5
JH		 2089
20901;
2091
2092__END__
2093
a7752796
PJA		 2094=pod
2095
184f15d5
JH		 2096=head1 NAME
2097
b68b7ab1 2098Math::BigRat - Arbitrary big rational numbers
184f15d5
JH		 2099
2100=head1 SYNOPSIS
2101
6320cdc0 2102 use Math::BigRat;
184f15d5 2103
6320cdc0 2104 my $x = Math::BigRat->new('3/7'); $x += '5/9';
184f15d5 2105
6320cdc0
SH		 2106 print $x->bstr(), "\n";
2107 print $x ** 2, "\n";
184f15d5 2108
6320cdc0
SH		 2109 my $y = Math::BigRat->new('inf');
2110 print "$y ", ($y->is_inf ? 'is' : 'is not'), " infinity\n";
7afd7a91 2111
6320cdc0 2112 my $z = Math::BigRat->new(144); $z->bsqrt();
7afd7a91 2113
184f15d5
JH		 2114=head1 DESCRIPTION
2115
7d341013 2116Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
b68b7ab1 2117for arbitrary big rational numbers.
184f15d5
JH		 2118
2119=head2 MATH LIBRARY
2120
b8884ce4
T		 2121You can change the underlying module that does the low-level
2122math operations by using:
184f15d5 2123
6320cdc0 2124 use Math::BigRat try => 'GMP';
184f15d5 2125
b8884ce4 2126Note: This needs Math::BigInt::GMP installed.
184f15d5
JH		 2127
2128The following would first try to find Math::BigInt::Foo, then
2129Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
2130
6320cdc0 2131 use Math::BigRat try => 'Foo,Math::BigInt::Bar';
184f15d5 2132
6320cdc0 2133If you want to get warned when the fallback occurs, replace "try" with "lib":
184f15d5 2134
6320cdc0 2135 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
7d341013 2136
6320cdc0 2137If you want the code to die instead, replace "try" with "only":
b8884ce4 2138
6320cdc0 2139 use Math::BigRat only => 'Foo,Math::BigInt::Bar';
7d341013 2140
184f15d5
JH		 2141=head1 METHODS
2142
3c4b39be 2143Any methods not listed here are derived from Math::BigFloat (or
6de7f0cc
JH		 2144Math::BigInt), so make sure you check these two modules for further
2145information.
2146
6320cdc0
SH		 2147=over
2148
2149=item new()
184f15d5 2150
6320cdc0 2151 $x = Math::BigRat->new('1/3');
184f15d5
JH		 2152
2153Create a new Math::BigRat object. Input can come in various forms:
2154
6320cdc0
SH		 2155 $x = Math::BigRat->new(123); # scalars
2156 $x = Math::BigRat->new('inf'); # infinity
2157 $x = Math::BigRat->new('123.3'); # float
2158 $x = Math::BigRat->new('1/3'); # simple string
2159 $x = Math::BigRat->new('1 / 3'); # spaced
2160 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
2161 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
2162 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
2163 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
184f15d5 2164
6320cdc0
SH		 2165 # You can also give D and N as different objects:
2166 $x = Math::BigRat->new(
2167 Math::BigInt->new(-123),
2168 Math::BigInt->new(7),
2169 ); # => -123/7
b68b7ab1 2170
6320cdc0 2171=item numerator()
184f15d5 2172
6320cdc0 2173 $n = $x->numerator();
184f15d5
JH		 2174
2175Returns a copy of the numerator (the part above the line) as signed BigInt.
2176
6320cdc0 2177=item denominator()
ccbfef19 2178
6320cdc0 2179 $d = $x->denominator();
184f15d5
JH		 2180
2181Returns a copy of the denominator (the part under the line) as positive BigInt.
2182
6320cdc0 2183=item parts()
184f15d5 2184
6320cdc0 2185 ($n, $d) = $x->parts();
184f15d5
JH		 2186
2187Return a list consisting of (signed) numerator and (unsigned) denominator as
2188BigInts.
2189
6320cdc0 2190=item numify()
b8884ce4 2191
6320cdc0 2192 my $y = $x->numify();
b8884ce4
T		 2193
2194Returns the object as a scalar. This will lose some data if the object
2195cannot be represented by a normal Perl scalar (integer or float), so
6320cdc0 2196use L<as_int()|/"as_int()/as_number()"> or L</as_float()> instead.
b8884ce4
T		 2197
2198This routine is automatically used whenever a scalar is required:
2199
6320cdc0
SH		 2200 my $x = Math::BigRat->new('3/1');
2201 @array = (0, 1, 2, 3);
2202 $y = $array[$x]; # set $y to 3
b8884ce4 2203
6320cdc0 2204=item as_int()/as_number()
6de7f0cc 2205
6320cdc0
SH		 2206 $x = Math::BigRat->new('13/7');
2207 print $x->as_int(), "\n"; # '1'
b68b7ab1
T		 2208
2209Returns a copy of the object as BigInt, truncated to an integer.
7d341013 2210
b68b7ab1
T		 2211C<as_number()> is an alias for C<as_int()>.
2212
6320cdc0 2213=item as_float()
4de3d162 2214
6320cdc0
SH		 2215 $x = Math::BigRat->new('13/7');
2216 print $x->as_float(), "\n"; # '1'
4de3d162 2217
6320cdc0
SH		 2218 $x = Math::BigRat->new('2/3');
2219 print $x->as_float(5), "\n"; # '0.66667'
4de3d162
T		 2220
2221Returns a copy of the object as BigFloat, preserving the
2222accuracy as wanted, or the default of 40 digits.
2223
2224This method was added in v0.22 of Math::BigRat (April 2008).
2225
6320cdc0 2226=item as_hex()
b68b7ab1 2227
6320cdc0
SH		 2228 $x = Math::BigRat->new('13');
2229 print $x->as_hex(), "\n"; # '0xd'
b68b7ab1 2230
ccbfef19 2231Returns the BigRat as hexadecimal string. Works only for integers.
b68b7ab1 2232
6320cdc0 2233=item as_bin()
b68b7ab1 2234
6320cdc0
SH		 2235 $x = Math::BigRat->new('13');
2236 print $x->as_bin(), "\n"; # '0x1101'
b68b7ab1 2237
ccbfef19 2238Returns the BigRat as binary string. Works only for integers.
6de7f0cc 2239
6320cdc0 2240=item as_oct()
b8884ce4 2241
6320cdc0
SH		 2242 $x = Math::BigRat->new('13');
2243 print $x->as_oct(), "\n"; # '015'
b8884ce4 2244
ccbfef19 2245Returns the BigRat as octal string. Works only for integers.
b8884ce4 2246
6320cdc0
SH		 2247=item from_hex()
2248
2249 my $h = Math::BigRat->from_hex('0x10');
2250
2251Create a BigRat from a hexadecimal number in string form.
2252
2253=item from_oct()
2254
2255 my $o = Math::BigRat->from_oct('020');
2256
2257Create a BigRat from an octal number in string form.
2258
2259=item from_bin()
2260
2261 my $b = Math::BigRat->from_bin('0b10000000');
2262
2263Create a BigRat from an binary number in string form.
2264
2265=item bnan()
2266
2267 $x = Math::BigRat->bnan();
2268
2269Creates a new BigRat object representing NaN (Not A Number).
2270If used on an object, it will set it to NaN:
2271
2272 $x->bnan();
b8884ce4 2273
6320cdc0 2274=item bzero()
b8884ce4 2275
6320cdc0 2276 $x = Math::BigRat->bzero();
b8884ce4 2277
6320cdc0
SH		 2278Creates a new BigRat object representing zero.
2279If used on an object, it will set it to zero:
b8884ce4 2280
6320cdc0
SH		 2281 $x->bzero();
2282
2283=item binf()
2284
2285 $x = Math::BigRat->binf($sign);
2286
2287Creates a new BigRat object representing infinity. The optional argument is
2288either '-' or '+', indicating whether you want infinity or minus infinity.
2289If used on an object, it will set it to infinity:
2290
2291 $x->binf();
2292 $x->binf('-');
2293
2294=item bone()
2295
2296 $x = Math::BigRat->bone($sign);
2297
2298Creates a new BigRat object representing one. The optional argument is
2299either '-' or '+', indicating whether you want one or minus one.
2300If used on an object, it will set it to one:
2301
2302 $x->bone(); # +1
2303 $x->bone('-'); # -1
2304
2305=item length()
2306
2307 $len = $x->length();
b8884ce4 2308
c4a6f826 2309Return the length of $x in digits for integer values.
b8884ce4 2310
6320cdc0 2311=item digit()
b8884ce4 2312
6320cdc0
SH		 2313 print Math::BigRat->new('123/1')->digit(1); # 1
2314 print Math::BigRat->new('123/1')->digit(-1); # 3
b8884ce4
T		 2315
2316Return the N'ths digit from X when X is an integer value.
2317
6320cdc0 2318=item bnorm()
b8884ce4 2319
6320cdc0 2320 $x->bnorm();
b8884ce4
T		 2321
2322Reduce the number to the shortest form. This routine is called
2323automatically whenever it is needed.
2324
6320cdc0 2325=item bfac()
6de7f0cc 2326
6320cdc0 2327 $x->bfac();
6de7f0cc 2328
a4e2b1c6 2329Calculates the factorial of $x. For instance:
6de7f0cc 2330
6320cdc0
SH		 2331 print Math::BigRat->new('3/1')->bfac(), "\n"; # 1*2*3
2332 print Math::BigRat->new('5/1')->bfac(), "\n"; # 1*2*3*4*5
184f15d5 2333
7d341013 2334Works currently only for integers.
6de7f0cc 2335
6320cdc0 2336=item bround()/round()/bfround()
6de7f0cc 2337
a4e2b1c6 2338Are not yet implemented.
6de7f0cc 2339
6320cdc0 2340=item bmod()
990fb837 2341
6320cdc0 2342 $x->bmod($y);
990fb837 2343
3f185657
PJA		 2344Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
2345result is identical to the remainder after floored division (F-division). If,
2346in addition, both $x and $y are integers, the result is identical to the result
2347from Perl's % operator.
990fb837 2348
6320cdc0
SH		 2349=item bmodinv()
2350
2351 $x->bmodinv($mod); # modular multiplicative inverse
2352
2353Returns the multiplicative inverse of C<$x> modulo C<$mod>. If
2354
2355 $y = $x -> copy() -> bmodinv($mod)
2356
2357then C<$y> is the number closest to zero, and with the same sign as C<$mod>,
2358satisfying
2359
2360 ($x * $y) % $mod = 1 % $mod
2361
2362If C<$x> and C<$y> are non-zero, they must be relative primes, i.e.,
2363C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative
2364inverse exists.
b8884ce4 2365
6320cdc0
SH		 2366=item bmodpow()
2367
2368 $num->bmodpow($exp,$mod); # modular exponentiation
2369 # ($num**$exp % $mod)
2370
2371Returns the value of C<$num> taken to the power C<$exp> in the modulus
2372C<$mod> using binary exponentiation. C<bmodpow> is far superior to
2373writing
2374
2375 $num ** $exp % $mod
2376
2377because it is much faster - it reduces internal variables into
2378the modulus whenever possible, so it operates on smaller numbers.
2379
2380C<bmodpow> also supports negative exponents.
2381
2382 bmodpow($num, -1, $mod)
2383
2384is exactly equivalent to
2385
2386 bmodinv($num, $mod)
2387
2388=item bneg()
2389
2390 $x->bneg();
b8884ce4
T		 2391
2392Used to negate the object in-place.
2393
6320cdc0 2394=item is_one()
7d341013 2395
6320cdc0 2396 print "$x is 1\n" if $x->is_one();
7d341013
T		 2397
2398Return true if $x is exactly one, otherwise false.
2399
6320cdc0 2400=item is_zero()
7d341013 2401
6320cdc0 2402 print "$x is 0\n" if $x->is_zero();
7d341013
T		 2403
2404Return true if $x is exactly zero, otherwise false.
2405
6320cdc0 2406=item is_pos()/is_positive()
7d341013 2407
6320cdc0 2408 print "$x is >= 0\n" if $x->is_positive();
7d341013
T		 2409
2410Return true if $x is positive (greater than or equal to zero), otherwise
2411false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
2412
b68b7ab1
T		 2413C<is_positive()> is an alias for C<is_pos()>.
2414
6320cdc0 2415=item is_neg()/is_negative()
7d341013 2416
6320cdc0 2417 print "$x is < 0\n" if $x->is_negative();
7d341013
T		 2418
2419Return true if $x is negative (smaller than zero), otherwise false. Please
2420note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
2421
b68b7ab1
T		 2422C<is_negative()> is an alias for C<is_neg()>.
2423
6320cdc0 2424=item is_int()
7d341013 2425
6320cdc0 2426 print "$x is an integer\n" if $x->is_int();
7d341013
T		 2427
2428Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
2429false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
2430
6320cdc0 2431=item is_odd()
7d341013 2432
6320cdc0 2433 print "$x is odd\n" if $x->is_odd();
7d341013
T		 2434
2435Return true if $x is odd, otherwise false.
2436
6320cdc0 2437=item is_even()
7d341013 2438
6320cdc0 2439 print "$x is even\n" if $x->is_even();
7d341013
T		 2440
2441Return true if $x is even, otherwise false.
2442
6320cdc0 2443=item bceil()
7d341013 2444
6320cdc0 2445 $x->bceil();
7d341013
T		 2446
2447Set $x to the next bigger integer value (e.g. truncate the number to integer
2448and then increment it by one).
2449
6320cdc0 2450=item bfloor()
ccbfef19 2451
6320cdc0 2452 $x->bfloor();
7d341013
T		 2453
2454Truncate $x to an integer value.
6de7f0cc 2455
6320cdc0
SH		 2456=item bint()
2457
2458 $x->bint();
2459
2460Round $x towards zero.
ccbfef19 2461
6320cdc0
SH		 2462=item bsqrt()
2463
2464 $x->bsqrt();
7afd7a91
T		 2465
2466Calculate the square root of $x.
2467
6320cdc0 2468=item broot()
ccbfef19 2469
6320cdc0 2470 $x->broot($n);
b8884ce4
T		 2471
2472Calculate the N'th root of $x.
2473
6320cdc0 2474=item badd()
3f185657 2475
6320cdc0 2476 $x->badd($y);
3f185657
PJA		 2477
2478Adds $y to $x and returns the result.
2479
6320cdc0 2480=item bmul()
3f185657 2481
6320cdc0 2482 $x->bmul($y);
3f185657
PJA		 2483
2484Multiplies $y to $x and returns the result.
2485
6320cdc0 2486=item bsub()
3f185657 2487
6320cdc0 2488 $x->bsub($y);
3f185657
PJA		 2489
2490Subtracts $y from $x and returns the result.
2491
6320cdc0 2492=item bdiv()
3f185657 2493
6320cdc0
SH		 2494 $q = $x->bdiv($y);
2495 ($q, $r) = $x->bdiv($y);
3f185657
PJA		 2496
2497In scalar context, divides $x by $y and returns the result. In list context,
2498does floored division (F-division), returning an integer $q and a remainder $r
2499so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned
2500by C<$x->bmod($y)>.
2501
6320cdc0 2502=item bdec()
3f185657 2503
6320cdc0 2504 $x->bdec();
3f185657
PJA		 2505
2506Decrements $x by 1 and returns the result.
2507
6320cdc0 2508=item binc()
3f185657 2509
6320cdc0 2510 $x->binc();
b8884ce4 2511
3f185657 2512Increments $x by 1 and returns the result.
b8884ce4 2513
6320cdc0 2514=item copy()
b8884ce4 2515
6320cdc0 2516 my $z = $x->copy();
b8884ce4
T		 2517
2518Makes a deep copy of the object.
2519
2520Please see the documentation in L<Math::BigInt> for further details.
2521
6320cdc0 2522=item bstr()/bsstr()
b8884ce4 2523
6320cdc0
SH		 2524 my $x = Math::BigRat->new('8/4');
2525 print $x->bstr(), "\n"; # prints 1/2
2526 print $x->bsstr(), "\n"; # prints 1/2
b8884ce4 2527
c4a6f826 2528Return a string representing this object.
b8884ce4 2529
6320cdc0 2530=item bcmp()
b8884ce4 2531
6320cdc0 2532 $x->bcmp($y);
b8884ce4 2533
6320cdc0
SH		 2534Compares $x with $y and takes the sign into account.
2535Returns -1, 0, 1 or undef.
2536
2537=item bacmp()
2538
2539 $x->bacmp($y);
b8884ce4 2540
6320cdc0
SH		 2541Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef.
2542
2543=item beq()
2544
2545 $x -> beq($y);
2546
2547Returns true if and only if $x is equal to $y, and false otherwise.
2548
2549=item bne()
2550
2551 $x -> bne($y);
2552
2553Returns true if and only if $x is not equal to $y, and false otherwise.
2554
2555=item blt()
2556
2557 $x -> blt($y);
2558
2559Returns true if and only if $x is equal to $y, and false otherwise.
2560
2561=item ble()
2562
2563 $x -> ble($y);
2564
2565Returns true if and only if $x is less than or equal to $y, and false
2566otherwise.
2567
2568=item bgt()
2569
2570 $x -> bgt($y);
2571
2572Returns true if and only if $x is greater than $y, and false otherwise.
2573
2574=item bge()
2575
2576 $x -> bge($y);
2577
2578Returns true if and only if $x is greater than or equal to $y, and false
2579otherwise.
2580
2581=item blsft()/brsft()
b8884ce4
T		 2582
2583Used to shift numbers left/right.
2584
2585Please see the documentation in L<Math::BigInt> for further details.
2586
6320cdc0
SH		 2587=item band()
2588
2589 $x->band($y); # bitwise and
2590
2591=item bior()
2592
2593 $x->bior($y); # bitwise inclusive or
2594
2595=item bxor()
2596
2597 $x->bxor($y); # bitwise exclusive or
b8884ce4 2598
6320cdc0
SH		 2599=item bnot()
2600
2601 $x->bnot(); # bitwise not (two's complement)
2602
2603=item bpow()
2604
2605 $x->bpow($y);
b8884ce4
T		 2606
2607Compute $x ** $y.
2608
2609Please see the documentation in L<Math::BigInt> for further details.
2610
6320cdc0
SH		 2611=item blog()
2612
2613 $x->blog($base, $accuracy); # logarithm of x to the base $base
116a1b2f 2614
6320cdc0
SH		 2615If C<$base> is not defined, Euler's number (e) is used:
2616
2617 print $x->blog(undef, 100); # log(x) to 100 digits
2618
2619=item bexp()
2620
2621 $x->bexp($accuracy); # calculate e ** X
116a1b2f
SP		 2622
2623Calculates two integers A and B so that A/B is equal to C<e ** $x>, where C<e> is
2624Euler's number.
2625
2626This method was added in v0.20 of Math::BigRat (May 2007).
2627
3d6c5fec 2628See also C<blog()>.
116a1b2f 2629
6320cdc0 2630=item bnok()
116a1b2f 2631
6320cdc0 2632 $x->bnok($y); # x over y (binomial coefficient n over k)
116a1b2f
SP		 2633
2634Calculates the binomial coefficient n over k, also called the "choose"
2635function. The result is equivalent to:
2636
6320cdc0
SH		 2637 ( n ) n!
2638 | - | = -------
2639 ( k ) k!(n-k)!
116a1b2f
SP		 2640
2641This method was added in v0.20 of Math::BigRat (May 2007).
2642
6320cdc0 2643=item config()
990fb837 2644
6320cdc0 2645 use Data::Dumper;
990fb837 2646
6320cdc0
SH		 2647 print Dumper ( Math::BigRat->config() );
2648 print Math::BigRat->config()->{lib}, "\n";
990fb837
RGS		 2649
2650Returns a hash containing the configuration, e.g. the version number, lib
2651loaded etc. The following hash keys are currently filled in with the
2652appropriate information.
2653
6320cdc0
SH		 2654 key RO/RW Description
2655 Example
2656 ============================================================
2657 lib RO Name of the Math library
2658 Math::BigInt::Calc
2659 lib_version RO Version of 'lib'
2660 0.30
2661 class RO The class of config you just called
2662 Math::BigRat
2663 version RO version number of the class you used
2664 0.10
2665 upgrade RW To which class numbers are upgraded
2666 undef
2667 downgrade RW To which class numbers are downgraded
2668 undef
2669 precision RW Global precision
2670 undef
2671 accuracy RW Global accuracy
2672 undef
2673 round_mode RW Global round mode
2674 even
2675 div_scale RW Fallback accuracy for div
2676 40
2677 trap_nan RW Trap creation of NaN (undef = no)
2678 undef
2679 trap_inf RW Trap creation of +inf/-inf (undef = no)
2680 undef
990fb837
RGS		 2681
2682By passing a reference to a hash you may set the configuration values. This
2683works only for values that a marked with a C<RW> above, anything else is
2684read-only.
2685
6320cdc0 2686=back
4de3d162 2687
a4e2b1c6 2688=head1 BUGS
6de7f0cc 2689
a7752796
PJA		 2690Please report any bugs or feature requests to
2691C<bug-math-bigrat at rt.cpan.org>, or through the web interface at
2692L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigRat>
2693(requires login).
2694We will be notified, and then you'll automatically be notified of progress on
2695your bug as I make changes.
2696
2697=head1 SUPPORT
2698
2699You can find documentation for this module with the perldoc command.
2700
2701 perldoc Math::BigRat
2702
2703You can also look for information at:
2704
2705=over 4
2706
2707=item * RT: CPAN's request tracker
2708
2709L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigRat>
2710
2711=item * AnnoCPAN: Annotated CPAN documentation
2712
2713L<http://annocpan.org/dist/Math-BigRat>
2714
2715=item * CPAN Ratings
7d341013 2716
a7752796 2717L<http://cpanratings.perl.org/dist/Math-BigRat>
7d341013 2718
a7752796 2719=item * Search CPAN
7d341013 2720
a7752796 2721L<http://search.cpan.org/dist/Math-BigRat/>
7d341013 2722
a7752796 2723=item * CPAN Testers Matrix
7d341013 2724
a7752796 2725L<http://matrix.cpantesters.org/?dist=Math-BigRat>
7d341013 2726
a7752796
PJA		 2727=item * The Bignum mailing list
2728
2729=over 4
2730
2731=item * Post to mailing list
2732
2733C<bignum at lists.scsys.co.uk>
2734
2735=item * View mailing list
2736
2737L<http://lists.scsys.co.uk/pipermail/bignum/>
2738
2739=item * Subscribe/Unsubscribe
2740
2741L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
2742
2743=back
7afd7a91 2744
7d341013 2745=back
184f15d5
JH		 2746
2747=head1 LICENSE
2748
2749This program is free software; you may redistribute it and/or modify it under
2750the same terms as Perl itself.
2751
2752=head1 SEE ALSO
2753
a7752796
PJA		 2754L<bigrat>, L<Math::BigFloat> and L<Math::BigInt> as well as the backends
2755L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>.
184f15d5
JH		 2756
2757=head1 AUTHORS
2758
0b299427
SH		 2759=over 4
2760
2761=item *
2762
2763Tels L<http://bloodgate.com/> 2001-2009.
c6c613ed 2764
0b299427
SH		 2765=item *
2766
2767Maintained by Peter John Acklam <pjacklam@online.no> 2011-
2768
2769=back
184f15d5
JH		 2770
2771=cut
Unnamed repository; edit this file 'description' to name the repository.