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