source: for-distributions/trunk/bin/windows/perl/lib/Math/BigRat.pm@ 14489

Last change on this file since 14489 was 14489, checked in by oranfry, 17 years ago

upgrading to perl 5.8
File size: 43.8 KB
Line 
1
2#
3# "Tax the rat farms." - Lord Vetinari
4#
5
6# The following hash values are used:
7# sign : +,-,NaN,+inf,-inf
8# _d : denominator
9# _n : numeraotr (value = _n/_d)
10# _a : accuracy
11# _p : precision
12# You should not look at the innards of a BigRat - use the methods for this.
13
14package Math::BigRat;
15
16require 5.005_03;
17use strict;
18
19use Math::BigFloat;
20use vars qw($VERSION @ISA $upgrade $downgrade
21 $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
22
23@ISA = qw(Math::BigFloat);
24
25$VERSION = '0.15';
26
27use overload; # inherit overload from Math::BigFloat
28
29BEGIN
30 {
31 *objectify = \&Math::BigInt::objectify; # inherit this from BigInt
32 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
33 # we inherit these from BigFloat because currently it is not possible
34 # that MBF has a different $MBI variable than we, because MBF also uses
35 # Math::BigInt::config->('lib'); (there is always only one library loaded)
36 *_e_add = \&Math::BigFloat::_e_add;
37 *_e_sub = \&Math::BigFloat::_e_sub;
38 *as_int = \&as_number;
39 *is_pos = \&is_positive;
40 *is_neg = \&is_negative;
41 }
42
43##############################################################################
44# Global constants and flags. Access these only via the accessor methods!
45
46$accuracy = $precision = undef;
47$round_mode = 'even';
48$div_scale = 40;
49$upgrade = undef;
50$downgrade = undef;
51
52# These are internally, and not to be used from the outside at all!
53
54$_trap_nan = 0; # are NaNs ok? set w/ config()
55$_trap_inf = 0; # are infs ok? set w/ config()
56
57# the package we are using for our private parts, defaults to:
58# Math::BigInt->config()->{lib}
59my $MBI = 'Math::BigInt::Calc';
60
61my $nan = 'NaN';
62my $class = 'Math::BigRat';
63
64sub isa
65 {
66 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
67 UNIVERSAL::isa(@_);
68 }
69
70##############################################################################
71
72sub _new_from_float
73 {
74 # turn a single float input into a rational number (like '0.1')
75 my ($self,$f) = @_;
76
77 return $self->bnan() if $f->is_nan();
78 return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
79
80 $self->{_n} = $MBI->_copy( $f->{_m} ); # mantissa
81 $self->{_d} = $MBI->_one();
82 $self->{sign} = $f->{sign} || '+';
83 if ($f->{_es} eq '-')
84 {
85 # something like Math::BigRat->new('0.1');
86 # 1 / 1 => 1/10
87 $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);
88 }
89 else
90 {
91 # something like Math::BigRat->new('10');
92 # 1 / 1 => 10/1
93 $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless
94 $MBI->_is_zero($f->{_e});
95 }
96 $self;
97 }
98
99sub new
100 {
101 # create a Math::BigRat
102 my $class = shift;
103
104 my ($n,$d) = @_;
105
106 my $self = { }; bless $self,$class;
107
108 # input like (BigInt) or (BigFloat):
109 if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
110 {
111 if ($n->isa('Math::BigFloat'))
112 {
113 $self->_new_from_float($n);
114 }
115 if ($n->isa('Math::BigInt'))
116 {
117 # TODO: trap NaN, inf
118 $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
119 $self->{_d} = $MBI->_one(); # d => 1
120 $self->{sign} = $n->{sign};
121 }
122 if ($n->isa('Math::BigInt::Lite'))
123 {
124 # TODO: trap NaN, inf
125 $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
126 $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N
127 $self->{_d} = $MBI->_one(); # d => 1
128 }
129 return $self->bnorm(); # normalize (120/1 => 12/10)
130 }
131
132 # input like (BigInt,BigInt) or (BigLite,BigLite):
133 if (ref($d) && ref($n))
134 {
135 # do N first (for $self->{sign}):
136 if ($n->isa('Math::BigInt'))
137 {
138 # TODO: trap NaN, inf
139 $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
140 $self->{sign} = $n->{sign};
141 }
142 elsif ($n->isa('Math::BigInt::Lite'))
143 {
144 # TODO: trap NaN, inf
145 $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
146 $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n
147 }
148 else
149 {
150 require Carp;
151 Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
152 }
153 # now D:
154 if ($d->isa('Math::BigInt'))
155 {
156 # TODO: trap NaN, inf
157 $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D
158 # +/+ or -/- => +, +/- or -/+ => -
159 $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
160 }
161 elsif ($d->isa('Math::BigInt::Lite'))
162 {
163 # TODO: trap NaN, inf
164 $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D
165 my $ds = '+'; $ds = '-' if $$d < 0;
166 # +/+ or -/- => +, +/- or -/+ => -
167 $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
168 }
169 else
170 {
171 require Carp;
172 Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
173 }
174 return $self->bnorm(); # normalize (120/1 => 12/10)
175 }
176 return $n->copy() if ref $n; # already a BigRat
177
178 if (!defined $n)
179 {
180 $self->{_n} = $MBI->_zero(); # undef => 0
181 $self->{_d} = $MBI->_one();
182 $self->{sign} = '+';
183 return $self;
184 }
185
186 # string input with / delimiter
187 if ($n =~ /\s*\/\s*/)
188 {
189 return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
190 return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
191 ($n,$d) = split (/\//,$n);
192 # try as BigFloats first
193 if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
194 {
195 local $Math::BigFloat::accuracy = undef;
196 local $Math::BigFloat::precision = undef;
197
198 # one of them looks like a float
199 my $nf = Math::BigFloat->new($n,undef,undef);
200 $self->{sign} = '+';
201 return $self->bnan() if $nf->is_nan();
202
203 $self->{_n} = $MBI->_copy( $nf->{_m} ); # get mantissa
204
205 # now correct $self->{_n} due to $n
206 my $f = Math::BigFloat->new($d,undef,undef);
207 return $self->bnan() if $f->is_nan();
208 $self->{_d} = $MBI->_copy( $f->{_m} );
209
210 # calculate the difference between nE and dE
211 # XXX TODO: check that exponent() makes a copy to avoid copy()
212 my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
213 if ($diff_e->is_negative())
214 {
215 # < 0: mul d with it
216 $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
217 }
218 elsif (!$diff_e->is_zero())
219 {
220 # > 0: mul n with it
221 $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
222 }
223 }
224 else
225 {
226 # both d and n look like (big)ints
227
228 $self->{sign} = '+'; # no sign => '+'
229 $self->{_n} = undef;
230 $self->{_d} = undef;
231 if ($n =~ /^([+-]?)0*(\d+)\z/) # first part ok?
232 {
233 $self->{sign} = $1 || '+'; # no sign => '+'
234 $self->{_n} = $MBI->_new($2 || 0);
235 }
236
237 if ($d =~ /^([+-]?)0*(\d+)\z/) # second part ok?
238 {
239 $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg.
240 $self->{_d} = $MBI->_new($2 || 0);
241 }
242
243 if (!defined $self->{_n} || !defined $self->{_d})
244 {
245 $d = Math::BigInt->new($d,undef,undef) unless ref $d;
246 $n = Math::BigInt->new($n,undef,undef) unless ref $n;
247
248 if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
249 {
250 # both parts are ok as integers (wierd things like ' 1e0'
251 $self->{_n} = $MBI->_copy($n->{value});
252 $self->{_d} = $MBI->_copy($d->{value});
253 $self->{sign} = $n->{sign};
254 $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2
255 return $self->bnorm();
256 }
257
258 $self->{sign} = '+'; # a default sign
259 return $self->bnan() if $n->is_nan() || $d->is_nan();
260
261 # handle inf cases:
262 if ($n->is_inf() || $d->is_inf())
263 {
264 if ($n->is_inf())
265 {
266 return $self->bnan() if $d->is_inf(); # both are inf => NaN
267 my $s = '+'; # '+inf/+123' or '-inf/-123'
268 $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
269 # +-inf/123 => +-inf
270 return $self->binf($s);
271 }
272 # 123/inf => 0
273 return $self->bzero();
274 }
275 }
276 }
277
278 return $self->bnorm();
279 }
280
281 # simple string input
282 if (($n =~ /[\.eE]/))
283 {
284 # looks like a float, quacks like a float, so probably is a float
285 $self->{sign} = 'NaN';
286 local $Math::BigFloat::accuracy = undef;
287 local $Math::BigFloat::precision = undef;
288 $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
289 }
290 else
291 {
292 # for simple forms, use $MBI directly
293 if ($n =~ /^([+-]?)0*(\d+)\z/)
294 {
295 $self->{sign} = $1 || '+';
296 $self->{_n} = $MBI->_new($2 || 0);
297 $self->{_d} = $MBI->_one();
298 }
299 else
300 {
301 my $n = Math::BigInt->new($n,undef,undef);
302 $self->{_n} = $MBI->_copy($n->{value});
303 $self->{_d} = $MBI->_one();
304 $self->{sign} = $n->{sign};
305 return $self->bnan() if $self->{sign} eq 'NaN';
306 return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
307 }
308 }
309 $self->bnorm();
310 }
311
312sub copy
313 {
314 # if two arguments, the first one is the class to "swallow" subclasses
315 my ($c,$x) = @_;
316
317 if (scalar @_ == 1)
318 {
319 $x = $_[0];
320 $c = ref($x);
321 }
322 return unless ref($x); # only for objects
323
324 my $self = bless {}, $c;
325
326 $self->{sign} = $x->{sign};
327 $self->{_d} = $MBI->_copy($x->{_d});
328 $self->{_n} = $MBI->_copy($x->{_n});
329 $self->{_a} = $x->{_a} if defined $x->{_a};
330 $self->{_p} = $x->{_p} if defined $x->{_p};
331 $self;
332 }
333
334##############################################################################
335
336sub config
337 {
338 # return (later set?) configuration data as hash ref
339 my $class = shift || 'Math::BigRat';
340
341 my $cfg = $class->SUPER::config(@_);
342
343 # now we need only to override the ones that are different from our parent
344 $cfg->{class} = $class;
345 $cfg->{with} = $MBI;
346 $cfg;
347 }
348
349##############################################################################
350
351sub bstr
352 {
353 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
354
355 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
356 {
357 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
358 return $s;
359 }
360
361 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
362
363 return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
364 $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
365 }
366
367sub bsstr
368 {
369 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
370
371 if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
372 {
373 my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf
374 return $s;
375 }
376
377 my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
378 $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
379 }
380
381sub bnorm
382 {
383 # reduce the number to the shortest form
384 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
385
386 # Both parts must be objects of whatever we are using today.
387 # Second check because Calc.pm has ARRAY res as unblessed objects.
388 if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
389 {
390 require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
391 }
392 if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
393 {
394 require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
395 }
396
397 # no normalize for NaN, inf etc.
398 return $x if $x->{sign} !~ /^[+-]$/;
399
400 # normalize zeros to 0/1
401 if ($MBI->_is_zero($x->{_n}))
402 {
403 $x->{sign} = '+'; # never leave a -0
404 $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
405 return $x;
406 }
407
408 return $x if $MBI->_is_one($x->{_d}); # no need to reduce
409
410 # reduce other numbers
411 my $gcd = $MBI->_copy($x->{_n});
412 $gcd = $MBI->_gcd($gcd,$x->{_d});
413
414 if (!$MBI->_is_one($gcd))
415 {
416 $x->{_n} = $MBI->_div($x->{_n},$gcd);
417 $x->{_d} = $MBI->_div($x->{_d},$gcd);
418 }
419 $x;
420 }
421
422##############################################################################
423# sign manipulation
424
425sub bneg
426 {
427 # (BRAT or num_str) return BRAT
428 # negate number or make a negated number from string
429 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
430
431 return $x if $x->modify('bneg');
432
433 # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
434 $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
435 $x;
436 }
437
438##############################################################################
439# special values
440
441sub _bnan
442 {
443 # used by parent class bnan() to initialize number to NaN
444 my $self = shift;
445
446 if ($_trap_nan)
447 {
448 require Carp;
449 my $class = ref($self);
450 # "$self" below will stringify the object, this blows up if $self is a
451 # partial object (happens under trap_nan), so fix it beforehand
452 $self->{_d} = $MBI->_zero() unless defined $self->{_d};
453 $self->{_n} = $MBI->_zero() unless defined $self->{_n};
454 Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
455 }
456 $self->{_n} = $MBI->_zero();
457 $self->{_d} = $MBI->_zero();
458 }
459
460sub _binf
461 {
462 # used by parent class bone() to initialize number to +inf/-inf
463 my $self = shift;
464
465 if ($_trap_inf)
466 {
467 require Carp;
468 my $class = ref($self);
469 # "$self" below will stringify the object, this blows up if $self is a
470 # partial object (happens under trap_nan), so fix it beforehand
471 $self->{_d} = $MBI->_zero() unless defined $self->{_d};
472 $self->{_n} = $MBI->_zero() unless defined $self->{_n};
473 Carp::croak ("Tried to set $self to inf in $class\::_binf()");
474 }
475 $self->{_n} = $MBI->_zero();
476 $self->{_d} = $MBI->_zero();
477 }
478
479sub _bone
480 {
481 # used by parent class bone() to initialize number to +1/-1
482 my $self = shift;
483 $self->{_n} = $MBI->_one();
484 $self->{_d} = $MBI->_one();
485 }
486
487sub _bzero
488 {
489 # used by parent class bzero() to initialize number to 0
490 my $self = shift;
491 $self->{_n} = $MBI->_zero();
492 $self->{_d} = $MBI->_one();
493 }
494
495##############################################################################
496# mul/add/div etc
497
498sub badd
499 {
500 # add two rational numbers
501
502 # set up parameters
503 my ($self,$x,$y,@r) = (ref($_[0]),@_);
504 # objectify is costly, so avoid it
505 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
506 {
507 ($self,$x,$y,@r) = objectify(2,@_);
508 }
509
510 # +inf + +inf => +inf, -inf + -inf => -inf
511 return $x->binf(substr($x->{sign},0,1))
512 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
513
514 # +inf + -inf or -inf + +inf => NaN
515 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
516
517 # 1 1 gcd(3,4) = 1 1*3 + 1*4 7
518 # - + - = --------- = --
519 # 4 3 4*3 12
520
521 # we do not compute the gcd() here, but simple do:
522 # 5 7 5*3 + 7*4 43
523 # - + - = --------- = --
524 # 4 3 4*3 12
525
526 # and bnorm() will then take care of the rest
527
528 # 5 * 3
529 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
530
531 # 7 * 4
532 my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} );
533
534 # 5 * 3 + 7 * 4
535 ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign});
536
537 # 4 * 3
538 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
539
540 # normalize result, and possible round
541 $x->bnorm()->round(@r);
542 }
543
544sub bsub
545 {
546 # subtract two rational numbers
547
548 # set up parameters
549 my ($self,$x,$y,@r) = (ref($_[0]),@_);
550 # objectify is costly, so avoid it
551 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
552 {
553 ($self,$x,$y,@r) = objectify(2,@_);
554 }
555
556 # flip sign of $x, call badd(), then flip sign of result
557 $x->{sign} =~ tr/+-/-+/
558 unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
559 $x->badd($y,@r); # does norm and round
560 $x->{sign} =~ tr/+-/-+/
561 unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0
562 $x;
563 }
564
565sub bmul
566 {
567 # multiply two rational numbers
568
569 # set up parameters
570 my ($self,$x,$y,@r) = (ref($_[0]),@_);
571 # objectify is costly, so avoid it
572 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
573 {
574 ($self,$x,$y,@r) = objectify(2,@_);
575 }
576
577 return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
578
579 # inf handling
580 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
581 {
582 return $x->bnan() if $x->is_zero() || $y->is_zero();
583 # result will always be +-inf:
584 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
585 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
586 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
587 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
588 return $x->binf('-');
589 }
590
591 # x== 0 # also: or y == 1 or y == -1
592 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
593
594 # XXX TODO:
595 # According to Knuth, this can be optimized by doing gcd twice (for d and n)
596 # and reducing in one step. This would save us the bnorm() at the end.
597
598 # 1 2 1 * 2 2 1
599 # - * - = ----- = - = -
600 # 4 3 4 * 3 12 6
601
602 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n});
603 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
604
605 # compute new sign
606 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
607
608 $x->bnorm()->round(@r);
609 }
610
611sub bdiv
612 {
613 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
614 # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
615
616 # set up parameters
617 my ($self,$x,$y,@r) = (ref($_[0]),@_);
618 # objectify is costly, so avoid it
619 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
620 {
621 ($self,$x,$y,@r) = objectify(2,@_);
622 }
623
624 return $self->_div_inf($x,$y)
625 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
626
627 # x== 0 # also: or y == 1 or y == -1
628 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
629
630 # XXX TODO: list context, upgrade
631 # According to Knuth, this can be optimized by doing gcd twice (for d and n)
632 # and reducing in one step. This would save us the bnorm() at the end.
633
634 # 1 1 1 3
635 # - / - == - * -
636 # 4 3 4 1
637
638 $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
639 $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n});
640
641 # compute new sign
642 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
643
644 $x->bnorm()->round(@r);
645 $x;
646 }
647
648sub bmod
649 {
650 # compute "remainder" (in Perl way) of $x / $y
651
652 # set up parameters
653 my ($self,$x,$y,@r) = (ref($_[0]),@_);
654 # objectify is costly, so avoid it
655 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
656 {
657 ($self,$x,$y,@r) = objectify(2,@_);
658 }
659
660 return $self->_div_inf($x,$y)
661 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
662
663 return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
664
665 # compute $x - $y * floor($x/$y), keeping the sign of $x
666
667 # copy x to u, make it positive and then do a normal division ($u/$y)
668 my $u = bless { sign => '+' }, $self;
669 $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
670 $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
671
672 # compute floor(u)
673 if (! $MBI->_is_one($u->{_d}))
674 {
675 $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate
676 # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
677 }
678
679 # now compute $y * $u
680 $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above
681 $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
682
683 my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive
684 # compute $x - $u
685 $x->bsub($u);
686 $x->{sign} = $xsign; # put sign back
687
688 $x->bnorm()->round(@r);
689 }
690
691##############################################################################
692# bdec/binc
693
694sub bdec
695 {
696 # decrement value (subtract 1)
697 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
698
699 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
700
701 if ($x->{sign} eq '-')
702 {
703 $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d}); # -5/2 => -7/2
704 }
705 else
706 {
707 if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d?
708 {
709 # 1/3 -- => -2/3
710 $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
711 $x->{sign} = '-';
712 }
713 else
714 {
715 $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
716 }
717 }
718 $x->bnorm()->round(@r);
719 }
720
721sub binc
722 {
723 # increment value (add 1)
724 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
725
726 return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
727
728 if ($x->{sign} eq '-')
729 {
730 if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)
731 {
732 # -1/3 ++ => 2/3 (overflow at 0)
733 $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
734 $x->{sign} = '+';
735 }
736 else
737 {
738 $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
739 }
740 }
741 else
742 {
743 $x->{_n} = $MBI->_add($x->{_n},$x->{_d}); # 5/2 => 7/2
744 }
745 $x->bnorm()->round(@r);
746 }
747
748##############################################################################
749# is_foo methods (the rest is inherited)
750
751sub is_int
752 {
753 # return true if arg (BRAT or num_str) is an integer
754 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
755
756 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
757 $MBI->_is_one($x->{_d}); # x/y && y != 1 => no integer
758 0;
759 }
760
761sub is_zero
762 {
763 # return true if arg (BRAT or num_str) is zero
764 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
765
766 return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});
767 0;
768 }
769
770sub is_one
771 {
772 # return true if arg (BRAT or num_str) is +1 or -1 if signis given
773 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
774
775 my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
776 return 1
777 if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}));
778 0;
779 }
780
781sub is_odd
782 {
783 # return true if arg (BFLOAT or num_str) is odd or false if even
784 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
785
786 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
787 ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1
788 0;
789 }
790
791sub is_even
792 {
793 # return true if arg (BINT or num_str) is even or false if odd
794 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
795
796 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
797 return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never
798 && $MBI->_is_even($x->{_n})); # but 4/1 is
799 0;
800 }
801
802##############################################################################
803# parts() and friends
804
805sub numerator
806 {
807 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
808
809 # NaN, inf, -inf
810 return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
811
812 my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign};
813 $n;
814 }
815
816sub denominator
817 {
818 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
819
820 # NaN
821 return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
822 # inf, -inf
823 return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
824
825 Math::BigInt->new($MBI->_str($x->{_d}));
826 }
827
828sub parts
829 {
830 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
831
832 my $c = 'Math::BigInt';
833
834 return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN';
835 return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf';
836 return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf';
837
838 my $n = $c->new( $MBI->_str($x->{_n}));
839 $n->{sign} = $x->{sign};
840 my $d = $c->new( $MBI->_str($x->{_d}));
841 ($n,$d);
842 }
843
844sub length
845 {
846 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
847
848 return $nan unless $x->is_int();
849 $MBI->_len($x->{_n}); # length(-123/1) => length(123)
850 }
851
852sub digit
853 {
854 my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_);
855
856 return $nan unless $x->is_int();
857 $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2)
858 }
859
860##############################################################################
861# special calc routines
862
863sub bceil
864 {
865 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
866
867 return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
868 $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
869
870 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
871 $x->{_d} = $MBI->_one(); # d => 1
872 $x->{_n} = $MBI->_inc($x->{_n})
873 if $x->{sign} eq '+'; # +22/7 => 4/1
874 $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0
875 $x;
876 }
877
878sub bfloor
879 {
880 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
881
882 return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf
883 $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0
884
885 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate
886 $x->{_d} = $MBI->_one(); # d => 1
887 $x->{_n} = $MBI->_inc($x->{_n})
888 if $x->{sign} eq '-'; # -22/7 => -4/1
889 $x;
890 }
891
892sub bfac
893 {
894 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
895
896 # if $x is not an integer
897 if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d})))
898 {
899 return $x->bnan();
900 }
901
902 $x->{_n} = $MBI->_fac($x->{_n});
903 # since _d is 1, we don't need to reduce/norm the result
904 $x->round(@r);
905 }
906
907sub bpow
908 {
909 # power ($x ** $y)
910
911 # set up parameters
912 my ($self,$x,$y,@r) = (ref($_[0]),@_);
913 # objectify is costly, so avoid it
914 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
915 {
916 ($self,$x,$y,@r) = objectify(2,@_);
917 }
918
919 return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
920 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
921 return $x->bone(@r) if $y->is_zero();
922 return $x->round(@r) if $x->is_one() || $y->is_one();
923
924 if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}))
925 {
926 # if $x == -1 and odd/even y => +1/-1
927 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
928 # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
929 }
930 # 1 ** -y => 1 / (1 ** |y|)
931 # so do test for negative $y after above's clause
932
933 return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
934
935 # shortcut y/1 (and/or x/1)
936 if ($MBI->_is_one($y->{_d}))
937 {
938 # shortcut for x/1 and y/1
939 if ($MBI->_is_one($x->{_d}))
940 {
941 $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1
942 if ($y->{sign} eq '-')
943 {
944 # 0.2 ** -3 => 1/(0.2 ** 3)
945 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
946 }
947 # correct sign; + ** + => +
948 if ($x->{sign} eq '-')
949 {
950 # - * - => +, - * - * - => -
951 $x->{sign} = '+' if $MBI->_is_even($y->{_n});
952 }
953 return $x->round(@r);
954 }
955 # x/z ** y/1
956 $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
957 $x->{_d} = $MBI->_pow($x->{_d},$y->{_n});
958 if ($y->{sign} eq '-')
959 {
960 # 0.2 ** -3 => 1/(0.2 ** 3)
961 ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap
962 }
963 # correct sign; + ** + => +
964 if ($x->{sign} eq '-')
965 {
966 # - * - => +, - * - * - => -
967 $x->{sign} = '+' if $MBI->_is_even($y->{_n});
968 }
969 return $x->round(@r);
970 }
971
972 # regular calculation (this is wrong for d/e ** f/g)
973 my $pow2 = $self->bone();
974 my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
975 my $two = $MBI->_two();
976
977 while (!$MBI->_is_one($y1))
978 {
979 $pow2->bmul($x) if $MBI->_is_odd($y1);
980 $MBI->_div($y1, $two);
981 $x->bmul($x);
982 }
983 $x->bmul($pow2) unless $pow2->is_one();
984 # n ** -x => 1/n ** x
985 ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-';
986 $x->bnorm()->round(@r);
987 }
988
989sub blog
990 {
991 # set up parameters
992 my ($self,$x,$y,@r) = (ref($_[0]),@_);
993
994 # objectify is costly, so avoid it
995 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
996 {
997 ($self,$x,$y,@r) = objectify(2,$class,@_);
998 }
999
1000 # blog(1,Y) => 0
1001 return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
1002
1003 # $x <= 0 => NaN
1004 return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
1005
1006 if ($x->is_int() && $y->is_int())
1007 {
1008 return $self->new($x->as_number()->blog($y->as_number(),@r));
1009 }
1010
1011 # do it with floats
1012 $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
1013 }
1014
1015sub _float_from_part
1016 {
1017 my $x = shift;
1018
1019 my $f = Math::BigFloat->bzero();
1020 $f->{_m} = $MBI->_copy($x);
1021 $f->{_e} = $MBI->_zero();
1022
1023 $f;
1024 }
1025
1026sub _as_float
1027 {
1028 my $x = shift;
1029
1030 local $Math::BigFloat::upgrade = undef;
1031 local $Math::BigFloat::accuracy = undef;
1032 local $Math::BigFloat::precision = undef;
1033 # 22/7 => 3.142857143..
1034
1035 my $a = $x->accuracy() || 0;
1036 if ($a != 0 || !$MBI->_is_one($x->{_d}))
1037 {
1038 # n/d
1039 return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
1040 }
1041 # just n
1042 Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
1043 }
1044
1045sub broot
1046 {
1047 # set up parameters
1048 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1049 # objectify is costly, so avoid it
1050 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1051 {
1052 ($self,$x,$y,@r) = objectify(2,@_);
1053 }
1054
1055 if ($x->is_int() && $y->is_int())
1056 {
1057 return $self->new($x->as_number()->broot($y->as_number(),@r));
1058 }
1059
1060 # do it with floats
1061 $x->_new_from_float( $x->_as_float()->broot($y,@r) );
1062 }
1063
1064sub bmodpow
1065 {
1066 # set up parameters
1067 my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
1068 # objectify is costly, so avoid it
1069 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1070 {
1071 ($self,$x,$y,$m,@r) = objectify(3,@_);
1072 }
1073
1074 # $x or $y or $m are NaN or +-inf => NaN
1075 return $x->bnan()
1076 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
1077 $m->{sign} !~ /^[+-]$/;
1078
1079 if ($x->is_int() && $y->is_int() && $m->is_int())
1080 {
1081 return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
1082 }
1083
1084 warn ("bmodpow() not fully implemented");
1085 $x->bnan();
1086 }
1087
1088sub bmodinv
1089 {
1090 # set up parameters
1091 my ($self,$x,$y,@r) = (ref($_[0]),@_);
1092 # objectify is costly, so avoid it
1093 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1094 {
1095 ($self,$x,$y,@r) = objectify(2,@_);
1096 }
1097
1098 # $x or $y are NaN or +-inf => NaN
1099 return $x->bnan()
1100 if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
1101
1102 if ($x->is_int() && $y->is_int())
1103 {
1104 return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
1105 }
1106
1107 warn ("bmodinv() not fully implemented");
1108 $x->bnan();
1109 }
1110
1111sub bsqrt
1112 {
1113 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1114
1115 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
1116 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
1117 return $x->round(@r) if $x->is_zero() || $x->is_one();
1118
1119 local $Math::BigFloat::upgrade = undef;
1120 local $Math::BigFloat::downgrade = undef;
1121 local $Math::BigFloat::precision = undef;
1122 local $Math::BigFloat::accuracy = undef;
1123 local $Math::BigInt::upgrade = undef;
1124 local $Math::BigInt::precision = undef;
1125 local $Math::BigInt::accuracy = undef;
1126
1127 $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
1128 $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();
1129
1130 # XXX TODO: we probably can optimze this:
1131
1132 # if sqrt(D) was not integer
1133 if ($x->{_d}->{_es} ne '+')
1134 {
1135 $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1
1136 $x->{_d} = $MBI->_copy( $x->{_d}->{_m} ); # 7.1/45.1 => 71/45.1
1137 }
1138 # if sqrt(N) was not integer
1139 if ($x->{_n}->{_es} ne '+')
1140 {
1141 $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1
1142 $x->{_n} = $MBI->_copy( $x->{_n}->{_m} ); # 710/45.1 => 710/451
1143 }
1144
1145 # convert parts to $MBI again
1146 $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
1147 if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
1148 $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
1149 if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';
1150
1151 $x->bnorm()->round(@r);
1152 }
1153
1154sub blsft
1155 {
1156 my ($self,$x,$y,$b,@r) = objectify(3,@_);
1157
1158 $b = 2 unless defined $b;
1159 $b = $self->new($b) unless ref ($b);
1160 $x->bmul( $b->copy()->bpow($y), @r);
1161 $x;
1162 }
1163
1164sub brsft
1165 {
1166 my ($self,$x,$y,$b,@r) = objectify(3,@_);
1167
1168 $b = 2 unless defined $b;
1169 $b = $self->new($b) unless ref ($b);
1170 $x->bdiv( $b->copy()->bpow($y), @r);
1171 $x;
1172 }
1173
1174##############################################################################
1175# round
1176
1177sub round
1178 {
1179 $_[0];
1180 }
1181
1182sub bround
1183 {
1184 $_[0];
1185 }
1186
1187sub bfround
1188 {
1189 $_[0];
1190 }
1191
1192##############################################################################
1193# comparing
1194
1195sub bcmp
1196 {
1197 # compare two signed numbers
1198
1199 # set up parameters
1200 my ($self,$x,$y) = (ref($_[0]),@_);
1201 # objectify is costly, so avoid it
1202 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1203 {
1204 ($self,$x,$y) = objectify(2,@_);
1205 }
1206
1207 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1208 {
1209 # handle +-inf and NaN
1210 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1211 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
1212 return +1 if $x->{sign} eq '+inf';
1213 return -1 if $x->{sign} eq '-inf';
1214 return -1 if $y->{sign} eq '+inf';
1215 return +1;
1216 }
1217 # check sign for speed first
1218 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
1219 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
1220
1221 # shortcut
1222 my $xz = $MBI->_is_zero($x->{_n});
1223 my $yz = $MBI->_is_zero($y->{_n});
1224 return 0 if $xz && $yz; # 0 <=> 0
1225 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
1226 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
1227
1228 my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1229 my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1230
1231 my $cmp = $MBI->_acmp($t,$u); # signs are equal
1232 $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
1233 $cmp;
1234 }
1235
1236sub bacmp
1237 {
1238 # compare two numbers (as unsigned)
1239
1240 # set up parameters
1241 my ($self,$x,$y) = (ref($_[0]),@_);
1242 # objectify is costly, so avoid it
1243 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1244 {
1245 ($self,$x,$y) = objectify(2,$class,@_);
1246 }
1247
1248 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
1249 {
1250 # handle +-inf and NaN
1251 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1252 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
1253 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
1254 return -1;
1255 }
1256
1257 my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
1258 my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
1259 $MBI->_acmp($t,$u); # ignore signs
1260 }
1261
1262##############################################################################
1263# output conversation
1264
1265sub numify
1266 {
1267 # convert 17/8 => float (aka 2.125)
1268 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1269
1270 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
1271
1272 # N/1 => N
1273 my $neg = ''; $neg = '-' if $x->{sign} eq '-';
1274 return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
1275
1276 $x->_as_float()->numify() + 0.0;
1277 }
1278
1279sub as_number
1280 {
1281 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1282
1283 return Math::BigInt->new($x) if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
1284
1285 my $u = Math::BigInt->bzero();
1286 $u->{sign} = $x->{sign};
1287 $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
1288 $u;
1289 }
1290
1291sub as_bin
1292 {
1293 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1294
1295 return $x unless $x->is_int();
1296
1297 my $s = $x->{sign}; $s = '' if $s eq '+';
1298 $s . $MBI->_as_bin($x->{_n});
1299 }
1300
1301sub as_hex
1302 {
1303 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1304
1305 return $x unless $x->is_int();
1306
1307 my $s = $x->{sign}; $s = '' if $s eq '+';
1308 $s . $MBI->_as_hex($x->{_n});
1309 }
1310
1311##############################################################################
1312# import
1313
1314sub import
1315 {
1316 my $self = shift;
1317 my $l = scalar @_;
1318 my $lib = ''; my @a;
1319
1320 for ( my $i = 0; $i < $l ; $i++)
1321 {
1322 if ( $_[$i] eq ':constant' )
1323 {
1324 # this rest causes overlord er load to step in
1325 overload::constant float => sub { $self->new(shift); };
1326 }
1327# elsif ($_[$i] eq 'upgrade')
1328# {
1329# # this causes upgrading
1330# $upgrade = $_[$i+1]; # or undef to disable
1331# $i++;
1332# }
1333 elsif ($_[$i] eq 'downgrade')
1334 {
1335 # this causes downgrading
1336 $downgrade = $_[$i+1]; # or undef to disable
1337 $i++;
1338 }
1339 elsif ($_[$i] eq 'lib')
1340 {
1341 $lib = $_[$i+1] || ''; # default Calc
1342 $i++;
1343 }
1344 elsif ($_[$i] eq 'with')
1345 {
1346 # this argument is no longer used
1347 #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
1348 $i++;
1349 }
1350 else
1351 {
1352 push @a, $_[$i];
1353 }
1354 }
1355 require Math::BigInt;
1356
1357 # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
1358 if ($lib ne '')
1359 {
1360 my @c = split /\s*,\s*/, $lib;
1361 foreach (@c)
1362 {
1363 $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
1364 }
1365 $lib = join(",", @c);
1366 }
1367 my @import = ('objectify');
1368 push @import, lib => $lib if $lib ne '';
1369
1370 # MBI already loaded, so feed it our lib arguments
1371 Math::BigInt->import( @import );
1372
1373 $MBI = Math::BigFloat->config()->{lib};
1374
1375 # register us with MBI to get notified of future lib changes
1376 Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
1377
1378 # any non :constant stuff is handled by our parent, Exporter (loaded
1379 # by Math::BigFloat, even if @_ is empty, to give it a chance
1380 $self->SUPER::import(@a); # for subclasses
1381 $self->export_to_level(1,$self,@a); # need this, too
1382 }
1383
13841;
1385
1386__END__
1387
1388=head1 NAME
1389
1390Math::BigRat - Arbitrary big rational numbers
1391
1392=head1 SYNOPSIS
1393
1394 use Math::BigRat;
1395
1396 my $x = Math::BigRat->new('3/7'); $x += '5/9';
1397
1398 print $x->bstr(),"\n";
1399 print $x ** 2,"\n";
1400
1401 my $y = Math::BigRat->new('inf');
1402 print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
1403
1404 my $z = Math::BigRat->new(144); $z->bsqrt();
1405
1406=head1 DESCRIPTION
1407
1408Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
1409for arbitrary big rational numbers.
1410
1411=head2 MATH LIBRARY
1412
1413Math with the numbers is done (by default) by a module called
1414Math::BigInt::Calc. This is equivalent to saying:
1415
1416 use Math::BigRat lib => 'Calc';
1417
1418You can change this by using:
1419
1420 use Math::BigRat lib => 'BitVect';
1421
1422The following would first try to find Math::BigInt::Foo, then
1423Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
1424
1425 use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
1426
1427Calc.pm uses as internal format an array of elements of some decimal base
1428(usually 1e7, but this might be different for some systems) with the least
1429significant digit first, while BitVect.pm uses a bit vector of base 2, most
1430significant bit first. Other modules might use even different means of
1431representing the numbers. See the respective module documentation for further
1432details.
1433
1434Currently the following replacement libraries exist, search for them at CPAN:
1435
1436 Math::BigInt::BitVect
1437 Math::BigInt::GMP
1438 Math::BigInt::Pari
1439 Math::BigInt::FastCalc
1440
1441=head1 METHODS
1442
1443Any methods not listed here are dervied from Math::BigFloat (or
1444Math::BigInt), so make sure you check these two modules for further
1445information.
1446
1447=head2 new()
1448
1449 $x = Math::BigRat->new('1/3');
1450
1451Create a new Math::BigRat object. Input can come in various forms:
1452
1453 $x = Math::BigRat->new(123); # scalars
1454 $x = Math::BigRat->new('inf'); # infinity
1455 $x = Math::BigRat->new('123.3'); # float
1456 $x = Math::BigRat->new('1/3'); # simple string
1457 $x = Math::BigRat->new('1 / 3'); # spaced
1458 $x = Math::BigRat->new('1 / 0.1'); # w/ floats
1459 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
1460 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
1461 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
1462
1463 # You can also give D and N as different objects:
1464 $x = Math::BigRat->new(
1465 Math::BigInt->new(-123),
1466 Math::BigInt->new(7),
1467 ); # => -123/7
1468
1469=head2 numerator()
1470
1471 $n = $x->numerator();
1472
1473Returns a copy of the numerator (the part above the line) as signed BigInt.
1474
1475=head2 denominator()
1476
1477 $d = $x->denominator();
1478
1479Returns a copy of the denominator (the part under the line) as positive BigInt.
1480
1481=head2 parts()
1482
1483 ($n,$d) = $x->parts();
1484
1485Return a list consisting of (signed) numerator and (unsigned) denominator as
1486BigInts.
1487
1488=head2 as_int()
1489
1490 $x = Math::BigRat->new('13/7');
1491 print $x->as_int(),"\n"; # '1'
1492
1493Returns a copy of the object as BigInt, truncated to an integer.
1494
1495C<as_number()> is an alias for C<as_int()>.
1496
1497=head2 as_hex()
1498
1499 $x = Math::BigRat->new('13');
1500 print $x->as_hex(),"\n"; # '0xd'
1501
1502Returns the BigRat as hexadecimal string. Works only for integers.
1503
1504=head2 as_bin()
1505
1506 $x = Math::BigRat->new('13');
1507 print $x->as_bin(),"\n"; # '0x1101'
1508
1509Returns the BigRat as binary string. Works only for integers.
1510
1511=head2 bfac()
1512
1513 $x->bfac();
1514
1515Calculates the factorial of $x. For instance:
1516
1517 print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3
1518 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5
1519
1520Works currently only for integers.
1521
1522=head2 blog()
1523
1524Is not yet implemented.
1525
1526=head2 bround()/round()/bfround()
1527
1528Are not yet implemented.
1529
1530=head2 bmod()
1531
1532 use Math::BigRat;
1533 my $x = Math::BigRat->new('7/4');
1534 my $y = Math::BigRat->new('4/3');
1535 print $x->bmod($y);
1536
1537Set $x to the remainder of the division of $x by $y.
1538
1539=head2 is_one()
1540
1541 print "$x is 1\n" if $x->is_one();
1542
1543Return true if $x is exactly one, otherwise false.
1544
1545=head2 is_zero()
1546
1547 print "$x is 0\n" if $x->is_zero();
1548
1549Return true if $x is exactly zero, otherwise false.
1550
1551=head2 is_pos()
1552
1553 print "$x is >= 0\n" if $x->is_positive();
1554
1555Return true if $x is positive (greater than or equal to zero), otherwise
1556false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
1557
1558C<is_positive()> is an alias for C<is_pos()>.
1559
1560=head2 is_neg()
1561
1562 print "$x is < 0\n" if $x->is_negative();
1563
1564Return true if $x is negative (smaller than zero), otherwise false. Please
1565note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
1566
1567C<is_negative()> is an alias for C<is_neg()>.
1568
1569=head2 is_int()
1570
1571 print "$x is an integer\n" if $x->is_int();
1572
1573Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
1574false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
1575
1576=head2 is_odd()
1577
1578 print "$x is odd\n" if $x->is_odd();
1579
1580Return true if $x is odd, otherwise false.
1581
1582=head2 is_even()
1583
1584 print "$x is even\n" if $x->is_even();
1585
1586Return true if $x is even, otherwise false.
1587
1588=head2 bceil()
1589
1590 $x->bceil();
1591
1592Set $x to the next bigger integer value (e.g. truncate the number to integer
1593and then increment it by one).
1594
1595=head2 bfloor()
1596
1597 $x->bfloor();
1598
1599Truncate $x to an integer value.
1600
1601=head2 bsqrt()
1602
1603 $x->bsqrt();
1604
1605Calculate the square root of $x.
1606
1607=head2 config
1608
1609 use Data::Dumper;
1610
1611 print Dumper ( Math::BigRat->config() );
1612 print Math::BigRat->config()->{lib},"\n";
1613
1614Returns a hash containing the configuration, e.g. the version number, lib
1615loaded etc. The following hash keys are currently filled in with the
1616appropriate information.
1617
1618 key RO/RW Description
1619 Example
1620 ============================================================
1621 lib RO Name of the Math library
1622 Math::BigInt::Calc
1623 lib_version RO Version of 'lib'
1624 0.30
1625 class RO The class of config you just called
1626 Math::BigRat
1627 version RO version number of the class you used
1628 0.10
1629 upgrade RW To which class numbers are upgraded
1630 undef
1631 downgrade RW To which class numbers are downgraded
1632 undef
1633 precision RW Global precision
1634 undef
1635 accuracy RW Global accuracy
1636 undef
1637 round_mode RW Global round mode
1638 even
1639 div_scale RW Fallback acccuracy for div
1640 40
1641 trap_nan RW Trap creation of NaN (undef = no)
1642 undef
1643 trap_inf RW Trap creation of +inf/-inf (undef = no)
1644 undef
1645
1646By passing a reference to a hash you may set the configuration values. This
1647works only for values that a marked with a C<RW> above, anything else is
1648read-only.
1649
1650=head1 BUGS
1651
1652Some things are not yet implemented, or only implemented half-way:
1653
1654=over 2
1655
1656=item inf handling (partial)
1657
1658=item NaN handling (partial)
1659
1660=item rounding (not implemented except for bceil/bfloor)
1661
1662=item $x ** $y where $y is not an integer
1663
1664=item bmod(), blog(), bmodinv() and bmodpow() (partial)
1665
1666=back
1667
1668=head1 LICENSE
1669
1670This program is free software; you may redistribute it and/or modify it under
1671the same terms as Perl itself.
1672
1673=head1 SEE ALSO
1674
1675L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
1676L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
1677
1678See L<http://search.cpan.org/search?dist=bignum> for a way to use
1679Math::BigRat.
1680
1681The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
1682may contain more documentation and examples as well as testcases.
1683
1684=head1 AUTHORS
1685
1686(C) by Tels L<http://bloodgate.com/> 2001 - 2005.
1687
1688=cut
Note: See TracBrowser for help on using the repository browser.