| 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 |
|
| 14 |
package Math::BigRat; |
| 15 |
|
| 16 |
require 5.005_03; |
| 17 |
use strict; |
| 18 |
|
| 19 |
use Math::BigFloat; |
| 20 |
use 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 |
|
| 27 |
use overload; # inherit overload from Math::BigFloat |
| 28 |
|
| 29 |
BEGIN |
| 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} |
| 59 |
my $MBI = 'Math::BigInt::Calc'; |
| 60 |
|
| 61 |
my $nan = 'NaN'; |
| 62 |
my $class = 'Math::BigRat'; |
| 63 |
|
| 64 |
sub isa |
| 65 |
{ |
| 66 |
return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't |
| 67 |
UNIVERSAL::isa(@_); |
| 68 |
} |
| 69 |
|
| 70 |
############################################################################## |
| 71 |
|
| 72 |
sub _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 |
|
| 99 |
sub 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 |
|
| 312 |
sub 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 |
|
| 336 |
sub 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 |
|
| 351 |
sub 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 |
|
| 367 |
sub 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 |
|
| 381 |
sub 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 |
|
| 425 |
sub 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 |
|
| 441 |
sub _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 |
|
| 460 |
sub _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 |
|
| 479 |
sub _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 |
|
| 487 |
sub _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 |
|
| 498 |
sub 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 |
|
| 544 |
sub 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 |
|
| 565 |
sub 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 |
|
| 611 |
sub 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 |
|
| 648 |
sub 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 |
|
| 694 |
sub 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 |
|
| 721 |
sub 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 |
|
| 751 |
sub 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 |
|
| 761 |
sub 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 |
|
| 770 |
sub 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 |
|
| 781 |
sub 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 |
|
| 791 |
sub 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 |
|
| 805 |
sub 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 |
|
| 816 |
sub 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 |
|
| 828 |
sub 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 |
|
| 844 |
sub 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 |
|
| 852 |
sub 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 |
|
| 863 |
sub 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 |
|
| 878 |
sub 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 |
|
| 892 |
sub 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 |
|
| 907 |
sub 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 |
|
| 989 |
sub 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 |
|
| 1015 |
sub _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 |
|
| 1026 |
sub _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 |
|
| 1045 |
sub 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 |
|
| 1064 |
sub 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 |
|
| 1088 |
sub 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 |
|
| 1111 |
sub 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 |
|
| 1154 |
sub 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 |
|
| 1164 |
sub 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 |
|
| 1177 |
sub round |
| 1178 |
{ |
| 1179 |
$_[0]; |
| 1180 |
} |
| 1181 |
|
| 1182 |
sub bround |
| 1183 |
{ |
| 1184 |
$_[0]; |
| 1185 |
} |
| 1186 |
|
| 1187 |
sub bfround |
| 1188 |
{ |
| 1189 |
$_[0]; |
| 1190 |
} |
| 1191 |
|
| 1192 |
############################################################################## |
| 1193 |
# comparing |
| 1194 |
|
| 1195 |
sub 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 |
|
| 1236 |
sub 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 |
|
| 1265 |
sub 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 |
|
| 1279 |
sub 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 |
|
| 1291 |
sub 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 |
|
| 1301 |
sub 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 |
|
| 1314 |
sub 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 |
|
| 1384 |
1; |
| 1385 |
|
| 1386 |
__END__ |
| 1387 |
|
| 1388 |
=head1 NAME |
| 1389 |
|
| 1390 |
Math::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 |
|
| 1408 |
Math::BigRat complements Math::BigInt and Math::BigFloat by providing support |
| 1409 |
for arbitrary big rational numbers. |
| 1410 |
|
| 1411 |
=head2 MATH LIBRARY |
| 1412 |
|
| 1413 |
Math with the numbers is done (by default) by a module called |
| 1414 |
Math::BigInt::Calc. This is equivalent to saying: |
| 1415 |
|
| 1416 |
use Math::BigRat lib => 'Calc'; |
| 1417 |
|
| 1418 |
You can change this by using: |
| 1419 |
|
| 1420 |
use Math::BigRat lib => 'BitVect'; |
| 1421 |
|
| 1422 |
The following would first try to find Math::BigInt::Foo, then |
| 1423 |
Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: |
| 1424 |
|
| 1425 |
use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; |
| 1426 |
|
| 1427 |
Calc.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 |
| 1429 |
significant digit first, while BitVect.pm uses a bit vector of base 2, most |
| 1430 |
significant bit first. Other modules might use even different means of |
| 1431 |
representing the numbers. See the respective module documentation for further |
| 1432 |
details. |
| 1433 |
|
| 1434 |
Currently 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 |
|
| 1443 |
Any methods not listed here are dervied from Math::BigFloat (or |
| 1444 |
Math::BigInt), so make sure you check these two modules for further |
| 1445 |
information. |
| 1446 |
|
| 1447 |
=head2 new() |
| 1448 |
|
| 1449 |
$x = Math::BigRat->new('1/3'); |
| 1450 |
|
| 1451 |
Create 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 |
|
| 1473 |
Returns a copy of the numerator (the part above the line) as signed BigInt. |
| 1474 |
|
| 1475 |
=head2 denominator() |
| 1476 |
|
| 1477 |
$d = $x->denominator(); |
| 1478 |
|
| 1479 |
Returns a copy of the denominator (the part under the line) as positive BigInt. |
| 1480 |
|
| 1481 |
=head2 parts() |
| 1482 |
|
| 1483 |
($n,$d) = $x->parts(); |
| 1484 |
|
| 1485 |
Return a list consisting of (signed) numerator and (unsigned) denominator as |
| 1486 |
BigInts. |
| 1487 |
|
| 1488 |
=head2 as_int() |
| 1489 |
|
| 1490 |
$x = Math::BigRat->new('13/7'); |
| 1491 |
print $x->as_int(),"\n"; # '1' |
| 1492 |
|
| 1493 |
Returns a copy of the object as BigInt, truncated to an integer. |
| 1494 |
|
| 1495 |
C<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 |
|
| 1502 |
Returns 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 |
|
| 1509 |
Returns the BigRat as binary string. Works only for integers. |
| 1510 |
|
| 1511 |
=head2 bfac() |
| 1512 |
|
| 1513 |
$x->bfac(); |
| 1514 |
|
| 1515 |
Calculates 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 |
|
| 1520 |
Works currently only for integers. |
| 1521 |
|
| 1522 |
=head2 blog() |
| 1523 |
|
| 1524 |
Is not yet implemented. |
| 1525 |
|
| 1526 |
=head2 bround()/round()/bfround() |
| 1527 |
|
| 1528 |
Are 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 |
|
| 1537 |
Set $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 |
|
| 1543 |
Return 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 |
|
| 1549 |
Return 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 |
|
| 1555 |
Return true if $x is positive (greater than or equal to zero), otherwise |
| 1556 |
false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't. |
| 1557 |
|
| 1558 |
C<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 |
|
| 1564 |
Return true if $x is negative (smaller than zero), otherwise false. Please |
| 1565 |
note that '-inf' is also negative, while 'NaN' and '+inf' aren't. |
| 1566 |
|
| 1567 |
C<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 |
|
| 1573 |
Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise |
| 1574 |
false. 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 |
|
| 1580 |
Return true if $x is odd, otherwise false. |
| 1581 |
|
| 1582 |
=head2 is_even() |
| 1583 |
|
| 1584 |
print "$x is even\n" if $x->is_even(); |
| 1585 |
|
| 1586 |
Return true if $x is even, otherwise false. |
| 1587 |
|
| 1588 |
=head2 bceil() |
| 1589 |
|
| 1590 |
$x->bceil(); |
| 1591 |
|
| 1592 |
Set $x to the next bigger integer value (e.g. truncate the number to integer |
| 1593 |
and then increment it by one). |
| 1594 |
|
| 1595 |
=head2 bfloor() |
| 1596 |
|
| 1597 |
$x->bfloor(); |
| 1598 |
|
| 1599 |
Truncate $x to an integer value. |
| 1600 |
|
| 1601 |
=head2 bsqrt() |
| 1602 |
|
| 1603 |
$x->bsqrt(); |
| 1604 |
|
| 1605 |
Calculate 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 |
|
| 1614 |
Returns a hash containing the configuration, e.g. the version number, lib |
| 1615 |
loaded etc. The following hash keys are currently filled in with the |
| 1616 |
appropriate 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 |
|
| 1646 |
By passing a reference to a hash you may set the configuration values. This |
| 1647 |
works only for values that a marked with a C<RW> above, anything else is |
| 1648 |
read-only. |
| 1649 |
|
| 1650 |
=head1 BUGS |
| 1651 |
|
| 1652 |
Some 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 |
|
| 1670 |
This program is free software; you may redistribute it and/or modify it under |
| 1671 |
the same terms as Perl itself. |
| 1672 |
|
| 1673 |
=head1 SEE ALSO |
| 1674 |
|
| 1675 |
L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>, |
| 1676 |
L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. |
| 1677 |
|
| 1678 |
See L<http://search.cpan.org/search?dist=bignum> for a way to use |
| 1679 |
Math::BigRat. |
| 1680 |
|
| 1681 |
The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat> |
| 1682 |
may 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 |
