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