1*0Sstevel@tonic-gatepackage Math::BigFloat; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# 4*0Sstevel@tonic-gate# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After' 5*0Sstevel@tonic-gate# 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate# The following hash values are internally used: 8*0Sstevel@tonic-gate# _e : exponent (ref to $CALC object) 9*0Sstevel@tonic-gate# _m : mantissa (ref to $CALC object) 10*0Sstevel@tonic-gate# _es : sign of _e 11*0Sstevel@tonic-gate# sign : +,-,+inf,-inf, or "NaN" if not a number 12*0Sstevel@tonic-gate# _a : accuracy 13*0Sstevel@tonic-gate# _p : precision 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gate$VERSION = '1.44'; 16*0Sstevel@tonic-gaterequire 5.005; 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gaterequire Exporter; 19*0Sstevel@tonic-gate@ISA = qw(Exporter Math::BigInt); 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateuse strict; 22*0Sstevel@tonic-gate# $_trap_inf and $_trap_nan are internal and should never be accessed from the outside 23*0Sstevel@tonic-gateuse vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode 24*0Sstevel@tonic-gate $upgrade $downgrade $_trap_nan $_trap_inf/; 25*0Sstevel@tonic-gatemy $class = "Math::BigFloat"; 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gateuse overload 28*0Sstevel@tonic-gate'<=>' => sub { $_[2] ? 29*0Sstevel@tonic-gate ref($_[0])->bcmp($_[1],$_[0]) : 30*0Sstevel@tonic-gate ref($_[0])->bcmp($_[0],$_[1])}, 31*0Sstevel@tonic-gate'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint 32*0Sstevel@tonic-gate; 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate############################################################################## 35*0Sstevel@tonic-gate# global constants, flags and assorted stuff 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate# the following are public, but their usage is not recommended. Use the 38*0Sstevel@tonic-gate# accessor methods instead. 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate# class constants, use Class->constant_name() to access 41*0Sstevel@tonic-gate$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' 42*0Sstevel@tonic-gate$accuracy = undef; 43*0Sstevel@tonic-gate$precision = undef; 44*0Sstevel@tonic-gate$div_scale = 40; 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate$upgrade = undef; 47*0Sstevel@tonic-gate$downgrade = undef; 48*0Sstevel@tonic-gate# the package we are using for our private parts, defaults to: 49*0Sstevel@tonic-gate# Math::BigInt->config()->{lib} 50*0Sstevel@tonic-gatemy $MBI = 'Math::BigInt::Calc'; 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config() 53*0Sstevel@tonic-gate$_trap_nan = 0; 54*0Sstevel@tonic-gate# the same for infinity 55*0Sstevel@tonic-gate$_trap_inf = 0; 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gate# constant for easier life 58*0Sstevel@tonic-gatemy $nan = 'NaN'; 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gatemy $IMPORT = 0; # was import() called yet? used to make require work 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate# some digits of accuracy for blog(undef,10); which we use in blog() for speed 63*0Sstevel@tonic-gatemy $LOG_10 = 64*0Sstevel@tonic-gate '2.3025850929940456840179914546843642076011014886287729760333279009675726097'; 65*0Sstevel@tonic-gatemy $LOG_10_A = length($LOG_10)-1; 66*0Sstevel@tonic-gate# ditto for log(2) 67*0Sstevel@tonic-gatemy $LOG_2 = 68*0Sstevel@tonic-gate '0.6931471805599453094172321214581765680755001343602552541206800094933936220'; 69*0Sstevel@tonic-gatemy $LOG_2_A = length($LOG_2)-1; 70*0Sstevel@tonic-gatemy $HALF = '0.5'; # made into an object if necc. 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gate############################################################################## 73*0Sstevel@tonic-gate# the old code had $rnd_mode, so we need to support it, too 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gatesub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } 76*0Sstevel@tonic-gatesub FETCH { return $round_mode; } 77*0Sstevel@tonic-gatesub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gateBEGIN 80*0Sstevel@tonic-gate { 81*0Sstevel@tonic-gate # when someone set's $rnd_mode, we catch this and check the value to see 82*0Sstevel@tonic-gate # whether it is valid or not. 83*0Sstevel@tonic-gate $rnd_mode = 'even'; tie $rnd_mode, 'Math::BigFloat'; 84*0Sstevel@tonic-gate } 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gate############################################################################## 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate{ 89*0Sstevel@tonic-gate # valid method aliases for AUTOLOAD 90*0Sstevel@tonic-gate my %methods = map { $_ => 1 } 91*0Sstevel@tonic-gate qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm 92*0Sstevel@tonic-gate fint facmp fcmp fzero fnan finf finc fdec flog ffac 93*0Sstevel@tonic-gate fceil ffloor frsft flsft fone flog froot 94*0Sstevel@tonic-gate /; 95*0Sstevel@tonic-gate # valid method's that can be hand-ed up (for AUTOLOAD) 96*0Sstevel@tonic-gate my %hand_ups = map { $_ => 1 } 97*0Sstevel@tonic-gate qw / is_nan is_inf is_negative is_positive is_pos is_neg 98*0Sstevel@tonic-gate accuracy precision div_scale round_mode fneg fabs fnot 99*0Sstevel@tonic-gate objectify upgrade downgrade 100*0Sstevel@tonic-gate bone binf bnan bzero 101*0Sstevel@tonic-gate /; 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate sub method_alias { exists $methods{$_[0]||''}; } 104*0Sstevel@tonic-gate sub method_hand_up { exists $hand_ups{$_[0]||''}; } 105*0Sstevel@tonic-gate} 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate############################################################################## 108*0Sstevel@tonic-gate# constructors 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gatesub new 111*0Sstevel@tonic-gate { 112*0Sstevel@tonic-gate # create a new BigFloat object from a string or another bigfloat object. 113*0Sstevel@tonic-gate # _e: exponent 114*0Sstevel@tonic-gate # _m: mantissa 115*0Sstevel@tonic-gate # sign => sign (+/-), or "NaN" 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate my ($class,$wanted,@r) = @_; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate # avoid numify-calls by not using || on $wanted! 120*0Sstevel@tonic-gate return $class->bzero() if !defined $wanted; # default to 0 121*0Sstevel@tonic-gate return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat'); 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate $class->import() if $IMPORT == 0; # make require work 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate my $self = {}; bless $self, $class; 126*0Sstevel@tonic-gate # shortcut for bigints and its subclasses 127*0Sstevel@tonic-gate if ((ref($wanted)) && (ref($wanted) ne $class)) 128*0Sstevel@tonic-gate { 129*0Sstevel@tonic-gate $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy 130*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 131*0Sstevel@tonic-gate $self->{_es} = '+'; 132*0Sstevel@tonic-gate $self->{sign} = $wanted->sign(); 133*0Sstevel@tonic-gate return $self->bnorm(); 134*0Sstevel@tonic-gate } 135*0Sstevel@tonic-gate # got string 136*0Sstevel@tonic-gate # handle '+inf', '-inf' first 137*0Sstevel@tonic-gate if ($wanted =~ /^[+-]?inf$/) 138*0Sstevel@tonic-gate { 139*0Sstevel@tonic-gate return $downgrade->new($wanted) if $downgrade; 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 142*0Sstevel@tonic-gate $self->{_es} = '+'; 143*0Sstevel@tonic-gate $self->{_m} = $MBI->_zero(); 144*0Sstevel@tonic-gate $self->{sign} = $wanted; 145*0Sstevel@tonic-gate $self->{sign} = '+inf' if $self->{sign} eq 'inf'; 146*0Sstevel@tonic-gate return $self->bnorm(); 147*0Sstevel@tonic-gate } 148*0Sstevel@tonic-gate 149*0Sstevel@tonic-gate my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted); 150*0Sstevel@tonic-gate if (!ref $mis) 151*0Sstevel@tonic-gate { 152*0Sstevel@tonic-gate if ($_trap_nan) 153*0Sstevel@tonic-gate { 154*0Sstevel@tonic-gate require Carp; 155*0Sstevel@tonic-gate Carp::croak ("$wanted is not a number initialized to $class"); 156*0Sstevel@tonic-gate } 157*0Sstevel@tonic-gate 158*0Sstevel@tonic-gate return $downgrade->bnan() if $downgrade; 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 161*0Sstevel@tonic-gate $self->{_es} = '+'; 162*0Sstevel@tonic-gate $self->{_m} = $MBI->_zero(); 163*0Sstevel@tonic-gate $self->{sign} = $nan; 164*0Sstevel@tonic-gate } 165*0Sstevel@tonic-gate else 166*0Sstevel@tonic-gate { 167*0Sstevel@tonic-gate # make integer from mantissa by adjusting exp, then convert to int 168*0Sstevel@tonic-gate $self->{_e} = $MBI->_new($$ev); # exponent 169*0Sstevel@tonic-gate $self->{_es} = $$es || '+'; 170*0Sstevel@tonic-gate my $mantissa = "$$miv$$mfv"; # create mant. 171*0Sstevel@tonic-gate $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros 172*0Sstevel@tonic-gate $self->{_m} = $MBI->_new($mantissa); # create mant. 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 175*0Sstevel@tonic-gate if (CORE::length($$mfv) != 0) 176*0Sstevel@tonic-gate { 177*0Sstevel@tonic-gate my $len = $MBI->_new( CORE::length($$mfv)); 178*0Sstevel@tonic-gate ($self->{_e}, $self->{_es}) = 179*0Sstevel@tonic-gate _e_sub ($self->{_e}, $len, $self->{_es}, '+'); 180*0Sstevel@tonic-gate } 181*0Sstevel@tonic-gate $self->{sign} = $$mis; 182*0Sstevel@tonic-gate 183*0Sstevel@tonic-gate # we can only have trailing zeros on the mantissa of $$mfv eq '' 184*0Sstevel@tonic-gate if (CORE::length($$mfv) == 0) 185*0Sstevel@tonic-gate { 186*0Sstevel@tonic-gate my $zeros = $MBI->_zeros($self->{_m}); # correct for trailing zeros 187*0Sstevel@tonic-gate if ($zeros != 0) 188*0Sstevel@tonic-gate { 189*0Sstevel@tonic-gate my $z = $MBI->_new($zeros); 190*0Sstevel@tonic-gate $MBI->_rsft ( $self->{_m}, $z, 10); 191*0Sstevel@tonic-gate _e_add ( $self->{_e}, $z, $self->{_es}, '+'); 192*0Sstevel@tonic-gate } 193*0Sstevel@tonic-gate } 194*0Sstevel@tonic-gate # for something like 0Ey, set y to 1, and -0 => +0 195*0Sstevel@tonic-gate $self->{sign} = '+', $self->{_e} = $MBI->_one() 196*0Sstevel@tonic-gate if $MBI->_is_zero($self->{_m}); 197*0Sstevel@tonic-gate return $self->round(@r) if !$downgrade; 198*0Sstevel@tonic-gate } 199*0Sstevel@tonic-gate # if downgrade, inf, NaN or integers go down 200*0Sstevel@tonic-gate 201*0Sstevel@tonic-gate if ($downgrade && $self->{_es} eq '+') 202*0Sstevel@tonic-gate { 203*0Sstevel@tonic-gate if ($MBI->_is_zero( $self->{_e} )) 204*0Sstevel@tonic-gate { 205*0Sstevel@tonic-gate return $downgrade->new($$mis . $MBI->_str( $self->{_m} )); 206*0Sstevel@tonic-gate } 207*0Sstevel@tonic-gate return $downgrade->new($self->bsstr()); 208*0Sstevel@tonic-gate } 209*0Sstevel@tonic-gate $self->bnorm()->round(@r); # first normalize, then round 210*0Sstevel@tonic-gate } 211*0Sstevel@tonic-gate 212*0Sstevel@tonic-gatesub copy 213*0Sstevel@tonic-gate { 214*0Sstevel@tonic-gate my ($c,$x); 215*0Sstevel@tonic-gate if (@_ > 1) 216*0Sstevel@tonic-gate { 217*0Sstevel@tonic-gate # if two arguments, the first one is the class to "swallow" subclasses 218*0Sstevel@tonic-gate ($c,$x) = @_; 219*0Sstevel@tonic-gate } 220*0Sstevel@tonic-gate else 221*0Sstevel@tonic-gate { 222*0Sstevel@tonic-gate $x = shift; 223*0Sstevel@tonic-gate $c = ref($x); 224*0Sstevel@tonic-gate } 225*0Sstevel@tonic-gate return unless ref($x); # only for objects 226*0Sstevel@tonic-gate 227*0Sstevel@tonic-gate my $self = {}; bless $self,$c; 228*0Sstevel@tonic-gate 229*0Sstevel@tonic-gate $self->{sign} = $x->{sign}; 230*0Sstevel@tonic-gate $self->{_es} = $x->{_es}; 231*0Sstevel@tonic-gate $self->{_m} = $MBI->_copy($x->{_m}); 232*0Sstevel@tonic-gate $self->{_e} = $MBI->_copy($x->{_e}); 233*0Sstevel@tonic-gate $self->{_a} = $x->{_a} if defined $x->{_a}; 234*0Sstevel@tonic-gate $self->{_p} = $x->{_p} if defined $x->{_p}; 235*0Sstevel@tonic-gate $self; 236*0Sstevel@tonic-gate } 237*0Sstevel@tonic-gate 238*0Sstevel@tonic-gatesub _bnan 239*0Sstevel@tonic-gate { 240*0Sstevel@tonic-gate # used by parent class bone() to initialize number to NaN 241*0Sstevel@tonic-gate my $self = shift; 242*0Sstevel@tonic-gate 243*0Sstevel@tonic-gate if ($_trap_nan) 244*0Sstevel@tonic-gate { 245*0Sstevel@tonic-gate require Carp; 246*0Sstevel@tonic-gate my $class = ref($self); 247*0Sstevel@tonic-gate Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); 248*0Sstevel@tonic-gate } 249*0Sstevel@tonic-gate 250*0Sstevel@tonic-gate $IMPORT=1; # call our import only once 251*0Sstevel@tonic-gate $self->{_m} = $MBI->_zero(); 252*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 253*0Sstevel@tonic-gate $self->{_es} = '+'; 254*0Sstevel@tonic-gate } 255*0Sstevel@tonic-gate 256*0Sstevel@tonic-gatesub _binf 257*0Sstevel@tonic-gate { 258*0Sstevel@tonic-gate # used by parent class bone() to initialize number to +-inf 259*0Sstevel@tonic-gate my $self = shift; 260*0Sstevel@tonic-gate 261*0Sstevel@tonic-gate if ($_trap_inf) 262*0Sstevel@tonic-gate { 263*0Sstevel@tonic-gate require Carp; 264*0Sstevel@tonic-gate my $class = ref($self); 265*0Sstevel@tonic-gate Carp::croak ("Tried to set $self to +-inf in $class\::_binf()"); 266*0Sstevel@tonic-gate } 267*0Sstevel@tonic-gate 268*0Sstevel@tonic-gate $IMPORT=1; # call our import only once 269*0Sstevel@tonic-gate $self->{_m} = $MBI->_zero(); 270*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 271*0Sstevel@tonic-gate $self->{_es} = '+'; 272*0Sstevel@tonic-gate } 273*0Sstevel@tonic-gate 274*0Sstevel@tonic-gatesub _bone 275*0Sstevel@tonic-gate { 276*0Sstevel@tonic-gate # used by parent class bone() to initialize number to 1 277*0Sstevel@tonic-gate my $self = shift; 278*0Sstevel@tonic-gate $IMPORT=1; # call our import only once 279*0Sstevel@tonic-gate $self->{_m} = $MBI->_one(); 280*0Sstevel@tonic-gate $self->{_e} = $MBI->_zero(); 281*0Sstevel@tonic-gate $self->{_es} = '+'; 282*0Sstevel@tonic-gate } 283*0Sstevel@tonic-gate 284*0Sstevel@tonic-gatesub _bzero 285*0Sstevel@tonic-gate { 286*0Sstevel@tonic-gate # used by parent class bone() to initialize number to 0 287*0Sstevel@tonic-gate my $self = shift; 288*0Sstevel@tonic-gate $IMPORT=1; # call our import only once 289*0Sstevel@tonic-gate $self->{_m} = $MBI->_zero(); 290*0Sstevel@tonic-gate $self->{_e} = $MBI->_one(); 291*0Sstevel@tonic-gate $self->{_es} = '+'; 292*0Sstevel@tonic-gate } 293*0Sstevel@tonic-gate 294*0Sstevel@tonic-gatesub isa 295*0Sstevel@tonic-gate { 296*0Sstevel@tonic-gate my ($self,$class) = @_; 297*0Sstevel@tonic-gate return if $class =~ /^Math::BigInt/; # we aren't one of these 298*0Sstevel@tonic-gate UNIVERSAL::isa($self,$class); 299*0Sstevel@tonic-gate } 300*0Sstevel@tonic-gate 301*0Sstevel@tonic-gatesub config 302*0Sstevel@tonic-gate { 303*0Sstevel@tonic-gate # return (later set?) configuration data as hash ref 304*0Sstevel@tonic-gate my $class = shift || 'Math::BigFloat'; 305*0Sstevel@tonic-gate 306*0Sstevel@tonic-gate my $cfg = $class->SUPER::config(@_); 307*0Sstevel@tonic-gate 308*0Sstevel@tonic-gate # now we need only to override the ones that are different from our parent 309*0Sstevel@tonic-gate $cfg->{class} = $class; 310*0Sstevel@tonic-gate $cfg->{with} = $MBI; 311*0Sstevel@tonic-gate $cfg; 312*0Sstevel@tonic-gate } 313*0Sstevel@tonic-gate 314*0Sstevel@tonic-gate############################################################################## 315*0Sstevel@tonic-gate# string conversation 316*0Sstevel@tonic-gate 317*0Sstevel@tonic-gatesub bstr 318*0Sstevel@tonic-gate { 319*0Sstevel@tonic-gate # (ref to BFLOAT or num_str ) return num_str 320*0Sstevel@tonic-gate # Convert number from internal format to (non-scientific) string format. 321*0Sstevel@tonic-gate # internal format is always normalized (no leading zeros, "-0" => "+0") 322*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 323*0Sstevel@tonic-gate 324*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/) 325*0Sstevel@tonic-gate { 326*0Sstevel@tonic-gate return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 327*0Sstevel@tonic-gate return 'inf'; # +inf 328*0Sstevel@tonic-gate } 329*0Sstevel@tonic-gate 330*0Sstevel@tonic-gate my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.'; 331*0Sstevel@tonic-gate 332*0Sstevel@tonic-gate # $x is zero? 333*0Sstevel@tonic-gate my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); 334*0Sstevel@tonic-gate if ($not_zero) 335*0Sstevel@tonic-gate { 336*0Sstevel@tonic-gate $es = $MBI->_str($x->{_m}); 337*0Sstevel@tonic-gate $len = CORE::length($es); 338*0Sstevel@tonic-gate my $e = $MBI->_num($x->{_e}); 339*0Sstevel@tonic-gate $e = -$e if $x->{_es} eq '-'; 340*0Sstevel@tonic-gate if ($e < 0) 341*0Sstevel@tonic-gate { 342*0Sstevel@tonic-gate $dot = ''; 343*0Sstevel@tonic-gate # if _e is bigger than a scalar, the following will blow your memory 344*0Sstevel@tonic-gate if ($e <= -$len) 345*0Sstevel@tonic-gate { 346*0Sstevel@tonic-gate my $r = abs($e) - $len; 347*0Sstevel@tonic-gate $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r); 348*0Sstevel@tonic-gate } 349*0Sstevel@tonic-gate else 350*0Sstevel@tonic-gate { 351*0Sstevel@tonic-gate substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e}); 352*0Sstevel@tonic-gate $cad = -$cad if $x->{_es} eq '-'; 353*0Sstevel@tonic-gate } 354*0Sstevel@tonic-gate } 355*0Sstevel@tonic-gate elsif ($e > 0) 356*0Sstevel@tonic-gate { 357*0Sstevel@tonic-gate # expand with zeros 358*0Sstevel@tonic-gate $es .= '0' x $e; $len += $e; $cad = 0; 359*0Sstevel@tonic-gate } 360*0Sstevel@tonic-gate } # if not zero 361*0Sstevel@tonic-gate 362*0Sstevel@tonic-gate $es = '-'.$es if $x->{sign} eq '-'; 363*0Sstevel@tonic-gate # if set accuracy or precision, pad with zeros on the right side 364*0Sstevel@tonic-gate if ((defined $x->{_a}) && ($not_zero)) 365*0Sstevel@tonic-gate { 366*0Sstevel@tonic-gate # 123400 => 6, 0.1234 => 4, 0.001234 => 4 367*0Sstevel@tonic-gate my $zeros = $x->{_a} - $cad; # cad == 0 => 12340 368*0Sstevel@tonic-gate $zeros = $x->{_a} - $len if $cad != $len; 369*0Sstevel@tonic-gate $es .= $dot.'0' x $zeros if $zeros > 0; 370*0Sstevel@tonic-gate } 371*0Sstevel@tonic-gate elsif ((($x->{_p} || 0) < 0)) 372*0Sstevel@tonic-gate { 373*0Sstevel@tonic-gate # 123400 => 6, 0.1234 => 4, 0.001234 => 6 374*0Sstevel@tonic-gate my $zeros = -$x->{_p} + $cad; 375*0Sstevel@tonic-gate $es .= $dot.'0' x $zeros if $zeros > 0; 376*0Sstevel@tonic-gate } 377*0Sstevel@tonic-gate $es; 378*0Sstevel@tonic-gate } 379*0Sstevel@tonic-gate 380*0Sstevel@tonic-gatesub bsstr 381*0Sstevel@tonic-gate { 382*0Sstevel@tonic-gate # (ref to BFLOAT or num_str ) return num_str 383*0Sstevel@tonic-gate # Convert number from internal format to scientific string format. 384*0Sstevel@tonic-gate # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") 385*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 386*0Sstevel@tonic-gate 387*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/) 388*0Sstevel@tonic-gate { 389*0Sstevel@tonic-gate return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 390*0Sstevel@tonic-gate return 'inf'; # +inf 391*0Sstevel@tonic-gate } 392*0Sstevel@tonic-gate my $sep = 'e'.$x->{_es}; 393*0Sstevel@tonic-gate my $sign = $x->{sign}; $sign = '' if $sign eq '+'; 394*0Sstevel@tonic-gate $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e}); 395*0Sstevel@tonic-gate } 396*0Sstevel@tonic-gate 397*0Sstevel@tonic-gatesub numify 398*0Sstevel@tonic-gate { 399*0Sstevel@tonic-gate # Make a number from a BigFloat object 400*0Sstevel@tonic-gate # simple return a string and let Perl's atoi()/atof() handle the rest 401*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 402*0Sstevel@tonic-gate $x->bsstr(); 403*0Sstevel@tonic-gate } 404*0Sstevel@tonic-gate 405*0Sstevel@tonic-gate############################################################################## 406*0Sstevel@tonic-gate# public stuff (usually prefixed with "b") 407*0Sstevel@tonic-gate 408*0Sstevel@tonic-gate# tels 2001-08-04 409*0Sstevel@tonic-gate# XXX TODO this must be overwritten and return NaN for non-integer values 410*0Sstevel@tonic-gate# band(), bior(), bxor(), too 411*0Sstevel@tonic-gate#sub bnot 412*0Sstevel@tonic-gate# { 413*0Sstevel@tonic-gate# $class->SUPER::bnot($class,@_); 414*0Sstevel@tonic-gate# } 415*0Sstevel@tonic-gate 416*0Sstevel@tonic-gatesub bcmp 417*0Sstevel@tonic-gate { 418*0Sstevel@tonic-gate # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) 419*0Sstevel@tonic-gate 420*0Sstevel@tonic-gate # set up parameters 421*0Sstevel@tonic-gate my ($self,$x,$y) = (ref($_[0]),@_); 422*0Sstevel@tonic-gate # objectify is costly, so avoid it 423*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 424*0Sstevel@tonic-gate { 425*0Sstevel@tonic-gate ($self,$x,$y) = objectify(2,@_); 426*0Sstevel@tonic-gate } 427*0Sstevel@tonic-gate 428*0Sstevel@tonic-gate return $upgrade->bcmp($x,$y) if defined $upgrade && 429*0Sstevel@tonic-gate ((!$x->isa($self)) || (!$y->isa($self))); 430*0Sstevel@tonic-gate 431*0Sstevel@tonic-gate if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 432*0Sstevel@tonic-gate { 433*0Sstevel@tonic-gate # handle +-inf and NaN 434*0Sstevel@tonic-gate return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 435*0Sstevel@tonic-gate return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/); 436*0Sstevel@tonic-gate return +1 if $x->{sign} eq '+inf'; 437*0Sstevel@tonic-gate return -1 if $x->{sign} eq '-inf'; 438*0Sstevel@tonic-gate return -1 if $y->{sign} eq '+inf'; 439*0Sstevel@tonic-gate return +1; 440*0Sstevel@tonic-gate } 441*0Sstevel@tonic-gate 442*0Sstevel@tonic-gate # check sign for speed first 443*0Sstevel@tonic-gate return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y 444*0Sstevel@tonic-gate return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 445*0Sstevel@tonic-gate 446*0Sstevel@tonic-gate # shortcut 447*0Sstevel@tonic-gate my $xz = $x->is_zero(); 448*0Sstevel@tonic-gate my $yz = $y->is_zero(); 449*0Sstevel@tonic-gate return 0 if $xz && $yz; # 0 <=> 0 450*0Sstevel@tonic-gate return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y 451*0Sstevel@tonic-gate return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 452*0Sstevel@tonic-gate 453*0Sstevel@tonic-gate # adjust so that exponents are equal 454*0Sstevel@tonic-gate my $lxm = $MBI->_len($x->{_m}); 455*0Sstevel@tonic-gate my $lym = $MBI->_len($y->{_m}); 456*0Sstevel@tonic-gate # the numify somewhat limits our length, but makes it much faster 457*0Sstevel@tonic-gate my ($xes,$yes) = (1,1); 458*0Sstevel@tonic-gate $xes = -1 if $x->{_es} ne '+'; 459*0Sstevel@tonic-gate $yes = -1 if $y->{_es} ne '+'; 460*0Sstevel@tonic-gate my $lx = $lxm + $xes * $MBI->_num($x->{_e}); 461*0Sstevel@tonic-gate my $ly = $lym + $yes * $MBI->_num($y->{_e}); 462*0Sstevel@tonic-gate my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-'; 463*0Sstevel@tonic-gate return $l <=> 0 if $l != 0; 464*0Sstevel@tonic-gate 465*0Sstevel@tonic-gate # lengths (corrected by exponent) are equal 466*0Sstevel@tonic-gate # so make mantissa equal length by padding with zero (shift left) 467*0Sstevel@tonic-gate my $diff = $lxm - $lym; 468*0Sstevel@tonic-gate my $xm = $x->{_m}; # not yet copy it 469*0Sstevel@tonic-gate my $ym = $y->{_m}; 470*0Sstevel@tonic-gate if ($diff > 0) 471*0Sstevel@tonic-gate { 472*0Sstevel@tonic-gate $ym = $MBI->_copy($y->{_m}); 473*0Sstevel@tonic-gate $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); 474*0Sstevel@tonic-gate } 475*0Sstevel@tonic-gate elsif ($diff < 0) 476*0Sstevel@tonic-gate { 477*0Sstevel@tonic-gate $xm = $MBI->_copy($x->{_m}); 478*0Sstevel@tonic-gate $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); 479*0Sstevel@tonic-gate } 480*0Sstevel@tonic-gate my $rc = $MBI->_acmp($xm,$ym); 481*0Sstevel@tonic-gate $rc = -$rc if $x->{sign} eq '-'; # -124 < -123 482*0Sstevel@tonic-gate $rc <=> 0; 483*0Sstevel@tonic-gate } 484*0Sstevel@tonic-gate 485*0Sstevel@tonic-gatesub bacmp 486*0Sstevel@tonic-gate { 487*0Sstevel@tonic-gate # Compares 2 values, ignoring their signs. 488*0Sstevel@tonic-gate # Returns one of undef, <0, =0, >0. (suitable for sort) 489*0Sstevel@tonic-gate 490*0Sstevel@tonic-gate # set up parameters 491*0Sstevel@tonic-gate my ($self,$x,$y) = (ref($_[0]),@_); 492*0Sstevel@tonic-gate # objectify is costly, so avoid it 493*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 494*0Sstevel@tonic-gate { 495*0Sstevel@tonic-gate ($self,$x,$y) = objectify(2,@_); 496*0Sstevel@tonic-gate } 497*0Sstevel@tonic-gate 498*0Sstevel@tonic-gate return $upgrade->bacmp($x,$y) if defined $upgrade && 499*0Sstevel@tonic-gate ((!$x->isa($self)) || (!$y->isa($self))); 500*0Sstevel@tonic-gate 501*0Sstevel@tonic-gate # handle +-inf and NaN's 502*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) 503*0Sstevel@tonic-gate { 504*0Sstevel@tonic-gate return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 505*0Sstevel@tonic-gate return 0 if ($x->is_inf() && $y->is_inf()); 506*0Sstevel@tonic-gate return 1 if ($x->is_inf() && !$y->is_inf()); 507*0Sstevel@tonic-gate return -1; 508*0Sstevel@tonic-gate } 509*0Sstevel@tonic-gate 510*0Sstevel@tonic-gate # shortcut 511*0Sstevel@tonic-gate my $xz = $x->is_zero(); 512*0Sstevel@tonic-gate my $yz = $y->is_zero(); 513*0Sstevel@tonic-gate return 0 if $xz && $yz; # 0 <=> 0 514*0Sstevel@tonic-gate return -1 if $xz && !$yz; # 0 <=> +y 515*0Sstevel@tonic-gate return 1 if $yz && !$xz; # +x <=> 0 516*0Sstevel@tonic-gate 517*0Sstevel@tonic-gate # adjust so that exponents are equal 518*0Sstevel@tonic-gate my $lxm = $MBI->_len($x->{_m}); 519*0Sstevel@tonic-gate my $lym = $MBI->_len($y->{_m}); 520*0Sstevel@tonic-gate my ($xes,$yes) = (1,1); 521*0Sstevel@tonic-gate $xes = -1 if $x->{_es} ne '+'; 522*0Sstevel@tonic-gate $yes = -1 if $y->{_es} ne '+'; 523*0Sstevel@tonic-gate # the numify somewhat limits our length, but makes it much faster 524*0Sstevel@tonic-gate my $lx = $lxm + $xes * $MBI->_num($x->{_e}); 525*0Sstevel@tonic-gate my $ly = $lym + $yes * $MBI->_num($y->{_e}); 526*0Sstevel@tonic-gate my $l = $lx - $ly; 527*0Sstevel@tonic-gate return $l <=> 0 if $l != 0; 528*0Sstevel@tonic-gate 529*0Sstevel@tonic-gate # lengths (corrected by exponent) are equal 530*0Sstevel@tonic-gate # so make mantissa equal-length by padding with zero (shift left) 531*0Sstevel@tonic-gate my $diff = $lxm - $lym; 532*0Sstevel@tonic-gate my $xm = $x->{_m}; # not yet copy it 533*0Sstevel@tonic-gate my $ym = $y->{_m}; 534*0Sstevel@tonic-gate if ($diff > 0) 535*0Sstevel@tonic-gate { 536*0Sstevel@tonic-gate $ym = $MBI->_copy($y->{_m}); 537*0Sstevel@tonic-gate $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); 538*0Sstevel@tonic-gate } 539*0Sstevel@tonic-gate elsif ($diff < 0) 540*0Sstevel@tonic-gate { 541*0Sstevel@tonic-gate $xm = $MBI->_copy($x->{_m}); 542*0Sstevel@tonic-gate $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); 543*0Sstevel@tonic-gate } 544*0Sstevel@tonic-gate $MBI->_acmp($xm,$ym); 545*0Sstevel@tonic-gate } 546*0Sstevel@tonic-gate 547*0Sstevel@tonic-gatesub badd 548*0Sstevel@tonic-gate { 549*0Sstevel@tonic-gate # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first) 550*0Sstevel@tonic-gate # return result as BFLOAT 551*0Sstevel@tonic-gate 552*0Sstevel@tonic-gate # set up parameters 553*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 554*0Sstevel@tonic-gate # objectify is costly, so avoid it 555*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 556*0Sstevel@tonic-gate { 557*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 558*0Sstevel@tonic-gate } 559*0Sstevel@tonic-gate 560*0Sstevel@tonic-gate # inf and NaN handling 561*0Sstevel@tonic-gate if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 562*0Sstevel@tonic-gate { 563*0Sstevel@tonic-gate # NaN first 564*0Sstevel@tonic-gate return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 565*0Sstevel@tonic-gate # inf handling 566*0Sstevel@tonic-gate if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) 567*0Sstevel@tonic-gate { 568*0Sstevel@tonic-gate # +inf++inf or -inf+-inf => same, rest is NaN 569*0Sstevel@tonic-gate return $x if $x->{sign} eq $y->{sign}; 570*0Sstevel@tonic-gate return $x->bnan(); 571*0Sstevel@tonic-gate } 572*0Sstevel@tonic-gate # +-inf + something => +inf; something +-inf => +-inf 573*0Sstevel@tonic-gate $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; 574*0Sstevel@tonic-gate return $x; 575*0Sstevel@tonic-gate } 576*0Sstevel@tonic-gate 577*0Sstevel@tonic-gate return $upgrade->badd($x,$y,$a,$p,$r) if defined $upgrade && 578*0Sstevel@tonic-gate ((!$x->isa($self)) || (!$y->isa($self))); 579*0Sstevel@tonic-gate 580*0Sstevel@tonic-gate # speed: no add for 0+y or x+0 581*0Sstevel@tonic-gate return $x->bround($a,$p,$r) if $y->is_zero(); # x+0 582*0Sstevel@tonic-gate if ($x->is_zero()) # 0+y 583*0Sstevel@tonic-gate { 584*0Sstevel@tonic-gate # make copy, clobbering up x (modify in place!) 585*0Sstevel@tonic-gate $x->{_e} = $MBI->_copy($y->{_e}); 586*0Sstevel@tonic-gate $x->{_es} = $y->{_es}; 587*0Sstevel@tonic-gate $x->{_m} = $MBI->_copy($y->{_m}); 588*0Sstevel@tonic-gate $x->{sign} = $y->{sign} || $nan; 589*0Sstevel@tonic-gate return $x->round($a,$p,$r,$y); 590*0Sstevel@tonic-gate } 591*0Sstevel@tonic-gate 592*0Sstevel@tonic-gate # take lower of the two e's and adapt m1 to it to match m2 593*0Sstevel@tonic-gate my $e = $y->{_e}; 594*0Sstevel@tonic-gate $e = $MBI->_zero() if !defined $e; # if no BFLOAT? 595*0Sstevel@tonic-gate $e = $MBI->_copy($e); # make copy (didn't do it yet) 596*0Sstevel@tonic-gate 597*0Sstevel@tonic-gate my $es; 598*0Sstevel@tonic-gate 599*0Sstevel@tonic-gate ($e,$es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); 600*0Sstevel@tonic-gate 601*0Sstevel@tonic-gate my $add = $MBI->_copy($y->{_m}); 602*0Sstevel@tonic-gate 603*0Sstevel@tonic-gate if ($es eq '-') # < 0 604*0Sstevel@tonic-gate { 605*0Sstevel@tonic-gate $MBI->_lsft( $x->{_m}, $e, 10); 606*0Sstevel@tonic-gate ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); 607*0Sstevel@tonic-gate } 608*0Sstevel@tonic-gate elsif (!$MBI->_is_zero($e)) # > 0 609*0Sstevel@tonic-gate { 610*0Sstevel@tonic-gate $MBI->_lsft($add, $e, 10); 611*0Sstevel@tonic-gate } 612*0Sstevel@tonic-gate # else: both e are the same, so just leave them 613*0Sstevel@tonic-gate 614*0Sstevel@tonic-gate if ($x->{sign} eq $y->{sign}) 615*0Sstevel@tonic-gate { 616*0Sstevel@tonic-gate # add 617*0Sstevel@tonic-gate $x->{_m} = $MBI->_add($x->{_m}, $add); 618*0Sstevel@tonic-gate } 619*0Sstevel@tonic-gate else 620*0Sstevel@tonic-gate { 621*0Sstevel@tonic-gate ($x->{_m}, $x->{sign}) = 622*0Sstevel@tonic-gate _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); 623*0Sstevel@tonic-gate } 624*0Sstevel@tonic-gate 625*0Sstevel@tonic-gate # delete trailing zeros, then round 626*0Sstevel@tonic-gate $x->bnorm()->round($a,$p,$r,$y); 627*0Sstevel@tonic-gate } 628*0Sstevel@tonic-gate 629*0Sstevel@tonic-gatesub bsub 630*0Sstevel@tonic-gate { 631*0Sstevel@tonic-gate # (BigFloat or num_str, BigFloat or num_str) return BigFloat 632*0Sstevel@tonic-gate # subtract second arg from first, modify first 633*0Sstevel@tonic-gate 634*0Sstevel@tonic-gate # set up parameters 635*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 636*0Sstevel@tonic-gate # objectify is costly, so avoid it 637*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 638*0Sstevel@tonic-gate { 639*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 640*0Sstevel@tonic-gate } 641*0Sstevel@tonic-gate 642*0Sstevel@tonic-gate if ($y->is_zero()) # still round for not adding zero 643*0Sstevel@tonic-gate { 644*0Sstevel@tonic-gate return $x->round($a,$p,$r); 645*0Sstevel@tonic-gate } 646*0Sstevel@tonic-gate 647*0Sstevel@tonic-gate # $x - $y = -$x + $y 648*0Sstevel@tonic-gate $y->{sign} =~ tr/+-/-+/; # does nothing for NaN 649*0Sstevel@tonic-gate $x->badd($y,$a,$p,$r); # badd does not leave internal zeros 650*0Sstevel@tonic-gate $y->{sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN) 651*0Sstevel@tonic-gate $x; # already rounded by badd() 652*0Sstevel@tonic-gate } 653*0Sstevel@tonic-gate 654*0Sstevel@tonic-gatesub binc 655*0Sstevel@tonic-gate { 656*0Sstevel@tonic-gate # increment arg by one 657*0Sstevel@tonic-gate my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 658*0Sstevel@tonic-gate 659*0Sstevel@tonic-gate if ($x->{_es} eq '-') 660*0Sstevel@tonic-gate { 661*0Sstevel@tonic-gate return $x->badd($self->bone(),@r); # digits after dot 662*0Sstevel@tonic-gate } 663*0Sstevel@tonic-gate 664*0Sstevel@tonic-gate if (!$MBI->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf 665*0Sstevel@tonic-gate { 666*0Sstevel@tonic-gate # 1e2 => 100, so after the shift below _m has a '0' as last digit 667*0Sstevel@tonic-gate $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100 668*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); # normalize 669*0Sstevel@tonic-gate $x->{_es} = '+'; 670*0Sstevel@tonic-gate # we know that the last digit of $x will be '1' or '9', depending on the 671*0Sstevel@tonic-gate # sign 672*0Sstevel@tonic-gate } 673*0Sstevel@tonic-gate # now $x->{_e} == 0 674*0Sstevel@tonic-gate if ($x->{sign} eq '+') 675*0Sstevel@tonic-gate { 676*0Sstevel@tonic-gate $MBI->_inc($x->{_m}); 677*0Sstevel@tonic-gate return $x->bnorm()->bround(@r); 678*0Sstevel@tonic-gate } 679*0Sstevel@tonic-gate elsif ($x->{sign} eq '-') 680*0Sstevel@tonic-gate { 681*0Sstevel@tonic-gate $MBI->_dec($x->{_m}); 682*0Sstevel@tonic-gate $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 683*0Sstevel@tonic-gate return $x->bnorm()->bround(@r); 684*0Sstevel@tonic-gate } 685*0Sstevel@tonic-gate # inf, nan handling etc 686*0Sstevel@tonic-gate $x->badd($self->bone(),@r); # badd() does round 687*0Sstevel@tonic-gate } 688*0Sstevel@tonic-gate 689*0Sstevel@tonic-gatesub bdec 690*0Sstevel@tonic-gate { 691*0Sstevel@tonic-gate # decrement arg by one 692*0Sstevel@tonic-gate my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 693*0Sstevel@tonic-gate 694*0Sstevel@tonic-gate if ($x->{_es} eq '-') 695*0Sstevel@tonic-gate { 696*0Sstevel@tonic-gate return $x->badd($self->bone('-'),@r); # digits after dot 697*0Sstevel@tonic-gate } 698*0Sstevel@tonic-gate 699*0Sstevel@tonic-gate if (!$MBI->_is_zero($x->{_e})) 700*0Sstevel@tonic-gate { 701*0Sstevel@tonic-gate $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100 702*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); # normalize 703*0Sstevel@tonic-gate $x->{_es} = '+'; 704*0Sstevel@tonic-gate } 705*0Sstevel@tonic-gate # now $x->{_e} == 0 706*0Sstevel@tonic-gate my $zero = $x->is_zero(); 707*0Sstevel@tonic-gate # <= 0 708*0Sstevel@tonic-gate if (($x->{sign} eq '-') || $zero) 709*0Sstevel@tonic-gate { 710*0Sstevel@tonic-gate $MBI->_inc($x->{_m}); 711*0Sstevel@tonic-gate $x->{sign} = '-' if $zero; # 0 => 1 => -1 712*0Sstevel@tonic-gate $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 713*0Sstevel@tonic-gate return $x->bnorm()->round(@r); 714*0Sstevel@tonic-gate } 715*0Sstevel@tonic-gate # > 0 716*0Sstevel@tonic-gate elsif ($x->{sign} eq '+') 717*0Sstevel@tonic-gate { 718*0Sstevel@tonic-gate $MBI->_dec($x->{_m}); 719*0Sstevel@tonic-gate return $x->bnorm()->round(@r); 720*0Sstevel@tonic-gate } 721*0Sstevel@tonic-gate # inf, nan handling etc 722*0Sstevel@tonic-gate $x->badd($self->bone('-'),@r); # does round 723*0Sstevel@tonic-gate } 724*0Sstevel@tonic-gate 725*0Sstevel@tonic-gatesub DEBUG () { 0; } 726*0Sstevel@tonic-gate 727*0Sstevel@tonic-gatesub blog 728*0Sstevel@tonic-gate { 729*0Sstevel@tonic-gate my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 730*0Sstevel@tonic-gate 731*0Sstevel@tonic-gate # $base > 0, $base != 1; if $base == undef default to $base == e 732*0Sstevel@tonic-gate # $x >= 0 733*0Sstevel@tonic-gate 734*0Sstevel@tonic-gate # we need to limit the accuracy to protect against overflow 735*0Sstevel@tonic-gate my $fallback = 0; 736*0Sstevel@tonic-gate my ($scale,@params); 737*0Sstevel@tonic-gate ($x,@params) = $x->_find_round_parameters($a,$p,$r); 738*0Sstevel@tonic-gate 739*0Sstevel@tonic-gate # also takes care of the "error in _find_round_parameters?" case 740*0Sstevel@tonic-gate return $x->bnan() if $x->{sign} ne '+' || $x->is_zero(); 741*0Sstevel@tonic-gate 742*0Sstevel@tonic-gate 743*0Sstevel@tonic-gate # no rounding at all, so must use fallback 744*0Sstevel@tonic-gate if (scalar @params == 0) 745*0Sstevel@tonic-gate { 746*0Sstevel@tonic-gate # simulate old behaviour 747*0Sstevel@tonic-gate $params[0] = $self->div_scale(); # and round to it as accuracy 748*0Sstevel@tonic-gate $params[1] = undef; # P = undef 749*0Sstevel@tonic-gate $scale = $params[0]+4; # at least four more for proper round 750*0Sstevel@tonic-gate $params[2] = $r; # round mode by caller or undef 751*0Sstevel@tonic-gate $fallback = 1; # to clear a/p afterwards 752*0Sstevel@tonic-gate } 753*0Sstevel@tonic-gate else 754*0Sstevel@tonic-gate { 755*0Sstevel@tonic-gate # the 4 below is empirical, and there might be cases where it is not 756*0Sstevel@tonic-gate # enough... 757*0Sstevel@tonic-gate $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 758*0Sstevel@tonic-gate } 759*0Sstevel@tonic-gate 760*0Sstevel@tonic-gate return $x->bzero(@params) if $x->is_one(); 761*0Sstevel@tonic-gate # base not defined => base == Euler's constant e 762*0Sstevel@tonic-gate if (defined $base) 763*0Sstevel@tonic-gate { 764*0Sstevel@tonic-gate # make object, since we don't feed it through objectify() to still get the 765*0Sstevel@tonic-gate # case of $base == undef 766*0Sstevel@tonic-gate $base = $self->new($base) unless ref($base); 767*0Sstevel@tonic-gate # $base > 0; $base != 1 768*0Sstevel@tonic-gate return $x->bnan() if $base->is_zero() || $base->is_one() || 769*0Sstevel@tonic-gate $base->{sign} ne '+'; 770*0Sstevel@tonic-gate # if $x == $base, we know the result must be 1.0 771*0Sstevel@tonic-gate return $x->bone('+',@params) if $x->bcmp($base) == 0; 772*0Sstevel@tonic-gate } 773*0Sstevel@tonic-gate 774*0Sstevel@tonic-gate # when user set globals, they would interfere with our calculation, so 775*0Sstevel@tonic-gate # disable them and later re-enable them 776*0Sstevel@tonic-gate no strict 'refs'; 777*0Sstevel@tonic-gate my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; 778*0Sstevel@tonic-gate my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; 779*0Sstevel@tonic-gate # we also need to disable any set A or P on $x (_find_round_parameters took 780*0Sstevel@tonic-gate # them already into account), since these would interfere, too 781*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 782*0Sstevel@tonic-gate # need to disable $upgrade in BigInt, to avoid deep recursion 783*0Sstevel@tonic-gate local $Math::BigInt::upgrade = undef; 784*0Sstevel@tonic-gate local $Math::BigFloat::downgrade = undef; 785*0Sstevel@tonic-gate 786*0Sstevel@tonic-gate # upgrade $x if $x is not a BigFloat (handle BigInt input) 787*0Sstevel@tonic-gate if (!$x->isa('Math::BigFloat')) 788*0Sstevel@tonic-gate { 789*0Sstevel@tonic-gate $x = Math::BigFloat->new($x); 790*0Sstevel@tonic-gate $self = ref($x); 791*0Sstevel@tonic-gate } 792*0Sstevel@tonic-gate 793*0Sstevel@tonic-gate my $done = 0; 794*0Sstevel@tonic-gate 795*0Sstevel@tonic-gate # If the base is defined and an integer, try to calculate integer result 796*0Sstevel@tonic-gate # first. This is very fast, and in case the real result was found, we can 797*0Sstevel@tonic-gate # stop right here. 798*0Sstevel@tonic-gate if (defined $base && $base->is_int() && $x->is_int()) 799*0Sstevel@tonic-gate { 800*0Sstevel@tonic-gate my $i = $MBI->_copy( $x->{_m} ); 801*0Sstevel@tonic-gate $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); 802*0Sstevel@tonic-gate my $int = Math::BigInt->bzero(); 803*0Sstevel@tonic-gate $int->{value} = $i; 804*0Sstevel@tonic-gate $int->blog($base->as_number()); 805*0Sstevel@tonic-gate # if ($exact) 806*0Sstevel@tonic-gate if ($base->as_number()->bpow($int) == $x) 807*0Sstevel@tonic-gate { 808*0Sstevel@tonic-gate # found result, return it 809*0Sstevel@tonic-gate $x->{_m} = $int->{value}; 810*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); 811*0Sstevel@tonic-gate $x->{_es} = '+'; 812*0Sstevel@tonic-gate $x->bnorm(); 813*0Sstevel@tonic-gate $done = 1; 814*0Sstevel@tonic-gate } 815*0Sstevel@tonic-gate } 816*0Sstevel@tonic-gate 817*0Sstevel@tonic-gate if ($done == 0) 818*0Sstevel@tonic-gate { 819*0Sstevel@tonic-gate # first calculate the log to base e (using reduction by 10 (and probably 2)) 820*0Sstevel@tonic-gate $self->_log_10($x,$scale); 821*0Sstevel@tonic-gate 822*0Sstevel@tonic-gate # and if a different base was requested, convert it 823*0Sstevel@tonic-gate if (defined $base) 824*0Sstevel@tonic-gate { 825*0Sstevel@tonic-gate $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat'); 826*0Sstevel@tonic-gate # not ln, but some other base (don't modify $base) 827*0Sstevel@tonic-gate $x->bdiv( $base->copy()->blog(undef,$scale), $scale ); 828*0Sstevel@tonic-gate } 829*0Sstevel@tonic-gate } 830*0Sstevel@tonic-gate 831*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 832*0Sstevel@tonic-gate if (defined $params[0]) 833*0Sstevel@tonic-gate { 834*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 835*0Sstevel@tonic-gate } 836*0Sstevel@tonic-gate else 837*0Sstevel@tonic-gate { 838*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 839*0Sstevel@tonic-gate } 840*0Sstevel@tonic-gate if ($fallback) 841*0Sstevel@tonic-gate { 842*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 843*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 844*0Sstevel@tonic-gate } 845*0Sstevel@tonic-gate # restore globals 846*0Sstevel@tonic-gate $$abr = $ab; $$pbr = $pb; 847*0Sstevel@tonic-gate 848*0Sstevel@tonic-gate $x; 849*0Sstevel@tonic-gate } 850*0Sstevel@tonic-gate 851*0Sstevel@tonic-gatesub _log 852*0Sstevel@tonic-gate { 853*0Sstevel@tonic-gate # internal log function to calculate ln() based on Taylor series. 854*0Sstevel@tonic-gate # Modifies $x in place. 855*0Sstevel@tonic-gate my ($self,$x,$scale) = @_; 856*0Sstevel@tonic-gate 857*0Sstevel@tonic-gate # in case of $x == 1, result is 0 858*0Sstevel@tonic-gate return $x->bzero() if $x->is_one(); 859*0Sstevel@tonic-gate 860*0Sstevel@tonic-gate # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log 861*0Sstevel@tonic-gate 862*0Sstevel@tonic-gate # u = x-1, v = x+1 863*0Sstevel@tonic-gate # _ _ 864*0Sstevel@tonic-gate # Taylor: | u 1 u^3 1 u^5 | 865*0Sstevel@tonic-gate # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0 866*0Sstevel@tonic-gate # |_ v 3 v^3 5 v^5 _| 867*0Sstevel@tonic-gate 868*0Sstevel@tonic-gate # This takes much more steps to calculate the result and is thus not used 869*0Sstevel@tonic-gate # u = x-1 870*0Sstevel@tonic-gate # _ _ 871*0Sstevel@tonic-gate # Taylor: | u 1 u^2 1 u^3 | 872*0Sstevel@tonic-gate # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2 873*0Sstevel@tonic-gate # |_ x 2 x^2 3 x^3 _| 874*0Sstevel@tonic-gate 875*0Sstevel@tonic-gate my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f); 876*0Sstevel@tonic-gate 877*0Sstevel@tonic-gate $v = $x->copy(); $v->binc(); # v = x+1 878*0Sstevel@tonic-gate $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1 879*0Sstevel@tonic-gate $x->bdiv($v,$scale); # first term: u/v 880*0Sstevel@tonic-gate $below = $v->copy(); 881*0Sstevel@tonic-gate $over = $u->copy(); 882*0Sstevel@tonic-gate $u *= $u; $v *= $v; # u^2, v^2 883*0Sstevel@tonic-gate $below->bmul($v); # u^3, v^3 884*0Sstevel@tonic-gate $over->bmul($u); 885*0Sstevel@tonic-gate $factor = $self->new(3); $f = $self->new(2); 886*0Sstevel@tonic-gate 887*0Sstevel@tonic-gate my $steps = 0 if DEBUG; 888*0Sstevel@tonic-gate $limit = $self->new("1E-". ($scale-1)); 889*0Sstevel@tonic-gate while (3 < 5) 890*0Sstevel@tonic-gate { 891*0Sstevel@tonic-gate # we calculate the next term, and add it to the last 892*0Sstevel@tonic-gate # when the next term is below our limit, it won't affect the outcome 893*0Sstevel@tonic-gate # anymore, so we stop 894*0Sstevel@tonic-gate 895*0Sstevel@tonic-gate # calculating the next term simple from over/below will result in quite 896*0Sstevel@tonic-gate # a time hog if the input has many digits, since over and below will 897*0Sstevel@tonic-gate # accumulate more and more digits, and the result will also have many 898*0Sstevel@tonic-gate # digits, but in the end it is rounded to $scale digits anyway. So if we 899*0Sstevel@tonic-gate # round $over and $below first, we save a lot of time for the division 900*0Sstevel@tonic-gate # (not with log(1.2345), but try log (123**123) to see what I mean. This 901*0Sstevel@tonic-gate # can introduce a rounding error if the division result would be f.i. 902*0Sstevel@tonic-gate # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but 903*0Sstevel@tonic-gate # if we truncated $over and $below we might get 0.12345. Does this matter 904*0Sstevel@tonic-gate # for the end result? So we give $over and $below 4 more digits to be 905*0Sstevel@tonic-gate # on the safe side (unscientific error handling as usual... :+D 906*0Sstevel@tonic-gate 907*0Sstevel@tonic-gate $next = $over->copy->bround($scale+4)->bdiv( 908*0Sstevel@tonic-gate $below->copy->bmul($factor)->bround($scale+4), 909*0Sstevel@tonic-gate $scale); 910*0Sstevel@tonic-gate 911*0Sstevel@tonic-gate## old version: 912*0Sstevel@tonic-gate## $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale); 913*0Sstevel@tonic-gate 914*0Sstevel@tonic-gate last if $next->bacmp($limit) <= 0; 915*0Sstevel@tonic-gate 916*0Sstevel@tonic-gate delete $next->{_a}; delete $next->{_p}; 917*0Sstevel@tonic-gate $x->badd($next); 918*0Sstevel@tonic-gate # calculate things for the next term 919*0Sstevel@tonic-gate $over *= $u; $below *= $v; $factor->badd($f); 920*0Sstevel@tonic-gate if (DEBUG) 921*0Sstevel@tonic-gate { 922*0Sstevel@tonic-gate $steps++; print "step $steps = $x\n" if $steps % 10 == 0; 923*0Sstevel@tonic-gate } 924*0Sstevel@tonic-gate } 925*0Sstevel@tonic-gate $x->bmul($f); # $x *= 2 926*0Sstevel@tonic-gate print "took $steps steps\n" if DEBUG; 927*0Sstevel@tonic-gate } 928*0Sstevel@tonic-gate 929*0Sstevel@tonic-gatesub _log_10 930*0Sstevel@tonic-gate { 931*0Sstevel@tonic-gate # Internal log function based on reducing input to the range of 0.1 .. 9.99 932*0Sstevel@tonic-gate # and then "correcting" the result to the proper one. Modifies $x in place. 933*0Sstevel@tonic-gate my ($self,$x,$scale) = @_; 934*0Sstevel@tonic-gate 935*0Sstevel@tonic-gate # taking blog() from numbers greater than 10 takes a *very long* time, so we 936*0Sstevel@tonic-gate # break the computation down into parts based on the observation that: 937*0Sstevel@tonic-gate # blog(x*y) = blog(x) + blog(y) 938*0Sstevel@tonic-gate # We set $y here to multiples of 10 so that $x is below 1 (the smaller $x is 939*0Sstevel@tonic-gate # the faster it get's, especially because 2*$x takes about 10 times as long, 940*0Sstevel@tonic-gate # so by dividing $x by 10 we make it at least factor 100 faster...) 941*0Sstevel@tonic-gate 942*0Sstevel@tonic-gate # The same observation is valid for numbers smaller than 0.1 (e.g. computing 943*0Sstevel@tonic-gate # log(1) is fastest, and the farther away we get from 1, the longer it takes) 944*0Sstevel@tonic-gate # so we also 'break' this down by multiplying $x with 10 and subtract the 945*0Sstevel@tonic-gate # log(10) afterwards to get the correct result. 946*0Sstevel@tonic-gate 947*0Sstevel@tonic-gate # calculate nr of digits before dot 948*0Sstevel@tonic-gate my $dbd = $MBI->_num($x->{_e}); 949*0Sstevel@tonic-gate $dbd = -$dbd if $x->{_es} eq '-'; 950*0Sstevel@tonic-gate $dbd += $MBI->_len($x->{_m}); 951*0Sstevel@tonic-gate 952*0Sstevel@tonic-gate # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid 953*0Sstevel@tonic-gate # infinite recursion 954*0Sstevel@tonic-gate 955*0Sstevel@tonic-gate my $calc = 1; # do some calculation? 956*0Sstevel@tonic-gate 957*0Sstevel@tonic-gate # disable the shortcut for 10, since we need log(10) and this would recurse 958*0Sstevel@tonic-gate # infinitely deep 959*0Sstevel@tonic-gate if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m})) 960*0Sstevel@tonic-gate { 961*0Sstevel@tonic-gate $dbd = 0; # disable shortcut 962*0Sstevel@tonic-gate # we can use the cached value in these cases 963*0Sstevel@tonic-gate if ($scale <= $LOG_10_A) 964*0Sstevel@tonic-gate { 965*0Sstevel@tonic-gate $x->bzero(); $x->badd($LOG_10); 966*0Sstevel@tonic-gate $calc = 0; # no need to calc, but round 967*0Sstevel@tonic-gate } 968*0Sstevel@tonic-gate } 969*0Sstevel@tonic-gate else 970*0Sstevel@tonic-gate { 971*0Sstevel@tonic-gate # disable the shortcut for 2, since we maybe have it cached 972*0Sstevel@tonic-gate if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m}))) 973*0Sstevel@tonic-gate { 974*0Sstevel@tonic-gate $dbd = 0; # disable shortcut 975*0Sstevel@tonic-gate # we can use the cached value in these cases 976*0Sstevel@tonic-gate if ($scale <= $LOG_2_A) 977*0Sstevel@tonic-gate { 978*0Sstevel@tonic-gate $x->bzero(); $x->badd($LOG_2); 979*0Sstevel@tonic-gate $calc = 0; # no need to calc, but round 980*0Sstevel@tonic-gate } 981*0Sstevel@tonic-gate } 982*0Sstevel@tonic-gate } 983*0Sstevel@tonic-gate 984*0Sstevel@tonic-gate # if $x = 0.1, we know the result must be 0-log(10) 985*0Sstevel@tonic-gate if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) && 986*0Sstevel@tonic-gate $MBI->_is_one($x->{_m})) 987*0Sstevel@tonic-gate { 988*0Sstevel@tonic-gate $dbd = 0; # disable shortcut 989*0Sstevel@tonic-gate # we can use the cached value in these cases 990*0Sstevel@tonic-gate if ($scale <= $LOG_10_A) 991*0Sstevel@tonic-gate { 992*0Sstevel@tonic-gate $x->bzero(); $x->bsub($LOG_10); 993*0Sstevel@tonic-gate $calc = 0; # no need to calc, but round 994*0Sstevel@tonic-gate } 995*0Sstevel@tonic-gate } 996*0Sstevel@tonic-gate 997*0Sstevel@tonic-gate return if $calc == 0; # already have the result 998*0Sstevel@tonic-gate 999*0Sstevel@tonic-gate # default: these correction factors are undef and thus not used 1000*0Sstevel@tonic-gate my $l_10; # value of ln(10) to A of $scale 1001*0Sstevel@tonic-gate my $l_2; # value of ln(2) to A of $scale 1002*0Sstevel@tonic-gate 1003*0Sstevel@tonic-gate # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1 1004*0Sstevel@tonic-gate # so don't do this shortcut for 1 or 0 1005*0Sstevel@tonic-gate if (($dbd > 1) || ($dbd < 0)) 1006*0Sstevel@tonic-gate { 1007*0Sstevel@tonic-gate # convert our cached value to an object if not already (avoid doing this 1008*0Sstevel@tonic-gate # at import() time, since not everybody needs this) 1009*0Sstevel@tonic-gate $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10; 1010*0Sstevel@tonic-gate 1011*0Sstevel@tonic-gate #print "x = $x, dbd = $dbd, calc = $calc\n"; 1012*0Sstevel@tonic-gate # got more than one digit before the dot, or more than one zero after the 1013*0Sstevel@tonic-gate # dot, so do: 1014*0Sstevel@tonic-gate # log(123) == log(1.23) + log(10) * 2 1015*0Sstevel@tonic-gate # log(0.0123) == log(1.23) - log(10) * 2 1016*0Sstevel@tonic-gate 1017*0Sstevel@tonic-gate if ($scale <= $LOG_10_A) 1018*0Sstevel@tonic-gate { 1019*0Sstevel@tonic-gate # use cached value 1020*0Sstevel@tonic-gate $l_10 = $LOG_10->copy(); # copy for mul 1021*0Sstevel@tonic-gate } 1022*0Sstevel@tonic-gate else 1023*0Sstevel@tonic-gate { 1024*0Sstevel@tonic-gate # else: slower, compute it (but don't cache it, because it could be big) 1025*0Sstevel@tonic-gate # also disable downgrade for this code path 1026*0Sstevel@tonic-gate local $Math::BigFloat::downgrade = undef; 1027*0Sstevel@tonic-gate $l_10 = $self->new(10)->blog(undef,$scale); # scale+4, actually 1028*0Sstevel@tonic-gate } 1029*0Sstevel@tonic-gate $dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1 1030*0Sstevel@tonic-gate $l_10->bmul( $self->new($dbd)); # log(10) * (digits_before_dot-1) 1031*0Sstevel@tonic-gate my $dbd_sign = '+'; 1032*0Sstevel@tonic-gate if ($dbd < 0) 1033*0Sstevel@tonic-gate { 1034*0Sstevel@tonic-gate $dbd = -$dbd; 1035*0Sstevel@tonic-gate $dbd_sign = '-'; 1036*0Sstevel@tonic-gate } 1037*0Sstevel@tonic-gate ($x->{_e}, $x->{_es}) = 1038*0Sstevel@tonic-gate _e_sub( $x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 1039*0Sstevel@tonic-gate 1040*0Sstevel@tonic-gate } 1041*0Sstevel@tonic-gate 1042*0Sstevel@tonic-gate # Now: 0.1 <= $x < 10 (and possible correction in l_10) 1043*0Sstevel@tonic-gate 1044*0Sstevel@tonic-gate ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div 1045*0Sstevel@tonic-gate ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1) 1046*0Sstevel@tonic-gate 1047*0Sstevel@tonic-gate $HALF = $self->new($HALF) unless ref($HALF); 1048*0Sstevel@tonic-gate 1049*0Sstevel@tonic-gate my $twos = 0; # default: none (0 times) 1050*0Sstevel@tonic-gate my $two = $self->new(2); 1051*0Sstevel@tonic-gate while ($x->bacmp($HALF) <= 0) 1052*0Sstevel@tonic-gate { 1053*0Sstevel@tonic-gate $twos--; $x->bmul($two); 1054*0Sstevel@tonic-gate } 1055*0Sstevel@tonic-gate while ($x->bacmp($two) >= 0) 1056*0Sstevel@tonic-gate { 1057*0Sstevel@tonic-gate $twos++; $x->bdiv($two,$scale+4); # keep all digits 1058*0Sstevel@tonic-gate } 1059*0Sstevel@tonic-gate # $twos > 0 => did mul 2, < 0 => did div 2 (never both) 1060*0Sstevel@tonic-gate # calculate correction factor based on ln(2) 1061*0Sstevel@tonic-gate if ($twos != 0) 1062*0Sstevel@tonic-gate { 1063*0Sstevel@tonic-gate $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2; 1064*0Sstevel@tonic-gate if ($scale <= $LOG_2_A) 1065*0Sstevel@tonic-gate { 1066*0Sstevel@tonic-gate # use cached value 1067*0Sstevel@tonic-gate $l_2 = $LOG_2->copy(); # copy for mul 1068*0Sstevel@tonic-gate } 1069*0Sstevel@tonic-gate else 1070*0Sstevel@tonic-gate { 1071*0Sstevel@tonic-gate # else: slower, compute it (but don't cache it, because it could be big) 1072*0Sstevel@tonic-gate # also disable downgrade for this code path 1073*0Sstevel@tonic-gate local $Math::BigFloat::downgrade = undef; 1074*0Sstevel@tonic-gate $l_2 = $two->blog(undef,$scale); # scale+4, actually 1075*0Sstevel@tonic-gate } 1076*0Sstevel@tonic-gate $l_2->bmul($twos); # * -2 => subtract, * 2 => add 1077*0Sstevel@tonic-gate } 1078*0Sstevel@tonic-gate 1079*0Sstevel@tonic-gate $self->_log($x,$scale); # need to do the "normal" way 1080*0Sstevel@tonic-gate $x->badd($l_10) if defined $l_10; # correct it by ln(10) 1081*0Sstevel@tonic-gate $x->badd($l_2) if defined $l_2; # and maybe by ln(2) 1082*0Sstevel@tonic-gate # all done, $x contains now the result 1083*0Sstevel@tonic-gate } 1084*0Sstevel@tonic-gate 1085*0Sstevel@tonic-gatesub blcm 1086*0Sstevel@tonic-gate { 1087*0Sstevel@tonic-gate # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT 1088*0Sstevel@tonic-gate # does not modify arguments, but returns new object 1089*0Sstevel@tonic-gate # Lowest Common Multiplicator 1090*0Sstevel@tonic-gate 1091*0Sstevel@tonic-gate my ($self,@arg) = objectify(0,@_); 1092*0Sstevel@tonic-gate my $x = $self->new(shift @arg); 1093*0Sstevel@tonic-gate while (@arg) { $x = _lcm($x,shift @arg); } 1094*0Sstevel@tonic-gate $x; 1095*0Sstevel@tonic-gate } 1096*0Sstevel@tonic-gate 1097*0Sstevel@tonic-gatesub bgcd 1098*0Sstevel@tonic-gate { 1099*0Sstevel@tonic-gate # (BFLOAT or num_str, BFLOAT or num_str) return BINT 1100*0Sstevel@tonic-gate # does not modify arguments, but returns new object 1101*0Sstevel@tonic-gate # GCD -- Euclids algorithm Knuth Vol 2 pg 296 1102*0Sstevel@tonic-gate 1103*0Sstevel@tonic-gate my ($self,@arg) = objectify(0,@_); 1104*0Sstevel@tonic-gate my $x = $self->new(shift @arg); 1105*0Sstevel@tonic-gate while (@arg) { $x = _gcd($x,shift @arg); } 1106*0Sstevel@tonic-gate $x; 1107*0Sstevel@tonic-gate } 1108*0Sstevel@tonic-gate 1109*0Sstevel@tonic-gate############################################################################## 1110*0Sstevel@tonic-gate 1111*0Sstevel@tonic-gatesub _e_add 1112*0Sstevel@tonic-gate { 1113*0Sstevel@tonic-gate # Internal helper sub to take two positive integers and their signs and 1114*0Sstevel@tonic-gate # then add them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), 1115*0Sstevel@tonic-gate # output ($CALC,('+'|'-')) 1116*0Sstevel@tonic-gate my ($x,$y,$xs,$ys) = @_; 1117*0Sstevel@tonic-gate 1118*0Sstevel@tonic-gate # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) 1119*0Sstevel@tonic-gate if ($xs eq $ys) 1120*0Sstevel@tonic-gate { 1121*0Sstevel@tonic-gate $x = $MBI->_add ($x, $y ); # a+b 1122*0Sstevel@tonic-gate # the sign follows $xs 1123*0Sstevel@tonic-gate return ($x, $xs); 1124*0Sstevel@tonic-gate } 1125*0Sstevel@tonic-gate 1126*0Sstevel@tonic-gate my $a = $MBI->_acmp($x,$y); 1127*0Sstevel@tonic-gate if ($a > 0) 1128*0Sstevel@tonic-gate { 1129*0Sstevel@tonic-gate $x = $MBI->_sub ($x , $y); # abs sub 1130*0Sstevel@tonic-gate } 1131*0Sstevel@tonic-gate elsif ($a == 0) 1132*0Sstevel@tonic-gate { 1133*0Sstevel@tonic-gate $x = $MBI->_zero(); # result is 0 1134*0Sstevel@tonic-gate $xs = '+'; 1135*0Sstevel@tonic-gate } 1136*0Sstevel@tonic-gate else # a < 0 1137*0Sstevel@tonic-gate { 1138*0Sstevel@tonic-gate $x = $MBI->_sub ( $y, $x, 1 ); # abs sub 1139*0Sstevel@tonic-gate $xs = $ys; 1140*0Sstevel@tonic-gate } 1141*0Sstevel@tonic-gate ($x,$xs); 1142*0Sstevel@tonic-gate } 1143*0Sstevel@tonic-gate 1144*0Sstevel@tonic-gatesub _e_sub 1145*0Sstevel@tonic-gate { 1146*0Sstevel@tonic-gate # Internal helper sub to take two positive integers and their signs and 1147*0Sstevel@tonic-gate # then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), 1148*0Sstevel@tonic-gate # output ($CALC,('+'|'-')) 1149*0Sstevel@tonic-gate my ($x,$y,$xs,$ys) = @_; 1150*0Sstevel@tonic-gate 1151*0Sstevel@tonic-gate # flip sign 1152*0Sstevel@tonic-gate $ys =~ tr/+-/-+/; 1153*0Sstevel@tonic-gate _e_add($x,$y,$xs,$ys); # call add (does subtract now) 1154*0Sstevel@tonic-gate } 1155*0Sstevel@tonic-gate 1156*0Sstevel@tonic-gate############################################################################### 1157*0Sstevel@tonic-gate# is_foo methods (is_negative, is_positive are inherited from BigInt) 1158*0Sstevel@tonic-gate 1159*0Sstevel@tonic-gatesub is_int 1160*0Sstevel@tonic-gate { 1161*0Sstevel@tonic-gate # return true if arg (BFLOAT or num_str) is an integer 1162*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1163*0Sstevel@tonic-gate 1164*0Sstevel@tonic-gate return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't 1165*0Sstevel@tonic-gate $x->{_es} eq '+'; # 1e-1 => no integer 1166*0Sstevel@tonic-gate 0; 1167*0Sstevel@tonic-gate } 1168*0Sstevel@tonic-gate 1169*0Sstevel@tonic-gatesub is_zero 1170*0Sstevel@tonic-gate { 1171*0Sstevel@tonic-gate # return true if arg (BFLOAT or num_str) is zero 1172*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1173*0Sstevel@tonic-gate 1174*0Sstevel@tonic-gate return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_m}); 1175*0Sstevel@tonic-gate 0; 1176*0Sstevel@tonic-gate } 1177*0Sstevel@tonic-gate 1178*0Sstevel@tonic-gatesub is_one 1179*0Sstevel@tonic-gate { 1180*0Sstevel@tonic-gate # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given 1181*0Sstevel@tonic-gate my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 1182*0Sstevel@tonic-gate 1183*0Sstevel@tonic-gate $sign = '+' if !defined $sign || $sign ne '-'; 1184*0Sstevel@tonic-gate return 1 1185*0Sstevel@tonic-gate if ($x->{sign} eq $sign && 1186*0Sstevel@tonic-gate $MBI->_is_zero($x->{_e}) && $MBI->_is_one($x->{_m})); 1187*0Sstevel@tonic-gate 0; 1188*0Sstevel@tonic-gate } 1189*0Sstevel@tonic-gate 1190*0Sstevel@tonic-gatesub is_odd 1191*0Sstevel@tonic-gate { 1192*0Sstevel@tonic-gate # return true if arg (BFLOAT or num_str) is odd or false if even 1193*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1194*0Sstevel@tonic-gate 1195*0Sstevel@tonic-gate return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't 1196*0Sstevel@tonic-gate ($MBI->_is_zero($x->{_e}) && $MBI->_is_odd($x->{_m})); 1197*0Sstevel@tonic-gate 0; 1198*0Sstevel@tonic-gate } 1199*0Sstevel@tonic-gate 1200*0Sstevel@tonic-gatesub is_even 1201*0Sstevel@tonic-gate { 1202*0Sstevel@tonic-gate # return true if arg (BINT or num_str) is even or false if odd 1203*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1204*0Sstevel@tonic-gate 1205*0Sstevel@tonic-gate return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1206*0Sstevel@tonic-gate return 1 if ($x->{_es} eq '+' # 123.45 is never 1207*0Sstevel@tonic-gate && $MBI->_is_even($x->{_m})); # but 1200 is 1208*0Sstevel@tonic-gate 0; 1209*0Sstevel@tonic-gate } 1210*0Sstevel@tonic-gate 1211*0Sstevel@tonic-gatesub bmul 1212*0Sstevel@tonic-gate { 1213*0Sstevel@tonic-gate # multiply two numbers -- stolen from Knuth Vol 2 pg 233 1214*0Sstevel@tonic-gate # (BINT or num_str, BINT or num_str) return BINT 1215*0Sstevel@tonic-gate 1216*0Sstevel@tonic-gate # set up parameters 1217*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 1218*0Sstevel@tonic-gate # objectify is costly, so avoid it 1219*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1220*0Sstevel@tonic-gate { 1221*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 1222*0Sstevel@tonic-gate } 1223*0Sstevel@tonic-gate 1224*0Sstevel@tonic-gate return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1225*0Sstevel@tonic-gate 1226*0Sstevel@tonic-gate # inf handling 1227*0Sstevel@tonic-gate if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) 1228*0Sstevel@tonic-gate { 1229*0Sstevel@tonic-gate return $x->bnan() if $x->is_zero() || $y->is_zero(); 1230*0Sstevel@tonic-gate # result will always be +-inf: 1231*0Sstevel@tonic-gate # +inf * +/+inf => +inf, -inf * -/-inf => +inf 1232*0Sstevel@tonic-gate # +inf * -/-inf => -inf, -inf * +/+inf => -inf 1233*0Sstevel@tonic-gate return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); 1234*0Sstevel@tonic-gate return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); 1235*0Sstevel@tonic-gate return $x->binf('-'); 1236*0Sstevel@tonic-gate } 1237*0Sstevel@tonic-gate # handle result = 0 1238*0Sstevel@tonic-gate return $x->bzero() if $x->is_zero() || $y->is_zero(); 1239*0Sstevel@tonic-gate 1240*0Sstevel@tonic-gate return $upgrade->bmul($x,$y,$a,$p,$r) if defined $upgrade && 1241*0Sstevel@tonic-gate ((!$x->isa($self)) || (!$y->isa($self))); 1242*0Sstevel@tonic-gate 1243*0Sstevel@tonic-gate # aEb * cEd = (a*c)E(b+d) 1244*0Sstevel@tonic-gate $MBI->_mul($x->{_m},$y->{_m}); 1245*0Sstevel@tonic-gate ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); 1246*0Sstevel@tonic-gate 1247*0Sstevel@tonic-gate # adjust sign: 1248*0Sstevel@tonic-gate $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+'; 1249*0Sstevel@tonic-gate return $x->bnorm()->round($a,$p,$r,$y); 1250*0Sstevel@tonic-gate } 1251*0Sstevel@tonic-gate 1252*0Sstevel@tonic-gatesub bdiv 1253*0Sstevel@tonic-gate { 1254*0Sstevel@tonic-gate # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return 1255*0Sstevel@tonic-gate # (BFLOAT,BFLOAT) (quo,rem) or BFLOAT (only rem) 1256*0Sstevel@tonic-gate 1257*0Sstevel@tonic-gate # set up parameters 1258*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 1259*0Sstevel@tonic-gate # objectify is costly, so avoid it 1260*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1261*0Sstevel@tonic-gate { 1262*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 1263*0Sstevel@tonic-gate } 1264*0Sstevel@tonic-gate 1265*0Sstevel@tonic-gate return $self->_div_inf($x,$y) 1266*0Sstevel@tonic-gate if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); 1267*0Sstevel@tonic-gate 1268*0Sstevel@tonic-gate # x== 0 # also: or y == 1 or y == -1 1269*0Sstevel@tonic-gate return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); 1270*0Sstevel@tonic-gate 1271*0Sstevel@tonic-gate # upgrade ? 1272*0Sstevel@tonic-gate return $upgrade->bdiv($upgrade->new($x),$y,$a,$p,$r) if defined $upgrade; 1273*0Sstevel@tonic-gate 1274*0Sstevel@tonic-gate # we need to limit the accuracy to protect against overflow 1275*0Sstevel@tonic-gate my $fallback = 0; 1276*0Sstevel@tonic-gate my (@params,$scale); 1277*0Sstevel@tonic-gate ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y); 1278*0Sstevel@tonic-gate 1279*0Sstevel@tonic-gate return $x if $x->is_nan(); # error in _find_round_parameters? 1280*0Sstevel@tonic-gate 1281*0Sstevel@tonic-gate # no rounding at all, so must use fallback 1282*0Sstevel@tonic-gate if (scalar @params == 0) 1283*0Sstevel@tonic-gate { 1284*0Sstevel@tonic-gate # simulate old behaviour 1285*0Sstevel@tonic-gate $params[0] = $self->div_scale(); # and round to it as accuracy 1286*0Sstevel@tonic-gate $scale = $params[0]+4; # at least four more for proper round 1287*0Sstevel@tonic-gate $params[2] = $r; # round mode by caller or undef 1288*0Sstevel@tonic-gate $fallback = 1; # to clear a/p afterwards 1289*0Sstevel@tonic-gate } 1290*0Sstevel@tonic-gate else 1291*0Sstevel@tonic-gate { 1292*0Sstevel@tonic-gate # the 4 below is empirical, and there might be cases where it is not 1293*0Sstevel@tonic-gate # enough... 1294*0Sstevel@tonic-gate $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 1295*0Sstevel@tonic-gate } 1296*0Sstevel@tonic-gate my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m}); 1297*0Sstevel@tonic-gate $scale = $lx if $lx > $scale; 1298*0Sstevel@tonic-gate $scale = $ly if $ly > $scale; 1299*0Sstevel@tonic-gate my $diff = $ly - $lx; 1300*0Sstevel@tonic-gate $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx! 1301*0Sstevel@tonic-gate 1302*0Sstevel@tonic-gate # make copy of $x in case of list context for later reminder calculation 1303*0Sstevel@tonic-gate my $rem; 1304*0Sstevel@tonic-gate if (wantarray && !$y->is_one()) 1305*0Sstevel@tonic-gate { 1306*0Sstevel@tonic-gate $rem = $x->copy(); 1307*0Sstevel@tonic-gate } 1308*0Sstevel@tonic-gate 1309*0Sstevel@tonic-gate $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 1310*0Sstevel@tonic-gate 1311*0Sstevel@tonic-gate # check for / +-1 ( +/- 1E0) 1312*0Sstevel@tonic-gate if (!$y->is_one()) 1313*0Sstevel@tonic-gate { 1314*0Sstevel@tonic-gate # promote BigInts and it's subclasses (except when already a BigFloat) 1315*0Sstevel@tonic-gate $y = $self->new($y) unless $y->isa('Math::BigFloat'); 1316*0Sstevel@tonic-gate 1317*0Sstevel@tonic-gate # calculate the result to $scale digits and then round it 1318*0Sstevel@tonic-gate # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) 1319*0Sstevel@tonic-gate $MBI->_lsft($x->{_m},$MBI->_new($scale),10); 1320*0Sstevel@tonic-gate $MBI->_div ($x->{_m},$y->{_m} ); # a/c 1321*0Sstevel@tonic-gate 1322*0Sstevel@tonic-gate ($x->{_e},$x->{_es}) = 1323*0Sstevel@tonic-gate _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); 1324*0Sstevel@tonic-gate # correct for 10**scale 1325*0Sstevel@tonic-gate ($x->{_e},$x->{_es}) = 1326*0Sstevel@tonic-gate _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+'); 1327*0Sstevel@tonic-gate $x->bnorm(); # remove trailing 0's 1328*0Sstevel@tonic-gate } 1329*0Sstevel@tonic-gate 1330*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 1331*0Sstevel@tonic-gate if (defined $params[0]) 1332*0Sstevel@tonic-gate { 1333*0Sstevel@tonic-gate delete $x->{_a}; # clear before round 1334*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 1335*0Sstevel@tonic-gate } 1336*0Sstevel@tonic-gate else 1337*0Sstevel@tonic-gate { 1338*0Sstevel@tonic-gate delete $x->{_p}; # clear before round 1339*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 1340*0Sstevel@tonic-gate } 1341*0Sstevel@tonic-gate if ($fallback) 1342*0Sstevel@tonic-gate { 1343*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1344*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1345*0Sstevel@tonic-gate } 1346*0Sstevel@tonic-gate 1347*0Sstevel@tonic-gate if (wantarray) 1348*0Sstevel@tonic-gate { 1349*0Sstevel@tonic-gate if (!$y->is_one()) 1350*0Sstevel@tonic-gate { 1351*0Sstevel@tonic-gate $rem->bmod($y,@params); # copy already done 1352*0Sstevel@tonic-gate } 1353*0Sstevel@tonic-gate else 1354*0Sstevel@tonic-gate { 1355*0Sstevel@tonic-gate $rem = $self->bzero(); 1356*0Sstevel@tonic-gate } 1357*0Sstevel@tonic-gate if ($fallback) 1358*0Sstevel@tonic-gate { 1359*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1360*0Sstevel@tonic-gate delete $rem->{_a}; delete $rem->{_p}; 1361*0Sstevel@tonic-gate } 1362*0Sstevel@tonic-gate return ($x,$rem); 1363*0Sstevel@tonic-gate } 1364*0Sstevel@tonic-gate $x; 1365*0Sstevel@tonic-gate } 1366*0Sstevel@tonic-gate 1367*0Sstevel@tonic-gatesub bmod 1368*0Sstevel@tonic-gate { 1369*0Sstevel@tonic-gate # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder 1370*0Sstevel@tonic-gate 1371*0Sstevel@tonic-gate # set up parameters 1372*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 1373*0Sstevel@tonic-gate # objectify is costly, so avoid it 1374*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1375*0Sstevel@tonic-gate { 1376*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 1377*0Sstevel@tonic-gate } 1378*0Sstevel@tonic-gate 1379*0Sstevel@tonic-gate # handle NaN, inf, -inf 1380*0Sstevel@tonic-gate if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 1381*0Sstevel@tonic-gate { 1382*0Sstevel@tonic-gate my ($d,$re) = $self->SUPER::_div_inf($x,$y); 1383*0Sstevel@tonic-gate $x->{sign} = $re->{sign}; 1384*0Sstevel@tonic-gate $x->{_e} = $re->{_e}; 1385*0Sstevel@tonic-gate $x->{_m} = $re->{_m}; 1386*0Sstevel@tonic-gate return $x->round($a,$p,$r,$y); 1387*0Sstevel@tonic-gate } 1388*0Sstevel@tonic-gate if ($y->is_zero()) 1389*0Sstevel@tonic-gate { 1390*0Sstevel@tonic-gate return $x->bnan() if $x->is_zero(); 1391*0Sstevel@tonic-gate return $x; 1392*0Sstevel@tonic-gate } 1393*0Sstevel@tonic-gate return $x->bzero() if $y->is_one() || $x->is_zero(); 1394*0Sstevel@tonic-gate 1395*0Sstevel@tonic-gate my $cmp = $x->bacmp($y); # equal or $x < $y? 1396*0Sstevel@tonic-gate return $x->bzero($a,$p) if $cmp == 0; # $x == $y => result 0 1397*0Sstevel@tonic-gate 1398*0Sstevel@tonic-gate # only $y of the operands negative? 1399*0Sstevel@tonic-gate my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign}; 1400*0Sstevel@tonic-gate 1401*0Sstevel@tonic-gate $x->{sign} = $y->{sign}; # calc sign first 1402*0Sstevel@tonic-gate return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0; # $x < $y => result $x 1403*0Sstevel@tonic-gate 1404*0Sstevel@tonic-gate my $ym = $MBI->_copy($y->{_m}); 1405*0Sstevel@tonic-gate 1406*0Sstevel@tonic-gate # 2e1 => 20 1407*0Sstevel@tonic-gate $MBI->_lsft( $ym, $y->{_e}, 10) 1408*0Sstevel@tonic-gate if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e}); 1409*0Sstevel@tonic-gate 1410*0Sstevel@tonic-gate # if $y has digits after dot 1411*0Sstevel@tonic-gate my $shifty = 0; # correct _e of $x by this 1412*0Sstevel@tonic-gate if ($y->{_es} eq '-') # has digits after dot 1413*0Sstevel@tonic-gate { 1414*0Sstevel@tonic-gate # 123 % 2.5 => 1230 % 25 => 5 => 0.5 1415*0Sstevel@tonic-gate $shifty = $MBI->_num($y->{_e}); # no more digits after dot 1416*0Sstevel@tonic-gate $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25 1417*0Sstevel@tonic-gate } 1418*0Sstevel@tonic-gate # $ym is now mantissa of $y based on exponent 0 1419*0Sstevel@tonic-gate 1420*0Sstevel@tonic-gate my $shiftx = 0; # correct _e of $x by this 1421*0Sstevel@tonic-gate if ($x->{_es} eq '-') # has digits after dot 1422*0Sstevel@tonic-gate { 1423*0Sstevel@tonic-gate # 123.4 % 20 => 1234 % 200 1424*0Sstevel@tonic-gate $shiftx = $MBI->_num($x->{_e}); # no more digits after dot 1425*0Sstevel@tonic-gate $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 1426*0Sstevel@tonic-gate } 1427*0Sstevel@tonic-gate # 123e1 % 20 => 1230 % 20 1428*0Sstevel@tonic-gate if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) 1429*0Sstevel@tonic-gate { 1430*0Sstevel@tonic-gate $MBI->_lsft( $x->{_m}, $x->{_e},10); # es => '+' here 1431*0Sstevel@tonic-gate } 1432*0Sstevel@tonic-gate 1433*0Sstevel@tonic-gate $x->{_e} = $MBI->_new($shiftx); 1434*0Sstevel@tonic-gate $x->{_es} = '+'; 1435*0Sstevel@tonic-gate $x->{_es} = '-' if $shiftx != 0 || $shifty != 0; 1436*0Sstevel@tonic-gate $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0; 1437*0Sstevel@tonic-gate 1438*0Sstevel@tonic-gate # now mantissas are equalized, exponent of $x is adjusted, so calc result 1439*0Sstevel@tonic-gate 1440*0Sstevel@tonic-gate $x->{_m} = $MBI->_mod( $x->{_m}, $ym); 1441*0Sstevel@tonic-gate 1442*0Sstevel@tonic-gate $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 1443*0Sstevel@tonic-gate $x->bnorm(); 1444*0Sstevel@tonic-gate 1445*0Sstevel@tonic-gate if ($neg != 0) # one of them negative => correct in place 1446*0Sstevel@tonic-gate { 1447*0Sstevel@tonic-gate my $r = $y - $x; 1448*0Sstevel@tonic-gate $x->{_m} = $r->{_m}; 1449*0Sstevel@tonic-gate $x->{_e} = $r->{_e}; 1450*0Sstevel@tonic-gate $x->{_es} = $r->{_es}; 1451*0Sstevel@tonic-gate $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 1452*0Sstevel@tonic-gate $x->bnorm(); 1453*0Sstevel@tonic-gate } 1454*0Sstevel@tonic-gate 1455*0Sstevel@tonic-gate $x->round($a,$p,$r,$y); # round and return 1456*0Sstevel@tonic-gate } 1457*0Sstevel@tonic-gate 1458*0Sstevel@tonic-gatesub broot 1459*0Sstevel@tonic-gate { 1460*0Sstevel@tonic-gate # calculate $y'th root of $x 1461*0Sstevel@tonic-gate 1462*0Sstevel@tonic-gate # set up parameters 1463*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 1464*0Sstevel@tonic-gate # objectify is costly, so avoid it 1465*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1466*0Sstevel@tonic-gate { 1467*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 1468*0Sstevel@tonic-gate } 1469*0Sstevel@tonic-gate 1470*0Sstevel@tonic-gate # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 1471*0Sstevel@tonic-gate return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || 1472*0Sstevel@tonic-gate $y->{sign} !~ /^\+$/; 1473*0Sstevel@tonic-gate 1474*0Sstevel@tonic-gate return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); 1475*0Sstevel@tonic-gate 1476*0Sstevel@tonic-gate # we need to limit the accuracy to protect against overflow 1477*0Sstevel@tonic-gate my $fallback = 0; 1478*0Sstevel@tonic-gate my (@params,$scale); 1479*0Sstevel@tonic-gate ($x,@params) = $x->_find_round_parameters($a,$p,$r); 1480*0Sstevel@tonic-gate 1481*0Sstevel@tonic-gate return $x if $x->is_nan(); # error in _find_round_parameters? 1482*0Sstevel@tonic-gate 1483*0Sstevel@tonic-gate # no rounding at all, so must use fallback 1484*0Sstevel@tonic-gate if (scalar @params == 0) 1485*0Sstevel@tonic-gate { 1486*0Sstevel@tonic-gate # simulate old behaviour 1487*0Sstevel@tonic-gate $params[0] = $self->div_scale(); # and round to it as accuracy 1488*0Sstevel@tonic-gate $scale = $params[0]+4; # at least four more for proper round 1489*0Sstevel@tonic-gate $params[2] = $r; # iound mode by caller or undef 1490*0Sstevel@tonic-gate $fallback = 1; # to clear a/p afterwards 1491*0Sstevel@tonic-gate } 1492*0Sstevel@tonic-gate else 1493*0Sstevel@tonic-gate { 1494*0Sstevel@tonic-gate # the 4 below is empirical, and there might be cases where it is not 1495*0Sstevel@tonic-gate # enough... 1496*0Sstevel@tonic-gate $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 1497*0Sstevel@tonic-gate } 1498*0Sstevel@tonic-gate 1499*0Sstevel@tonic-gate # when user set globals, they would interfere with our calculation, so 1500*0Sstevel@tonic-gate # disable them and later re-enable them 1501*0Sstevel@tonic-gate no strict 'refs'; 1502*0Sstevel@tonic-gate my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; 1503*0Sstevel@tonic-gate my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; 1504*0Sstevel@tonic-gate # we also need to disable any set A or P on $x (_find_round_parameters took 1505*0Sstevel@tonic-gate # them already into account), since these would interfere, too 1506*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1507*0Sstevel@tonic-gate # need to disable $upgrade in BigInt, to avoid deep recursion 1508*0Sstevel@tonic-gate local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI 1509*0Sstevel@tonic-gate 1510*0Sstevel@tonic-gate # remember sign and make $x positive, since -4 ** (1/2) => -2 1511*0Sstevel@tonic-gate my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+'; 1512*0Sstevel@tonic-gate 1513*0Sstevel@tonic-gate my $is_two = 0; 1514*0Sstevel@tonic-gate if ($y->isa('Math::BigFloat')) 1515*0Sstevel@tonic-gate { 1516*0Sstevel@tonic-gate $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e})); 1517*0Sstevel@tonic-gate } 1518*0Sstevel@tonic-gate else 1519*0Sstevel@tonic-gate { 1520*0Sstevel@tonic-gate $is_two = ($y == 2); 1521*0Sstevel@tonic-gate } 1522*0Sstevel@tonic-gate 1523*0Sstevel@tonic-gate # normal square root if $y == 2: 1524*0Sstevel@tonic-gate if ($is_two) 1525*0Sstevel@tonic-gate { 1526*0Sstevel@tonic-gate $x->bsqrt($scale+4); 1527*0Sstevel@tonic-gate } 1528*0Sstevel@tonic-gate elsif ($y->is_one('-')) 1529*0Sstevel@tonic-gate { 1530*0Sstevel@tonic-gate # $x ** -1 => 1/$x 1531*0Sstevel@tonic-gate my $u = $self->bone()->bdiv($x,$scale); 1532*0Sstevel@tonic-gate # copy private parts over 1533*0Sstevel@tonic-gate $x->{_m} = $u->{_m}; 1534*0Sstevel@tonic-gate $x->{_e} = $u->{_e}; 1535*0Sstevel@tonic-gate $x->{_es} = $u->{_es}; 1536*0Sstevel@tonic-gate } 1537*0Sstevel@tonic-gate else 1538*0Sstevel@tonic-gate { 1539*0Sstevel@tonic-gate # calculate the broot() as integer result first, and if it fits, return 1540*0Sstevel@tonic-gate # it rightaway (but only if $x and $y are integer): 1541*0Sstevel@tonic-gate 1542*0Sstevel@tonic-gate my $done = 0; # not yet 1543*0Sstevel@tonic-gate if ($y->is_int() && $x->is_int()) 1544*0Sstevel@tonic-gate { 1545*0Sstevel@tonic-gate my $i = $MBI->_copy( $x->{_m} ); 1546*0Sstevel@tonic-gate $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); 1547*0Sstevel@tonic-gate my $int = Math::BigInt->bzero(); 1548*0Sstevel@tonic-gate $int->{value} = $i; 1549*0Sstevel@tonic-gate $int->broot($y->as_number()); 1550*0Sstevel@tonic-gate # if ($exact) 1551*0Sstevel@tonic-gate if ($int->copy()->bpow($y) == $x) 1552*0Sstevel@tonic-gate { 1553*0Sstevel@tonic-gate # found result, return it 1554*0Sstevel@tonic-gate $x->{_m} = $int->{value}; 1555*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); 1556*0Sstevel@tonic-gate $x->{_es} = '+'; 1557*0Sstevel@tonic-gate $x->bnorm(); 1558*0Sstevel@tonic-gate $done = 1; 1559*0Sstevel@tonic-gate } 1560*0Sstevel@tonic-gate } 1561*0Sstevel@tonic-gate if ($done == 0) 1562*0Sstevel@tonic-gate { 1563*0Sstevel@tonic-gate my $u = $self->bone()->bdiv($y,$scale+4); 1564*0Sstevel@tonic-gate delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts 1565*0Sstevel@tonic-gate $x->bpow($u,$scale+4); # el cheapo 1566*0Sstevel@tonic-gate } 1567*0Sstevel@tonic-gate } 1568*0Sstevel@tonic-gate $x->bneg() if $sign == 1; 1569*0Sstevel@tonic-gate 1570*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 1571*0Sstevel@tonic-gate if (defined $params[0]) 1572*0Sstevel@tonic-gate { 1573*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 1574*0Sstevel@tonic-gate } 1575*0Sstevel@tonic-gate else 1576*0Sstevel@tonic-gate { 1577*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 1578*0Sstevel@tonic-gate } 1579*0Sstevel@tonic-gate if ($fallback) 1580*0Sstevel@tonic-gate { 1581*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1582*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1583*0Sstevel@tonic-gate } 1584*0Sstevel@tonic-gate # restore globals 1585*0Sstevel@tonic-gate $$abr = $ab; $$pbr = $pb; 1586*0Sstevel@tonic-gate $x; 1587*0Sstevel@tonic-gate } 1588*0Sstevel@tonic-gate 1589*0Sstevel@tonic-gatesub bsqrt 1590*0Sstevel@tonic-gate { 1591*0Sstevel@tonic-gate # calculate square root 1592*0Sstevel@tonic-gate my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 1593*0Sstevel@tonic-gate 1594*0Sstevel@tonic-gate return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 1595*0Sstevel@tonic-gate return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf 1596*0Sstevel@tonic-gate return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one(); 1597*0Sstevel@tonic-gate 1598*0Sstevel@tonic-gate # we need to limit the accuracy to protect against overflow 1599*0Sstevel@tonic-gate my $fallback = 0; 1600*0Sstevel@tonic-gate my (@params,$scale); 1601*0Sstevel@tonic-gate ($x,@params) = $x->_find_round_parameters($a,$p,$r); 1602*0Sstevel@tonic-gate 1603*0Sstevel@tonic-gate return $x if $x->is_nan(); # error in _find_round_parameters? 1604*0Sstevel@tonic-gate 1605*0Sstevel@tonic-gate # no rounding at all, so must use fallback 1606*0Sstevel@tonic-gate if (scalar @params == 0) 1607*0Sstevel@tonic-gate { 1608*0Sstevel@tonic-gate # simulate old behaviour 1609*0Sstevel@tonic-gate $params[0] = $self->div_scale(); # and round to it as accuracy 1610*0Sstevel@tonic-gate $scale = $params[0]+4; # at least four more for proper round 1611*0Sstevel@tonic-gate $params[2] = $r; # round mode by caller or undef 1612*0Sstevel@tonic-gate $fallback = 1; # to clear a/p afterwards 1613*0Sstevel@tonic-gate } 1614*0Sstevel@tonic-gate else 1615*0Sstevel@tonic-gate { 1616*0Sstevel@tonic-gate # the 4 below is empirical, and there might be cases where it is not 1617*0Sstevel@tonic-gate # enough... 1618*0Sstevel@tonic-gate $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 1619*0Sstevel@tonic-gate } 1620*0Sstevel@tonic-gate 1621*0Sstevel@tonic-gate # when user set globals, they would interfere with our calculation, so 1622*0Sstevel@tonic-gate # disable them and later re-enable them 1623*0Sstevel@tonic-gate no strict 'refs'; 1624*0Sstevel@tonic-gate my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; 1625*0Sstevel@tonic-gate my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; 1626*0Sstevel@tonic-gate # we also need to disable any set A or P on $x (_find_round_parameters took 1627*0Sstevel@tonic-gate # them already into account), since these would interfere, too 1628*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1629*0Sstevel@tonic-gate # need to disable $upgrade in BigInt, to avoid deep recursion 1630*0Sstevel@tonic-gate local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI 1631*0Sstevel@tonic-gate 1632*0Sstevel@tonic-gate my $i = $MBI->_copy( $x->{_m} ); 1633*0Sstevel@tonic-gate $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); 1634*0Sstevel@tonic-gate my $xas = Math::BigInt->bzero(); 1635*0Sstevel@tonic-gate $xas->{value} = $i; 1636*0Sstevel@tonic-gate 1637*0Sstevel@tonic-gate my $gs = $xas->copy()->bsqrt(); # some guess 1638*0Sstevel@tonic-gate 1639*0Sstevel@tonic-gate if (($x->{_es} ne '-') # guess can't be accurate if there are 1640*0Sstevel@tonic-gate # digits after the dot 1641*0Sstevel@tonic-gate && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head? 1642*0Sstevel@tonic-gate { 1643*0Sstevel@tonic-gate # exact result, copy result over to keep $x 1644*0Sstevel@tonic-gate $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+'; 1645*0Sstevel@tonic-gate $x->bnorm(); 1646*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 1647*0Sstevel@tonic-gate if (defined $params[0]) 1648*0Sstevel@tonic-gate { 1649*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 1650*0Sstevel@tonic-gate } 1651*0Sstevel@tonic-gate else 1652*0Sstevel@tonic-gate { 1653*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 1654*0Sstevel@tonic-gate } 1655*0Sstevel@tonic-gate if ($fallback) 1656*0Sstevel@tonic-gate { 1657*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1658*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1659*0Sstevel@tonic-gate } 1660*0Sstevel@tonic-gate # re-enable A and P, upgrade is taken care of by "local" 1661*0Sstevel@tonic-gate ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb; 1662*0Sstevel@tonic-gate return $x; 1663*0Sstevel@tonic-gate } 1664*0Sstevel@tonic-gate 1665*0Sstevel@tonic-gate # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy 1666*0Sstevel@tonic-gate # of the result by multipyling the input by 100 and then divide the integer 1667*0Sstevel@tonic-gate # result of sqrt(input) by 10. Rounding afterwards returns the real result. 1668*0Sstevel@tonic-gate 1669*0Sstevel@tonic-gate # The following steps will transform 123.456 (in $x) into 123456 (in $y1) 1670*0Sstevel@tonic-gate my $y1 = $MBI->_copy($x->{_m}); 1671*0Sstevel@tonic-gate 1672*0Sstevel@tonic-gate my $length = $MBI->_len($y1); 1673*0Sstevel@tonic-gate 1674*0Sstevel@tonic-gate # Now calculate how many digits the result of sqrt(y1) would have 1675*0Sstevel@tonic-gate my $digits = int($length / 2); 1676*0Sstevel@tonic-gate 1677*0Sstevel@tonic-gate # But we need at least $scale digits, so calculate how many are missing 1678*0Sstevel@tonic-gate my $shift = $scale - $digits; 1679*0Sstevel@tonic-gate 1680*0Sstevel@tonic-gate # That should never happen (we take care of integer guesses above) 1681*0Sstevel@tonic-gate # $shift = 0 if $shift < 0; 1682*0Sstevel@tonic-gate 1683*0Sstevel@tonic-gate # Multiply in steps of 100, by shifting left two times the "missing" digits 1684*0Sstevel@tonic-gate my $s2 = $shift * 2; 1685*0Sstevel@tonic-gate 1686*0Sstevel@tonic-gate # We now make sure that $y1 has the same odd or even number of digits than 1687*0Sstevel@tonic-gate # $x had. So when _e of $x is odd, we must shift $y1 by one digit left, 1688*0Sstevel@tonic-gate # because we always must multiply by steps of 100 (sqrt(100) is 10) and not 1689*0Sstevel@tonic-gate # steps of 10. The length of $x does not count, since an even or odd number 1690*0Sstevel@tonic-gate # of digits before the dot is not changed by adding an even number of digits 1691*0Sstevel@tonic-gate # after the dot (the result is still odd or even digits long). 1692*0Sstevel@tonic-gate $s2++ if $MBI->_is_odd($x->{_e}); 1693*0Sstevel@tonic-gate 1694*0Sstevel@tonic-gate $MBI->_lsft( $y1, $MBI->_new($s2), 10); 1695*0Sstevel@tonic-gate 1696*0Sstevel@tonic-gate # now take the square root and truncate to integer 1697*0Sstevel@tonic-gate $y1 = $MBI->_sqrt($y1); 1698*0Sstevel@tonic-gate 1699*0Sstevel@tonic-gate # By "shifting" $y1 right (by creating a negative _e) we calculate the final 1700*0Sstevel@tonic-gate # result, which is than later rounded to the desired scale. 1701*0Sstevel@tonic-gate 1702*0Sstevel@tonic-gate # calculate how many zeros $x had after the '.' (or before it, depending 1703*0Sstevel@tonic-gate # on sign of $dat, the result should have half as many: 1704*0Sstevel@tonic-gate my $dat = $MBI->_num($x->{_e}); 1705*0Sstevel@tonic-gate $dat = -$dat if $x->{_es} eq '-'; 1706*0Sstevel@tonic-gate $dat += $length; 1707*0Sstevel@tonic-gate 1708*0Sstevel@tonic-gate if ($dat > 0) 1709*0Sstevel@tonic-gate { 1710*0Sstevel@tonic-gate # no zeros after the dot (e.g. 1.23, 0.49 etc) 1711*0Sstevel@tonic-gate # preserve half as many digits before the dot than the input had 1712*0Sstevel@tonic-gate # (but round this "up") 1713*0Sstevel@tonic-gate $dat = int(($dat+1)/2); 1714*0Sstevel@tonic-gate } 1715*0Sstevel@tonic-gate else 1716*0Sstevel@tonic-gate { 1717*0Sstevel@tonic-gate $dat = int(($dat)/2); 1718*0Sstevel@tonic-gate } 1719*0Sstevel@tonic-gate $dat -= $MBI->_len($y1); 1720*0Sstevel@tonic-gate if ($dat < 0) 1721*0Sstevel@tonic-gate { 1722*0Sstevel@tonic-gate $dat = abs($dat); 1723*0Sstevel@tonic-gate $x->{_e} = $MBI->_new( $dat ); 1724*0Sstevel@tonic-gate $x->{_es} = '-'; 1725*0Sstevel@tonic-gate } 1726*0Sstevel@tonic-gate else 1727*0Sstevel@tonic-gate { 1728*0Sstevel@tonic-gate $x->{_e} = $MBI->_new( $dat ); 1729*0Sstevel@tonic-gate $x->{_es} = '+'; 1730*0Sstevel@tonic-gate } 1731*0Sstevel@tonic-gate $x->{_m} = $y1; 1732*0Sstevel@tonic-gate $x->bnorm(); 1733*0Sstevel@tonic-gate 1734*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 1735*0Sstevel@tonic-gate if (defined $params[0]) 1736*0Sstevel@tonic-gate { 1737*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 1738*0Sstevel@tonic-gate } 1739*0Sstevel@tonic-gate else 1740*0Sstevel@tonic-gate { 1741*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 1742*0Sstevel@tonic-gate } 1743*0Sstevel@tonic-gate if ($fallback) 1744*0Sstevel@tonic-gate { 1745*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1746*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1747*0Sstevel@tonic-gate } 1748*0Sstevel@tonic-gate # restore globals 1749*0Sstevel@tonic-gate $$abr = $ab; $$pbr = $pb; 1750*0Sstevel@tonic-gate $x; 1751*0Sstevel@tonic-gate } 1752*0Sstevel@tonic-gate 1753*0Sstevel@tonic-gatesub bfac 1754*0Sstevel@tonic-gate { 1755*0Sstevel@tonic-gate # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT 1756*0Sstevel@tonic-gate # compute factorial number, modifies first argument 1757*0Sstevel@tonic-gate 1758*0Sstevel@tonic-gate # set up parameters 1759*0Sstevel@tonic-gate my ($self,$x,@r) = (ref($_[0]),@_); 1760*0Sstevel@tonic-gate # objectify is costly, so avoid it 1761*0Sstevel@tonic-gate ($self,$x,@r) = objectify(1,@_) if !ref($x); 1762*0Sstevel@tonic-gate 1763*0Sstevel@tonic-gate return $x if $x->{sign} eq '+inf'; # inf => inf 1764*0Sstevel@tonic-gate return $x->bnan() 1765*0Sstevel@tonic-gate if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN 1766*0Sstevel@tonic-gate ($x->{_es} ne '+')); # digits after dot? 1767*0Sstevel@tonic-gate 1768*0Sstevel@tonic-gate # use BigInt's bfac() for faster calc 1769*0Sstevel@tonic-gate if (! $MBI->_is_zero($x->{_e})) 1770*0Sstevel@tonic-gate { 1771*0Sstevel@tonic-gate $MBI->_lsft($x->{_m}, $x->{_e},10); # change 12e1 to 120e0 1772*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); # normalize 1773*0Sstevel@tonic-gate $x->{_es} = '+'; 1774*0Sstevel@tonic-gate } 1775*0Sstevel@tonic-gate $MBI->_fac($x->{_m}); # calculate factorial 1776*0Sstevel@tonic-gate $x->bnorm()->round(@r); # norm again and round result 1777*0Sstevel@tonic-gate } 1778*0Sstevel@tonic-gate 1779*0Sstevel@tonic-gatesub _pow 1780*0Sstevel@tonic-gate { 1781*0Sstevel@tonic-gate # Calculate a power where $y is a non-integer, like 2 ** 0.5 1782*0Sstevel@tonic-gate my ($x,$y,$a,$p,$r) = @_; 1783*0Sstevel@tonic-gate my $self = ref($x); 1784*0Sstevel@tonic-gate 1785*0Sstevel@tonic-gate # if $y == 0.5, it is sqrt($x) 1786*0Sstevel@tonic-gate $HALF = $self->new($HALF) unless ref($HALF); 1787*0Sstevel@tonic-gate return $x->bsqrt($a,$p,$r,$y) if $y->bcmp($HALF) == 0; 1788*0Sstevel@tonic-gate 1789*0Sstevel@tonic-gate # Using: 1790*0Sstevel@tonic-gate # a ** x == e ** (x * ln a) 1791*0Sstevel@tonic-gate 1792*0Sstevel@tonic-gate # u = y * ln x 1793*0Sstevel@tonic-gate # _ _ 1794*0Sstevel@tonic-gate # Taylor: | u u^2 u^3 | 1795*0Sstevel@tonic-gate # x ** y = 1 + | --- + --- + ----- + ... | 1796*0Sstevel@tonic-gate # |_ 1 1*2 1*2*3 _| 1797*0Sstevel@tonic-gate 1798*0Sstevel@tonic-gate # we need to limit the accuracy to protect against overflow 1799*0Sstevel@tonic-gate my $fallback = 0; 1800*0Sstevel@tonic-gate my ($scale,@params); 1801*0Sstevel@tonic-gate ($x,@params) = $x->_find_round_parameters($a,$p,$r); 1802*0Sstevel@tonic-gate 1803*0Sstevel@tonic-gate return $x if $x->is_nan(); # error in _find_round_parameters? 1804*0Sstevel@tonic-gate 1805*0Sstevel@tonic-gate # no rounding at all, so must use fallback 1806*0Sstevel@tonic-gate if (scalar @params == 0) 1807*0Sstevel@tonic-gate { 1808*0Sstevel@tonic-gate # simulate old behaviour 1809*0Sstevel@tonic-gate $params[0] = $self->div_scale(); # and round to it as accuracy 1810*0Sstevel@tonic-gate $params[1] = undef; # disable P 1811*0Sstevel@tonic-gate $scale = $params[0]+4; # at least four more for proper round 1812*0Sstevel@tonic-gate $params[2] = $r; # round mode by caller or undef 1813*0Sstevel@tonic-gate $fallback = 1; # to clear a/p afterwards 1814*0Sstevel@tonic-gate } 1815*0Sstevel@tonic-gate else 1816*0Sstevel@tonic-gate { 1817*0Sstevel@tonic-gate # the 4 below is empirical, and there might be cases where it is not 1818*0Sstevel@tonic-gate # enough... 1819*0Sstevel@tonic-gate $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 1820*0Sstevel@tonic-gate } 1821*0Sstevel@tonic-gate 1822*0Sstevel@tonic-gate # when user set globals, they would interfere with our calculation, so 1823*0Sstevel@tonic-gate # disable them and later re-enable them 1824*0Sstevel@tonic-gate no strict 'refs'; 1825*0Sstevel@tonic-gate my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; 1826*0Sstevel@tonic-gate my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; 1827*0Sstevel@tonic-gate # we also need to disable any set A or P on $x (_find_round_parameters took 1828*0Sstevel@tonic-gate # them already into account), since these would interfere, too 1829*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1830*0Sstevel@tonic-gate # need to disable $upgrade in BigInt, to avoid deep recursion 1831*0Sstevel@tonic-gate local $Math::BigInt::upgrade = undef; 1832*0Sstevel@tonic-gate 1833*0Sstevel@tonic-gate my ($limit,$v,$u,$below,$factor,$next,$over); 1834*0Sstevel@tonic-gate 1835*0Sstevel@tonic-gate $u = $x->copy()->blog(undef,$scale)->bmul($y); 1836*0Sstevel@tonic-gate $v = $self->bone(); # 1 1837*0Sstevel@tonic-gate $factor = $self->new(2); # 2 1838*0Sstevel@tonic-gate $x->bone(); # first term: 1 1839*0Sstevel@tonic-gate 1840*0Sstevel@tonic-gate $below = $v->copy(); 1841*0Sstevel@tonic-gate $over = $u->copy(); 1842*0Sstevel@tonic-gate 1843*0Sstevel@tonic-gate $limit = $self->new("1E-". ($scale-1)); 1844*0Sstevel@tonic-gate #my $steps = 0; 1845*0Sstevel@tonic-gate while (3 < 5) 1846*0Sstevel@tonic-gate { 1847*0Sstevel@tonic-gate # we calculate the next term, and add it to the last 1848*0Sstevel@tonic-gate # when the next term is below our limit, it won't affect the outcome 1849*0Sstevel@tonic-gate # anymore, so we stop 1850*0Sstevel@tonic-gate $next = $over->copy()->bdiv($below,$scale); 1851*0Sstevel@tonic-gate last if $next->bacmp($limit) <= 0; 1852*0Sstevel@tonic-gate $x->badd($next); 1853*0Sstevel@tonic-gate # calculate things for the next term 1854*0Sstevel@tonic-gate $over *= $u; $below *= $factor; $factor->binc(); 1855*0Sstevel@tonic-gate 1856*0Sstevel@tonic-gate last if $x->{sign} !~ /^[-+]$/; 1857*0Sstevel@tonic-gate 1858*0Sstevel@tonic-gate #$steps++; 1859*0Sstevel@tonic-gate } 1860*0Sstevel@tonic-gate 1861*0Sstevel@tonic-gate # shortcut to not run through _find_round_parameters again 1862*0Sstevel@tonic-gate if (defined $params[0]) 1863*0Sstevel@tonic-gate { 1864*0Sstevel@tonic-gate $x->bround($params[0],$params[2]); # then round accordingly 1865*0Sstevel@tonic-gate } 1866*0Sstevel@tonic-gate else 1867*0Sstevel@tonic-gate { 1868*0Sstevel@tonic-gate $x->bfround($params[1],$params[2]); # then round accordingly 1869*0Sstevel@tonic-gate } 1870*0Sstevel@tonic-gate if ($fallback) 1871*0Sstevel@tonic-gate { 1872*0Sstevel@tonic-gate # clear a/p after round, since user did not request it 1873*0Sstevel@tonic-gate delete $x->{_a}; delete $x->{_p}; 1874*0Sstevel@tonic-gate } 1875*0Sstevel@tonic-gate # restore globals 1876*0Sstevel@tonic-gate $$abr = $ab; $$pbr = $pb; 1877*0Sstevel@tonic-gate $x; 1878*0Sstevel@tonic-gate } 1879*0Sstevel@tonic-gate 1880*0Sstevel@tonic-gatesub bpow 1881*0Sstevel@tonic-gate { 1882*0Sstevel@tonic-gate # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT 1883*0Sstevel@tonic-gate # compute power of two numbers, second arg is used as integer 1884*0Sstevel@tonic-gate # modifies first argument 1885*0Sstevel@tonic-gate 1886*0Sstevel@tonic-gate # set up parameters 1887*0Sstevel@tonic-gate my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); 1888*0Sstevel@tonic-gate # objectify is costly, so avoid it 1889*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1890*0Sstevel@tonic-gate { 1891*0Sstevel@tonic-gate ($self,$x,$y,$a,$p,$r) = objectify(2,@_); 1892*0Sstevel@tonic-gate } 1893*0Sstevel@tonic-gate 1894*0Sstevel@tonic-gate return $x if $x->{sign} =~ /^[+-]inf$/; 1895*0Sstevel@tonic-gate return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; 1896*0Sstevel@tonic-gate return $x->bone() if $y->is_zero(); 1897*0Sstevel@tonic-gate return $x if $x->is_one() || $y->is_one(); 1898*0Sstevel@tonic-gate 1899*0Sstevel@tonic-gate return $x->_pow($y,$a,$p,$r) if !$y->is_int(); # non-integer power 1900*0Sstevel@tonic-gate 1901*0Sstevel@tonic-gate my $y1 = $y->as_number()->{value}; # make CALC 1902*0Sstevel@tonic-gate 1903*0Sstevel@tonic-gate # if ($x == -1) 1904*0Sstevel@tonic-gate if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e})) 1905*0Sstevel@tonic-gate { 1906*0Sstevel@tonic-gate # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1 1907*0Sstevel@tonic-gate return $MBI->_is_odd($y1) ? $x : $x->babs(1); 1908*0Sstevel@tonic-gate } 1909*0Sstevel@tonic-gate if ($x->is_zero()) 1910*0Sstevel@tonic-gate { 1911*0Sstevel@tonic-gate return $x->bone() if $y->is_zero(); 1912*0Sstevel@tonic-gate return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0) 1913*0Sstevel@tonic-gate # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf) 1914*0Sstevel@tonic-gate return $x->binf(); 1915*0Sstevel@tonic-gate } 1916*0Sstevel@tonic-gate 1917*0Sstevel@tonic-gate my $new_sign = '+'; 1918*0Sstevel@tonic-gate $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+'); 1919*0Sstevel@tonic-gate 1920*0Sstevel@tonic-gate # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster) 1921*0Sstevel@tonic-gate $x->{_m} = $MBI->_pow( $x->{_m}, $y1); 1922*0Sstevel@tonic-gate $MBI->_mul ($x->{_e}, $y1); 1923*0Sstevel@tonic-gate 1924*0Sstevel@tonic-gate $x->{sign} = $new_sign; 1925*0Sstevel@tonic-gate $x->bnorm(); 1926*0Sstevel@tonic-gate if ($y->{sign} eq '-') 1927*0Sstevel@tonic-gate { 1928*0Sstevel@tonic-gate # modify $x in place! 1929*0Sstevel@tonic-gate my $z = $x->copy(); $x->bzero()->binc(); 1930*0Sstevel@tonic-gate return $x->bdiv($z,$a,$p,$r); # round in one go (might ignore y's A!) 1931*0Sstevel@tonic-gate } 1932*0Sstevel@tonic-gate $x->round($a,$p,$r,$y); 1933*0Sstevel@tonic-gate } 1934*0Sstevel@tonic-gate 1935*0Sstevel@tonic-gate############################################################################### 1936*0Sstevel@tonic-gate# rounding functions 1937*0Sstevel@tonic-gate 1938*0Sstevel@tonic-gatesub bfround 1939*0Sstevel@tonic-gate { 1940*0Sstevel@tonic-gate # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' 1941*0Sstevel@tonic-gate # $n == 0 means round to integer 1942*0Sstevel@tonic-gate # expects and returns normalized numbers! 1943*0Sstevel@tonic-gate my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); 1944*0Sstevel@tonic-gate 1945*0Sstevel@tonic-gate return $x if $x->modify('bfround'); 1946*0Sstevel@tonic-gate 1947*0Sstevel@tonic-gate my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_); 1948*0Sstevel@tonic-gate return $x if !defined $scale; # no-op 1949*0Sstevel@tonic-gate 1950*0Sstevel@tonic-gate # never round a 0, +-inf, NaN 1951*0Sstevel@tonic-gate if ($x->is_zero()) 1952*0Sstevel@tonic-gate { 1953*0Sstevel@tonic-gate $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2 1954*0Sstevel@tonic-gate return $x; 1955*0Sstevel@tonic-gate } 1956*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; 1957*0Sstevel@tonic-gate 1958*0Sstevel@tonic-gate # don't round if x already has lower precision 1959*0Sstevel@tonic-gate return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}); 1960*0Sstevel@tonic-gate 1961*0Sstevel@tonic-gate $x->{_p} = $scale; # remember round in any case 1962*0Sstevel@tonic-gate delete $x->{_a}; # and clear A 1963*0Sstevel@tonic-gate if ($scale < 0) 1964*0Sstevel@tonic-gate { 1965*0Sstevel@tonic-gate # round right from the '.' 1966*0Sstevel@tonic-gate 1967*0Sstevel@tonic-gate return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round 1968*0Sstevel@tonic-gate 1969*0Sstevel@tonic-gate $scale = -$scale; # positive for simplicity 1970*0Sstevel@tonic-gate my $len = $MBI->_len($x->{_m}); # length of mantissa 1971*0Sstevel@tonic-gate 1972*0Sstevel@tonic-gate # the following poses a restriction on _e, but if _e is bigger than a 1973*0Sstevel@tonic-gate # scalar, you got other problems (memory etc) anyway 1974*0Sstevel@tonic-gate my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e}))); # digits after dot 1975*0Sstevel@tonic-gate my $zad = 0; # zeros after dot 1976*0Sstevel@tonic-gate $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style 1977*0Sstevel@tonic-gate 1978*0Sstevel@tonic-gate # p rint "scale $scale dad $dad zad $zad len $len\n"; 1979*0Sstevel@tonic-gate # number bsstr len zad dad 1980*0Sstevel@tonic-gate # 0.123 123e-3 3 0 3 1981*0Sstevel@tonic-gate # 0.0123 123e-4 3 1 4 1982*0Sstevel@tonic-gate # 0.001 1e-3 1 2 3 1983*0Sstevel@tonic-gate # 1.23 123e-2 3 0 2 1984*0Sstevel@tonic-gate # 1.2345 12345e-4 5 0 4 1985*0Sstevel@tonic-gate 1986*0Sstevel@tonic-gate # do not round after/right of the $dad 1987*0Sstevel@tonic-gate return $x if $scale > $dad; # 0.123, scale >= 3 => exit 1988*0Sstevel@tonic-gate 1989*0Sstevel@tonic-gate # round to zero if rounding inside the $zad, but not for last zero like: 1990*0Sstevel@tonic-gate # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) 1991*0Sstevel@tonic-gate return $x->bzero() if $scale < $zad; 1992*0Sstevel@tonic-gate if ($scale == $zad) # for 0.006, scale -3 and trunc 1993*0Sstevel@tonic-gate { 1994*0Sstevel@tonic-gate $scale = -$len; 1995*0Sstevel@tonic-gate } 1996*0Sstevel@tonic-gate else 1997*0Sstevel@tonic-gate { 1998*0Sstevel@tonic-gate # adjust round-point to be inside mantissa 1999*0Sstevel@tonic-gate if ($zad != 0) 2000*0Sstevel@tonic-gate { 2001*0Sstevel@tonic-gate $scale = $scale-$zad; 2002*0Sstevel@tonic-gate } 2003*0Sstevel@tonic-gate else 2004*0Sstevel@tonic-gate { 2005*0Sstevel@tonic-gate my $dbd = $len - $dad; $dbd = 0 if $dbd < 0; # digits before dot 2006*0Sstevel@tonic-gate $scale = $dbd+$scale; 2007*0Sstevel@tonic-gate } 2008*0Sstevel@tonic-gate } 2009*0Sstevel@tonic-gate } 2010*0Sstevel@tonic-gate else 2011*0Sstevel@tonic-gate { 2012*0Sstevel@tonic-gate # round left from the '.' 2013*0Sstevel@tonic-gate 2014*0Sstevel@tonic-gate # 123 => 100 means length(123) = 3 - $scale (2) => 1 2015*0Sstevel@tonic-gate 2016*0Sstevel@tonic-gate my $dbt = $MBI->_len($x->{_m}); 2017*0Sstevel@tonic-gate # digits before dot 2018*0Sstevel@tonic-gate my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e})); 2019*0Sstevel@tonic-gate # should be the same, so treat it as this 2020*0Sstevel@tonic-gate $scale = 1 if $scale == 0; 2021*0Sstevel@tonic-gate # shortcut if already integer 2022*0Sstevel@tonic-gate return $x if $scale == 1 && $dbt <= $dbd; 2023*0Sstevel@tonic-gate # maximum digits before dot 2024*0Sstevel@tonic-gate ++$dbd; 2025*0Sstevel@tonic-gate 2026*0Sstevel@tonic-gate if ($scale > $dbd) 2027*0Sstevel@tonic-gate { 2028*0Sstevel@tonic-gate # not enough digits before dot, so round to zero 2029*0Sstevel@tonic-gate return $x->bzero; 2030*0Sstevel@tonic-gate } 2031*0Sstevel@tonic-gate elsif ( $scale == $dbd ) 2032*0Sstevel@tonic-gate { 2033*0Sstevel@tonic-gate # maximum 2034*0Sstevel@tonic-gate $scale = -$dbt; 2035*0Sstevel@tonic-gate } 2036*0Sstevel@tonic-gate else 2037*0Sstevel@tonic-gate { 2038*0Sstevel@tonic-gate $scale = $dbd - $scale; 2039*0Sstevel@tonic-gate } 2040*0Sstevel@tonic-gate } 2041*0Sstevel@tonic-gate # pass sign to bround for rounding modes '+inf' and '-inf' 2042*0Sstevel@tonic-gate my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m})); 2043*0Sstevel@tonic-gate $m->bround($scale,$mode); 2044*0Sstevel@tonic-gate $x->{_m} = $m->{value}; # get our mantissa back 2045*0Sstevel@tonic-gate $x->bnorm(); 2046*0Sstevel@tonic-gate } 2047*0Sstevel@tonic-gate 2048*0Sstevel@tonic-gatesub bround 2049*0Sstevel@tonic-gate { 2050*0Sstevel@tonic-gate # accuracy: preserve $N digits, and overwrite the rest with 0's 2051*0Sstevel@tonic-gate my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); 2052*0Sstevel@tonic-gate 2053*0Sstevel@tonic-gate if (($_[0] || 0) < 0) 2054*0Sstevel@tonic-gate { 2055*0Sstevel@tonic-gate require Carp; Carp::croak ('bround() needs positive accuracy'); 2056*0Sstevel@tonic-gate } 2057*0Sstevel@tonic-gate 2058*0Sstevel@tonic-gate my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_); 2059*0Sstevel@tonic-gate return $x if !defined $scale; # no-op 2060*0Sstevel@tonic-gate 2061*0Sstevel@tonic-gate return $x if $x->modify('bround'); 2062*0Sstevel@tonic-gate 2063*0Sstevel@tonic-gate # scale is now either $x->{_a}, $accuracy, or the user parameter 2064*0Sstevel@tonic-gate # test whether $x already has lower accuracy, do nothing in this case 2065*0Sstevel@tonic-gate # but do round if the accuracy is the same, since a math operation might 2066*0Sstevel@tonic-gate # want to round a number with A=5 to 5 digits afterwards again 2067*0Sstevel@tonic-gate return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0]; 2068*0Sstevel@tonic-gate 2069*0Sstevel@tonic-gate # scale < 0 makes no sense 2070*0Sstevel@tonic-gate # never round a +-inf, NaN 2071*0Sstevel@tonic-gate return $x if ($scale < 0) || $x->{sign} !~ /^[+-]$/; 2072*0Sstevel@tonic-gate 2073*0Sstevel@tonic-gate # 1: $scale == 0 => keep all digits 2074*0Sstevel@tonic-gate # 2: never round a 0 2075*0Sstevel@tonic-gate # 3: if we should keep more digits than the mantissa has, do nothing 2076*0Sstevel@tonic-gate if ($scale == 0 || $x->is_zero() || $MBI->_len($x->{_m}) <= $scale) 2077*0Sstevel@tonic-gate { 2078*0Sstevel@tonic-gate $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; 2079*0Sstevel@tonic-gate return $x; 2080*0Sstevel@tonic-gate } 2081*0Sstevel@tonic-gate 2082*0Sstevel@tonic-gate # pass sign to bround for '+inf' and '-inf' rounding modes 2083*0Sstevel@tonic-gate my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m})); 2084*0Sstevel@tonic-gate 2085*0Sstevel@tonic-gate $m->bround($scale,$mode); # round mantissa 2086*0Sstevel@tonic-gate $x->{_m} = $m->{value}; # get our mantissa back 2087*0Sstevel@tonic-gate $x->{_a} = $scale; # remember rounding 2088*0Sstevel@tonic-gate delete $x->{_p}; # and clear P 2089*0Sstevel@tonic-gate $x->bnorm(); # del trailing zeros gen. by bround() 2090*0Sstevel@tonic-gate } 2091*0Sstevel@tonic-gate 2092*0Sstevel@tonic-gatesub bfloor 2093*0Sstevel@tonic-gate { 2094*0Sstevel@tonic-gate # return integer less or equal then $x 2095*0Sstevel@tonic-gate my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 2096*0Sstevel@tonic-gate 2097*0Sstevel@tonic-gate return $x if $x->modify('bfloor'); 2098*0Sstevel@tonic-gate 2099*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf 2100*0Sstevel@tonic-gate 2101*0Sstevel@tonic-gate # if $x has digits after dot 2102*0Sstevel@tonic-gate if ($x->{_es} eq '-') 2103*0Sstevel@tonic-gate { 2104*0Sstevel@tonic-gate $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot 2105*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); # trunc/norm 2106*0Sstevel@tonic-gate $x->{_es} = '+'; # abs e 2107*0Sstevel@tonic-gate $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative 2108*0Sstevel@tonic-gate } 2109*0Sstevel@tonic-gate $x->round($a,$p,$r); 2110*0Sstevel@tonic-gate } 2111*0Sstevel@tonic-gate 2112*0Sstevel@tonic-gatesub bceil 2113*0Sstevel@tonic-gate { 2114*0Sstevel@tonic-gate # return integer greater or equal then $x 2115*0Sstevel@tonic-gate my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 2116*0Sstevel@tonic-gate 2117*0Sstevel@tonic-gate return $x if $x->modify('bceil'); 2118*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf 2119*0Sstevel@tonic-gate 2120*0Sstevel@tonic-gate # if $x has digits after dot 2121*0Sstevel@tonic-gate if ($x->{_es} eq '-') 2122*0Sstevel@tonic-gate { 2123*0Sstevel@tonic-gate $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot 2124*0Sstevel@tonic-gate $x->{_e} = $MBI->_zero(); # trunc/norm 2125*0Sstevel@tonic-gate $x->{_es} = '+'; # abs e 2126*0Sstevel@tonic-gate $MBI->_inc($x->{_m}) if $x->{sign} eq '+'; # increment if positive 2127*0Sstevel@tonic-gate } 2128*0Sstevel@tonic-gate $x->round($a,$p,$r); 2129*0Sstevel@tonic-gate } 2130*0Sstevel@tonic-gate 2131*0Sstevel@tonic-gatesub brsft 2132*0Sstevel@tonic-gate { 2133*0Sstevel@tonic-gate # shift right by $y (divide by power of $n) 2134*0Sstevel@tonic-gate 2135*0Sstevel@tonic-gate # set up parameters 2136*0Sstevel@tonic-gate my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_); 2137*0Sstevel@tonic-gate # objectify is costly, so avoid it 2138*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2139*0Sstevel@tonic-gate { 2140*0Sstevel@tonic-gate ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); 2141*0Sstevel@tonic-gate } 2142*0Sstevel@tonic-gate 2143*0Sstevel@tonic-gate return $x if $x->modify('brsft'); 2144*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf 2145*0Sstevel@tonic-gate 2146*0Sstevel@tonic-gate $n = 2 if !defined $n; $n = $self->new($n); 2147*0Sstevel@tonic-gate $x->bdiv($n->bpow($y),$a,$p,$r,$y); 2148*0Sstevel@tonic-gate } 2149*0Sstevel@tonic-gate 2150*0Sstevel@tonic-gatesub blsft 2151*0Sstevel@tonic-gate { 2152*0Sstevel@tonic-gate # shift left by $y (multiply by power of $n) 2153*0Sstevel@tonic-gate 2154*0Sstevel@tonic-gate # set up parameters 2155*0Sstevel@tonic-gate my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_); 2156*0Sstevel@tonic-gate # objectify is costly, so avoid it 2157*0Sstevel@tonic-gate if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2158*0Sstevel@tonic-gate { 2159*0Sstevel@tonic-gate ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); 2160*0Sstevel@tonic-gate } 2161*0Sstevel@tonic-gate 2162*0Sstevel@tonic-gate return $x if $x->modify('blsft'); 2163*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf 2164*0Sstevel@tonic-gate 2165*0Sstevel@tonic-gate $n = 2 if !defined $n; $n = $self->new($n); 2166*0Sstevel@tonic-gate $x->bmul($n->bpow($y),$a,$p,$r,$y); 2167*0Sstevel@tonic-gate } 2168*0Sstevel@tonic-gate 2169*0Sstevel@tonic-gate############################################################################### 2170*0Sstevel@tonic-gate 2171*0Sstevel@tonic-gatesub DESTROY 2172*0Sstevel@tonic-gate { 2173*0Sstevel@tonic-gate # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub 2174*0Sstevel@tonic-gate } 2175*0Sstevel@tonic-gate 2176*0Sstevel@tonic-gatesub AUTOLOAD 2177*0Sstevel@tonic-gate { 2178*0Sstevel@tonic-gate # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx() 2179*0Sstevel@tonic-gate # or falling back to MBI::bxxx() 2180*0Sstevel@tonic-gate my $name = $AUTOLOAD; 2181*0Sstevel@tonic-gate 2182*0Sstevel@tonic-gate $name =~ s/(.*):://; # split package 2183*0Sstevel@tonic-gate my $c = $1 || $class; 2184*0Sstevel@tonic-gate no strict 'refs'; 2185*0Sstevel@tonic-gate $c->import() if $IMPORT == 0; 2186*0Sstevel@tonic-gate if (!method_alias($name)) 2187*0Sstevel@tonic-gate { 2188*0Sstevel@tonic-gate if (!defined $name) 2189*0Sstevel@tonic-gate { 2190*0Sstevel@tonic-gate # delayed load of Carp and avoid recursion 2191*0Sstevel@tonic-gate require Carp; 2192*0Sstevel@tonic-gate Carp::croak ("$c: Can't call a method without name"); 2193*0Sstevel@tonic-gate } 2194*0Sstevel@tonic-gate if (!method_hand_up($name)) 2195*0Sstevel@tonic-gate { 2196*0Sstevel@tonic-gate # delayed load of Carp and avoid recursion 2197*0Sstevel@tonic-gate require Carp; 2198*0Sstevel@tonic-gate Carp::croak ("Can't call $c\-\>$name, not a valid method"); 2199*0Sstevel@tonic-gate } 2200*0Sstevel@tonic-gate # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() 2201*0Sstevel@tonic-gate $name =~ s/^f/b/; 2202*0Sstevel@tonic-gate return &{"Math::BigInt"."::$name"}(@_); 2203*0Sstevel@tonic-gate } 2204*0Sstevel@tonic-gate my $bname = $name; $bname =~ s/^f/b/; 2205*0Sstevel@tonic-gate $c .= "::$name"; 2206*0Sstevel@tonic-gate *{$c} = \&{$bname}; 2207*0Sstevel@tonic-gate &{$c}; # uses @_ 2208*0Sstevel@tonic-gate } 2209*0Sstevel@tonic-gate 2210*0Sstevel@tonic-gatesub exponent 2211*0Sstevel@tonic-gate { 2212*0Sstevel@tonic-gate # return a copy of the exponent 2213*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2214*0Sstevel@tonic-gate 2215*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/) 2216*0Sstevel@tonic-gate { 2217*0Sstevel@tonic-gate my $s = $x->{sign}; $s =~ s/^[+-]//; 2218*0Sstevel@tonic-gate return Math::BigInt->new($s); # -inf, +inf => +inf 2219*0Sstevel@tonic-gate } 2220*0Sstevel@tonic-gate Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e})); 2221*0Sstevel@tonic-gate } 2222*0Sstevel@tonic-gate 2223*0Sstevel@tonic-gatesub mantissa 2224*0Sstevel@tonic-gate { 2225*0Sstevel@tonic-gate # return a copy of the mantissa 2226*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2227*0Sstevel@tonic-gate 2228*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/) 2229*0Sstevel@tonic-gate { 2230*0Sstevel@tonic-gate my $s = $x->{sign}; $s =~ s/^[+]//; 2231*0Sstevel@tonic-gate return Math::BigInt->new($s); # -inf, +inf => +inf 2232*0Sstevel@tonic-gate } 2233*0Sstevel@tonic-gate my $m = Math::BigInt->new( $MBI->_str($x->{_m})); 2234*0Sstevel@tonic-gate $m->bneg() if $x->{sign} eq '-'; 2235*0Sstevel@tonic-gate 2236*0Sstevel@tonic-gate $m; 2237*0Sstevel@tonic-gate } 2238*0Sstevel@tonic-gate 2239*0Sstevel@tonic-gatesub parts 2240*0Sstevel@tonic-gate { 2241*0Sstevel@tonic-gate # return a copy of both the exponent and the mantissa 2242*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2243*0Sstevel@tonic-gate 2244*0Sstevel@tonic-gate if ($x->{sign} !~ /^[+-]$/) 2245*0Sstevel@tonic-gate { 2246*0Sstevel@tonic-gate my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//; 2247*0Sstevel@tonic-gate return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf 2248*0Sstevel@tonic-gate } 2249*0Sstevel@tonic-gate my $m = Math::BigInt->bzero(); 2250*0Sstevel@tonic-gate $m->{value} = $MBI->_copy($x->{_m}); 2251*0Sstevel@tonic-gate $m->bneg() if $x->{sign} eq '-'; 2252*0Sstevel@tonic-gate ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) )); 2253*0Sstevel@tonic-gate } 2254*0Sstevel@tonic-gate 2255*0Sstevel@tonic-gate############################################################################## 2256*0Sstevel@tonic-gate# private stuff (internal use only) 2257*0Sstevel@tonic-gate 2258*0Sstevel@tonic-gatesub import 2259*0Sstevel@tonic-gate { 2260*0Sstevel@tonic-gate my $self = shift; 2261*0Sstevel@tonic-gate my $l = scalar @_; 2262*0Sstevel@tonic-gate my $lib = ''; my @a; 2263*0Sstevel@tonic-gate $IMPORT=1; 2264*0Sstevel@tonic-gate for ( my $i = 0; $i < $l ; $i++) 2265*0Sstevel@tonic-gate { 2266*0Sstevel@tonic-gate if ( $_[$i] eq ':constant' ) 2267*0Sstevel@tonic-gate { 2268*0Sstevel@tonic-gate # This causes overlord er load to step in. 'binary' and 'integer' 2269*0Sstevel@tonic-gate # are handled by BigInt. 2270*0Sstevel@tonic-gate overload::constant float => sub { $self->new(shift); }; 2271*0Sstevel@tonic-gate } 2272*0Sstevel@tonic-gate elsif ($_[$i] eq 'upgrade') 2273*0Sstevel@tonic-gate { 2274*0Sstevel@tonic-gate # this causes upgrading 2275*0Sstevel@tonic-gate $upgrade = $_[$i+1]; # or undef to disable 2276*0Sstevel@tonic-gate $i++; 2277*0Sstevel@tonic-gate } 2278*0Sstevel@tonic-gate elsif ($_[$i] eq 'downgrade') 2279*0Sstevel@tonic-gate { 2280*0Sstevel@tonic-gate # this causes downgrading 2281*0Sstevel@tonic-gate $downgrade = $_[$i+1]; # or undef to disable 2282*0Sstevel@tonic-gate $i++; 2283*0Sstevel@tonic-gate } 2284*0Sstevel@tonic-gate elsif ($_[$i] eq 'lib') 2285*0Sstevel@tonic-gate { 2286*0Sstevel@tonic-gate # alternative library 2287*0Sstevel@tonic-gate $lib = $_[$i+1] || ''; # default Calc 2288*0Sstevel@tonic-gate $i++; 2289*0Sstevel@tonic-gate } 2290*0Sstevel@tonic-gate elsif ($_[$i] eq 'with') 2291*0Sstevel@tonic-gate { 2292*0Sstevel@tonic-gate # alternative class for our private parts() 2293*0Sstevel@tonic-gate # XXX: no longer supported 2294*0Sstevel@tonic-gate # $MBI = $_[$i+1] || 'Math::BigInt'; 2295*0Sstevel@tonic-gate $i++; 2296*0Sstevel@tonic-gate } 2297*0Sstevel@tonic-gate else 2298*0Sstevel@tonic-gate { 2299*0Sstevel@tonic-gate push @a, $_[$i]; 2300*0Sstevel@tonic-gate } 2301*0Sstevel@tonic-gate } 2302*0Sstevel@tonic-gate 2303*0Sstevel@tonic-gate # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work 2304*0Sstevel@tonic-gate my $mbilib = eval { Math::BigInt->config()->{lib} }; 2305*0Sstevel@tonic-gate if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc')) 2306*0Sstevel@tonic-gate { 2307*0Sstevel@tonic-gate # MBI already loaded 2308*0Sstevel@tonic-gate Math::BigInt->import('lib',"$lib,$mbilib", 'objectify'); 2309*0Sstevel@tonic-gate } 2310*0Sstevel@tonic-gate else 2311*0Sstevel@tonic-gate { 2312*0Sstevel@tonic-gate # MBI not loaded, or with ne "Math::BigInt::Calc" 2313*0Sstevel@tonic-gate $lib .= ",$mbilib" if defined $mbilib; 2314*0Sstevel@tonic-gate $lib =~ s/^,//; # don't leave empty 2315*0Sstevel@tonic-gate # replacement library can handle lib statement, but also could ignore it 2316*0Sstevel@tonic-gate if ($] < 5.006) 2317*0Sstevel@tonic-gate { 2318*0Sstevel@tonic-gate # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is 2319*0Sstevel@tonic-gate # used in the same script, or eval inside import(). 2320*0Sstevel@tonic-gate require Math::BigInt; 2321*0Sstevel@tonic-gate Math::BigInt->import( lib => $lib, 'objectify' ); 2322*0Sstevel@tonic-gate } 2323*0Sstevel@tonic-gate else 2324*0Sstevel@tonic-gate { 2325*0Sstevel@tonic-gate my $rc = "use Math::BigInt lib => '$lib', 'objectify';"; 2326*0Sstevel@tonic-gate eval $rc; 2327*0Sstevel@tonic-gate } 2328*0Sstevel@tonic-gate } 2329*0Sstevel@tonic-gate if ($@) 2330*0Sstevel@tonic-gate { 2331*0Sstevel@tonic-gate require Carp; Carp::croak ("Couldn't load $lib: $! $@"); 2332*0Sstevel@tonic-gate } 2333*0Sstevel@tonic-gate $MBI = Math::BigInt->config()->{lib}; 2334*0Sstevel@tonic-gate 2335*0Sstevel@tonic-gate # any non :constant stuff is handled by our parent, Exporter 2336*0Sstevel@tonic-gate # even if @_ is empty, to give it a chance 2337*0Sstevel@tonic-gate $self->SUPER::import(@a); # for subclasses 2338*0Sstevel@tonic-gate $self->export_to_level(1,$self,@a); # need this, too 2339*0Sstevel@tonic-gate } 2340*0Sstevel@tonic-gate 2341*0Sstevel@tonic-gatesub bnorm 2342*0Sstevel@tonic-gate { 2343*0Sstevel@tonic-gate # adjust m and e so that m is smallest possible 2344*0Sstevel@tonic-gate # round number according to accuracy and precision settings 2345*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 2346*0Sstevel@tonic-gate 2347*0Sstevel@tonic-gate return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2348*0Sstevel@tonic-gate 2349*0Sstevel@tonic-gate my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros 2350*0Sstevel@tonic-gate if ($zeros != 0) 2351*0Sstevel@tonic-gate { 2352*0Sstevel@tonic-gate my $z = $MBI->_new($zeros); 2353*0Sstevel@tonic-gate $x->{_m} = $MBI->_rsft ($x->{_m}, $z, 10); 2354*0Sstevel@tonic-gate if ($x->{_es} eq '-') 2355*0Sstevel@tonic-gate { 2356*0Sstevel@tonic-gate if ($MBI->_acmp($x->{_e},$z) >= 0) 2357*0Sstevel@tonic-gate { 2358*0Sstevel@tonic-gate $x->{_e} = $MBI->_sub ($x->{_e}, $z); 2359*0Sstevel@tonic-gate $x->{_es} = '+' if $MBI->_is_zero($x->{_e}); 2360*0Sstevel@tonic-gate } 2361*0Sstevel@tonic-gate else 2362*0Sstevel@tonic-gate { 2363*0Sstevel@tonic-gate $x->{_e} = $MBI->_sub ( $MBI->_copy($z), $x->{_e}); 2364*0Sstevel@tonic-gate $x->{_es} = '+'; 2365*0Sstevel@tonic-gate } 2366*0Sstevel@tonic-gate } 2367*0Sstevel@tonic-gate else 2368*0Sstevel@tonic-gate { 2369*0Sstevel@tonic-gate $x->{_e} = $MBI->_add ($x->{_e}, $z); 2370*0Sstevel@tonic-gate } 2371*0Sstevel@tonic-gate } 2372*0Sstevel@tonic-gate else 2373*0Sstevel@tonic-gate { 2374*0Sstevel@tonic-gate # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing 2375*0Sstevel@tonic-gate # zeros). So, for something like 0Ey, set y to 1, and -0 => +0 2376*0Sstevel@tonic-gate $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one() 2377*0Sstevel@tonic-gate if $MBI->_is_zero($x->{_m}); 2378*0Sstevel@tonic-gate } 2379*0Sstevel@tonic-gate 2380*0Sstevel@tonic-gate $x; # MBI bnorm is no-op, so dont call it 2381*0Sstevel@tonic-gate } 2382*0Sstevel@tonic-gate 2383*0Sstevel@tonic-gate############################################################################## 2384*0Sstevel@tonic-gate 2385*0Sstevel@tonic-gatesub as_hex 2386*0Sstevel@tonic-gate { 2387*0Sstevel@tonic-gate # return number as hexadecimal string (only for integers defined) 2388*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2389*0Sstevel@tonic-gate 2390*0Sstevel@tonic-gate return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2391*0Sstevel@tonic-gate return '0x0' if $x->is_zero(); 2392*0Sstevel@tonic-gate 2393*0Sstevel@tonic-gate return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!? 2394*0Sstevel@tonic-gate 2395*0Sstevel@tonic-gate my $z = $MBI->_copy($x->{_m}); 2396*0Sstevel@tonic-gate if (! $MBI->_is_zero($x->{_e})) # > 0 2397*0Sstevel@tonic-gate { 2398*0Sstevel@tonic-gate $MBI->_lsft( $z, $x->{_e},10); 2399*0Sstevel@tonic-gate } 2400*0Sstevel@tonic-gate $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); 2401*0Sstevel@tonic-gate $z->as_hex(); 2402*0Sstevel@tonic-gate } 2403*0Sstevel@tonic-gate 2404*0Sstevel@tonic-gatesub as_bin 2405*0Sstevel@tonic-gate { 2406*0Sstevel@tonic-gate # return number as binary digit string (only for integers defined) 2407*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2408*0Sstevel@tonic-gate 2409*0Sstevel@tonic-gate return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2410*0Sstevel@tonic-gate return '0b0' if $x->is_zero(); 2411*0Sstevel@tonic-gate 2412*0Sstevel@tonic-gate return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!? 2413*0Sstevel@tonic-gate 2414*0Sstevel@tonic-gate my $z = $MBI->_copy($x->{_m}); 2415*0Sstevel@tonic-gate if (! $MBI->_is_zero($x->{_e})) # > 0 2416*0Sstevel@tonic-gate { 2417*0Sstevel@tonic-gate $MBI->_lsft( $z, $x->{_e},10); 2418*0Sstevel@tonic-gate } 2419*0Sstevel@tonic-gate $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); 2420*0Sstevel@tonic-gate $z->as_bin(); 2421*0Sstevel@tonic-gate } 2422*0Sstevel@tonic-gate 2423*0Sstevel@tonic-gatesub as_number 2424*0Sstevel@tonic-gate { 2425*0Sstevel@tonic-gate # return copy as a bigint representation of this BigFloat number 2426*0Sstevel@tonic-gate my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2427*0Sstevel@tonic-gate 2428*0Sstevel@tonic-gate my $z = $MBI->_copy($x->{_m}); 2429*0Sstevel@tonic-gate if ($x->{_es} eq '-') # < 0 2430*0Sstevel@tonic-gate { 2431*0Sstevel@tonic-gate $MBI->_rsft( $z, $x->{_e},10); 2432*0Sstevel@tonic-gate } 2433*0Sstevel@tonic-gate elsif (! $MBI->_is_zero($x->{_e})) # > 0 2434*0Sstevel@tonic-gate { 2435*0Sstevel@tonic-gate $MBI->_lsft( $z, $x->{_e},10); 2436*0Sstevel@tonic-gate } 2437*0Sstevel@tonic-gate $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); 2438*0Sstevel@tonic-gate $z; 2439*0Sstevel@tonic-gate } 2440*0Sstevel@tonic-gate 2441*0Sstevel@tonic-gatesub length 2442*0Sstevel@tonic-gate { 2443*0Sstevel@tonic-gate my $x = shift; 2444*0Sstevel@tonic-gate my $class = ref($x) || $x; 2445*0Sstevel@tonic-gate $x = $class->new(shift) unless ref($x); 2446*0Sstevel@tonic-gate 2447*0Sstevel@tonic-gate return 1 if $MBI->_is_zero($x->{_m}); 2448*0Sstevel@tonic-gate 2449*0Sstevel@tonic-gate my $len = $MBI->_len($x->{_m}); 2450*0Sstevel@tonic-gate $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+'; 2451*0Sstevel@tonic-gate if (wantarray()) 2452*0Sstevel@tonic-gate { 2453*0Sstevel@tonic-gate my $t = 0; 2454*0Sstevel@tonic-gate $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-'; 2455*0Sstevel@tonic-gate return ($len, $t); 2456*0Sstevel@tonic-gate } 2457*0Sstevel@tonic-gate $len; 2458*0Sstevel@tonic-gate } 2459*0Sstevel@tonic-gate 2460*0Sstevel@tonic-gate1; 2461*0Sstevel@tonic-gate__END__ 2462*0Sstevel@tonic-gate 2463*0Sstevel@tonic-gate=head1 NAME 2464*0Sstevel@tonic-gate 2465*0Sstevel@tonic-gateMath::BigFloat - Arbitrary size floating point math package 2466*0Sstevel@tonic-gate 2467*0Sstevel@tonic-gate=head1 SYNOPSIS 2468*0Sstevel@tonic-gate 2469*0Sstevel@tonic-gate use Math::BigFloat; 2470*0Sstevel@tonic-gate 2471*0Sstevel@tonic-gate # Number creation 2472*0Sstevel@tonic-gate $x = Math::BigFloat->new($str); # defaults to 0 2473*0Sstevel@tonic-gate $nan = Math::BigFloat->bnan(); # create a NotANumber 2474*0Sstevel@tonic-gate $zero = Math::BigFloat->bzero(); # create a +0 2475*0Sstevel@tonic-gate $inf = Math::BigFloat->binf(); # create a +inf 2476*0Sstevel@tonic-gate $inf = Math::BigFloat->binf('-'); # create a -inf 2477*0Sstevel@tonic-gate $one = Math::BigFloat->bone(); # create a +1 2478*0Sstevel@tonic-gate $one = Math::BigFloat->bone('-'); # create a -1 2479*0Sstevel@tonic-gate 2480*0Sstevel@tonic-gate # Testing 2481*0Sstevel@tonic-gate $x->is_zero(); # true if arg is +0 2482*0Sstevel@tonic-gate $x->is_nan(); # true if arg is NaN 2483*0Sstevel@tonic-gate $x->is_one(); # true if arg is +1 2484*0Sstevel@tonic-gate $x->is_one('-'); # true if arg is -1 2485*0Sstevel@tonic-gate $x->is_odd(); # true if odd, false for even 2486*0Sstevel@tonic-gate $x->is_even(); # true if even, false for odd 2487*0Sstevel@tonic-gate $x->is_pos(); # true if >= 0 2488*0Sstevel@tonic-gate $x->is_neg(); # true if < 0 2489*0Sstevel@tonic-gate $x->is_inf(sign); # true if +inf, or -inf (default is '+') 2490*0Sstevel@tonic-gate 2491*0Sstevel@tonic-gate $x->bcmp($y); # compare numbers (undef,<0,=0,>0) 2492*0Sstevel@tonic-gate $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) 2493*0Sstevel@tonic-gate $x->sign(); # return the sign, either +,- or NaN 2494*0Sstevel@tonic-gate $x->digit($n); # return the nth digit, counting from right 2495*0Sstevel@tonic-gate $x->digit(-$n); # return the nth digit, counting from left 2496*0Sstevel@tonic-gate 2497*0Sstevel@tonic-gate # The following all modify their first argument. If you want to preserve 2498*0Sstevel@tonic-gate # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is 2499*0Sstevel@tonic-gate # neccessary when mixing $a = $b assigments with non-overloaded math. 2500*0Sstevel@tonic-gate 2501*0Sstevel@tonic-gate # set 2502*0Sstevel@tonic-gate $x->bzero(); # set $i to 0 2503*0Sstevel@tonic-gate $x->bnan(); # set $i to NaN 2504*0Sstevel@tonic-gate $x->bone(); # set $x to +1 2505*0Sstevel@tonic-gate $x->bone('-'); # set $x to -1 2506*0Sstevel@tonic-gate $x->binf(); # set $x to inf 2507*0Sstevel@tonic-gate $x->binf('-'); # set $x to -inf 2508*0Sstevel@tonic-gate 2509*0Sstevel@tonic-gate $x->bneg(); # negation 2510*0Sstevel@tonic-gate $x->babs(); # absolute value 2511*0Sstevel@tonic-gate $x->bnorm(); # normalize (no-op) 2512*0Sstevel@tonic-gate $x->bnot(); # two's complement (bit wise not) 2513*0Sstevel@tonic-gate $x->binc(); # increment x by 1 2514*0Sstevel@tonic-gate $x->bdec(); # decrement x by 1 2515*0Sstevel@tonic-gate 2516*0Sstevel@tonic-gate $x->badd($y); # addition (add $y to $x) 2517*0Sstevel@tonic-gate $x->bsub($y); # subtraction (subtract $y from $x) 2518*0Sstevel@tonic-gate $x->bmul($y); # multiplication (multiply $x by $y) 2519*0Sstevel@tonic-gate $x->bdiv($y); # divide, set $x to quotient 2520*0Sstevel@tonic-gate # return (quo,rem) or quo if scalar 2521*0Sstevel@tonic-gate 2522*0Sstevel@tonic-gate $x->bmod($y); # modulus ($x % $y) 2523*0Sstevel@tonic-gate $x->bpow($y); # power of arguments ($x ** $y) 2524*0Sstevel@tonic-gate $x->blsft($y); # left shift 2525*0Sstevel@tonic-gate $x->brsft($y); # right shift 2526*0Sstevel@tonic-gate # return (quo,rem) or quo if scalar 2527*0Sstevel@tonic-gate 2528*0Sstevel@tonic-gate $x->blog(); # logarithm of $x to base e (Euler's number) 2529*0Sstevel@tonic-gate $x->blog($base); # logarithm of $x to base $base (f.i. 2) 2530*0Sstevel@tonic-gate 2531*0Sstevel@tonic-gate $x->band($y); # bit-wise and 2532*0Sstevel@tonic-gate $x->bior($y); # bit-wise inclusive or 2533*0Sstevel@tonic-gate $x->bxor($y); # bit-wise exclusive or 2534*0Sstevel@tonic-gate $x->bnot(); # bit-wise not (two's complement) 2535*0Sstevel@tonic-gate 2536*0Sstevel@tonic-gate $x->bsqrt(); # calculate square-root 2537*0Sstevel@tonic-gate $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) 2538*0Sstevel@tonic-gate $x->bfac(); # factorial of $x (1*2*3*4*..$x) 2539*0Sstevel@tonic-gate 2540*0Sstevel@tonic-gate $x->bround($N); # accuracy: preserve $N digits 2541*0Sstevel@tonic-gate $x->bfround($N); # precision: round to the $Nth digit 2542*0Sstevel@tonic-gate 2543*0Sstevel@tonic-gate $x->bfloor(); # return integer less or equal than $x 2544*0Sstevel@tonic-gate $x->bceil(); # return integer greater or equal than $x 2545*0Sstevel@tonic-gate 2546*0Sstevel@tonic-gate # The following do not modify their arguments: 2547*0Sstevel@tonic-gate 2548*0Sstevel@tonic-gate bgcd(@values); # greatest common divisor 2549*0Sstevel@tonic-gate blcm(@values); # lowest common multiplicator 2550*0Sstevel@tonic-gate 2551*0Sstevel@tonic-gate $x->bstr(); # return string 2552*0Sstevel@tonic-gate $x->bsstr(); # return string in scientific notation 2553*0Sstevel@tonic-gate 2554*0Sstevel@tonic-gate $x->as_int(); # return $x as BigInt 2555*0Sstevel@tonic-gate $x->exponent(); # return exponent as BigInt 2556*0Sstevel@tonic-gate $x->mantissa(); # return mantissa as BigInt 2557*0Sstevel@tonic-gate $x->parts(); # return (mantissa,exponent) as BigInt 2558*0Sstevel@tonic-gate 2559*0Sstevel@tonic-gate $x->length(); # number of digits (w/o sign and '.') 2560*0Sstevel@tonic-gate ($l,$f) = $x->length(); # number of digits, and length of fraction 2561*0Sstevel@tonic-gate 2562*0Sstevel@tonic-gate $x->precision(); # return P of $x (or global, if P of $x undef) 2563*0Sstevel@tonic-gate $x->precision($n); # set P of $x to $n 2564*0Sstevel@tonic-gate $x->accuracy(); # return A of $x (or global, if A of $x undef) 2565*0Sstevel@tonic-gate $x->accuracy($n); # set A $x to $n 2566*0Sstevel@tonic-gate 2567*0Sstevel@tonic-gate # these get/set the appropriate global value for all BigFloat objects 2568*0Sstevel@tonic-gate Math::BigFloat->precision(); # Precision 2569*0Sstevel@tonic-gate Math::BigFloat->accuracy(); # Accuracy 2570*0Sstevel@tonic-gate Math::BigFloat->round_mode(); # rounding mode 2571*0Sstevel@tonic-gate 2572*0Sstevel@tonic-gate=head1 DESCRIPTION 2573*0Sstevel@tonic-gate 2574*0Sstevel@tonic-gateAll operators (inlcuding basic math operations) are overloaded if you 2575*0Sstevel@tonic-gatedeclare your big floating point numbers as 2576*0Sstevel@tonic-gate 2577*0Sstevel@tonic-gate $i = new Math::BigFloat '12_3.456_789_123_456_789E-2'; 2578*0Sstevel@tonic-gate 2579*0Sstevel@tonic-gateOperations with overloaded operators preserve the arguments, which is 2580*0Sstevel@tonic-gateexactly what you expect. 2581*0Sstevel@tonic-gate 2582*0Sstevel@tonic-gate=head2 Canonical notation 2583*0Sstevel@tonic-gate 2584*0Sstevel@tonic-gateInput to these routines are either BigFloat objects, or strings of the 2585*0Sstevel@tonic-gatefollowing four forms: 2586*0Sstevel@tonic-gate 2587*0Sstevel@tonic-gate=over 2 2588*0Sstevel@tonic-gate 2589*0Sstevel@tonic-gate=item * 2590*0Sstevel@tonic-gate 2591*0Sstevel@tonic-gateC</^[+-]\d+$/> 2592*0Sstevel@tonic-gate 2593*0Sstevel@tonic-gate=item * 2594*0Sstevel@tonic-gate 2595*0Sstevel@tonic-gateC</^[+-]\d+\.\d*$/> 2596*0Sstevel@tonic-gate 2597*0Sstevel@tonic-gate=item * 2598*0Sstevel@tonic-gate 2599*0Sstevel@tonic-gateC</^[+-]\d+E[+-]?\d+$/> 2600*0Sstevel@tonic-gate 2601*0Sstevel@tonic-gate=item * 2602*0Sstevel@tonic-gate 2603*0Sstevel@tonic-gateC</^[+-]\d*\.\d+E[+-]?\d+$/> 2604*0Sstevel@tonic-gate 2605*0Sstevel@tonic-gate=back 2606*0Sstevel@tonic-gate 2607*0Sstevel@tonic-gateall with optional leading and trailing zeros and/or spaces. Additonally, 2608*0Sstevel@tonic-gatenumbers are allowed to have an underscore between any two digits. 2609*0Sstevel@tonic-gate 2610*0Sstevel@tonic-gateEmpty strings as well as other illegal numbers results in 'NaN'. 2611*0Sstevel@tonic-gate 2612*0Sstevel@tonic-gatebnorm() on a BigFloat object is now effectively a no-op, since the numbers 2613*0Sstevel@tonic-gateare always stored in normalized form. On a string, it creates a BigFloat 2614*0Sstevel@tonic-gateobject. 2615*0Sstevel@tonic-gate 2616*0Sstevel@tonic-gate=head2 Output 2617*0Sstevel@tonic-gate 2618*0Sstevel@tonic-gateOutput values are BigFloat objects (normalized), except for bstr() and bsstr(). 2619*0Sstevel@tonic-gate 2620*0Sstevel@tonic-gateThe string output will always have leading and trailing zeros stripped and drop 2621*0Sstevel@tonic-gatea plus sign. C<bstr()> will give you always the form with a decimal point, 2622*0Sstevel@tonic-gatewhile C<bsstr()> (s for scientific) gives you the scientific notation. 2623*0Sstevel@tonic-gate 2624*0Sstevel@tonic-gate Input bstr() bsstr() 2625*0Sstevel@tonic-gate '-0' '0' '0E1' 2626*0Sstevel@tonic-gate ' -123 123 123' '-123123123' '-123123123E0' 2627*0Sstevel@tonic-gate '00.0123' '0.0123' '123E-4' 2628*0Sstevel@tonic-gate '123.45E-2' '1.2345' '12345E-4' 2629*0Sstevel@tonic-gate '10E+3' '10000' '1E4' 2630*0Sstevel@tonic-gate 2631*0Sstevel@tonic-gateSome routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>, 2632*0Sstevel@tonic-gateC<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>) 2633*0Sstevel@tonic-gatereturn either undef, <0, 0 or >0 and are suited for sort. 2634*0Sstevel@tonic-gate 2635*0Sstevel@tonic-gateActual math is done by using the class defined with C<with => Class;> (which 2636*0Sstevel@tonic-gatedefaults to BigInts) to represent the mantissa and exponent. 2637*0Sstevel@tonic-gate 2638*0Sstevel@tonic-gateThe sign C</^[+-]$/> is stored separately. The string 'NaN' is used to 2639*0Sstevel@tonic-gaterepresent the result when input arguments are not numbers, as well as 2640*0Sstevel@tonic-gatethe result of dividing by zero. 2641*0Sstevel@tonic-gate 2642*0Sstevel@tonic-gate=head2 C<mantissa()>, C<exponent()> and C<parts()> 2643*0Sstevel@tonic-gate 2644*0Sstevel@tonic-gateC<mantissa()> and C<exponent()> return the said parts of the BigFloat 2645*0Sstevel@tonic-gateas BigInts such that: 2646*0Sstevel@tonic-gate 2647*0Sstevel@tonic-gate $m = $x->mantissa(); 2648*0Sstevel@tonic-gate $e = $x->exponent(); 2649*0Sstevel@tonic-gate $y = $m * ( 10 ** $e ); 2650*0Sstevel@tonic-gate print "ok\n" if $x == $y; 2651*0Sstevel@tonic-gate 2652*0Sstevel@tonic-gateC<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them. 2653*0Sstevel@tonic-gate 2654*0Sstevel@tonic-gateA zero is represented and returned as C<0E1>, B<not> C<0E0> (after Knuth). 2655*0Sstevel@tonic-gate 2656*0Sstevel@tonic-gateCurrently the mantissa is reduced as much as possible, favouring higher 2657*0Sstevel@tonic-gateexponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0). 2658*0Sstevel@tonic-gateThis might change in the future, so do not depend on it. 2659*0Sstevel@tonic-gate 2660*0Sstevel@tonic-gate=head2 Accuracy vs. Precision 2661*0Sstevel@tonic-gate 2662*0Sstevel@tonic-gateSee also: L<Rounding|Rounding>. 2663*0Sstevel@tonic-gate 2664*0Sstevel@tonic-gateMath::BigFloat supports both precision and accuracy. For a full documentation, 2665*0Sstevel@tonic-gateexamples and tips on these topics please see the large section in 2666*0Sstevel@tonic-gateL<Math::BigInt>. 2667*0Sstevel@tonic-gate 2668*0Sstevel@tonic-gateSince things like sqrt(2) or 1/3 must presented with a limited precision lest 2669*0Sstevel@tonic-gatea operation consumes all resources, each operation produces no more than 2670*0Sstevel@tonic-gatethe requested number of digits. 2671*0Sstevel@tonic-gate 2672*0Sstevel@tonic-gatePlease refer to BigInt's documentation for the precedence rules of which 2673*0Sstevel@tonic-gateaccuracy/precision setting will be used. 2674*0Sstevel@tonic-gate 2675*0Sstevel@tonic-gateIf there is no gloabl precision set, B<and> the operation inquestion was not 2676*0Sstevel@tonic-gatecalled with a requested precision or accuracy, B<and> the input $x has no 2677*0Sstevel@tonic-gateaccuracy or precision set, then a fallback parameter will be used. For 2678*0Sstevel@tonic-gatehistorical reasons, it is called C<div_scale> and can be accessed via: 2679*0Sstevel@tonic-gate 2680*0Sstevel@tonic-gate $d = Math::BigFloat->div_scale(); # query 2681*0Sstevel@tonic-gate Math::BigFloat->div_scale($n); # set to $n digits 2682*0Sstevel@tonic-gate 2683*0Sstevel@tonic-gateThe default value is 40 digits. 2684*0Sstevel@tonic-gate 2685*0Sstevel@tonic-gateIn case the result of one operation has more precision than specified, 2686*0Sstevel@tonic-gateit is rounded. The rounding mode taken is either the default mode, or the one 2687*0Sstevel@tonic-gatesupplied to the operation after the I<scale>: 2688*0Sstevel@tonic-gate 2689*0Sstevel@tonic-gate $x = Math::BigFloat->new(2); 2690*0Sstevel@tonic-gate Math::BigFloat->precision(5); # 5 digits max 2691*0Sstevel@tonic-gate $y = $x->copy()->bdiv(3); # will give 0.66666 2692*0Sstevel@tonic-gate $y = $x->copy()->bdiv(3,6); # will give 0.666666 2693*0Sstevel@tonic-gate $y = $x->copy()->bdiv(3,6,'odd'); # will give 0.666667 2694*0Sstevel@tonic-gate Math::BigFloat->round_mode('zero'); 2695*0Sstevel@tonic-gate $y = $x->copy()->bdiv(3,6); # will give 0.666666 2696*0Sstevel@tonic-gate 2697*0Sstevel@tonic-gate=head2 Rounding 2698*0Sstevel@tonic-gate 2699*0Sstevel@tonic-gate=over 2 2700*0Sstevel@tonic-gate 2701*0Sstevel@tonic-gate=item ffround ( +$scale ) 2702*0Sstevel@tonic-gate 2703*0Sstevel@tonic-gateRounds to the $scale'th place left from the '.', counting from the dot. 2704*0Sstevel@tonic-gateThe first digit is numbered 1. 2705*0Sstevel@tonic-gate 2706*0Sstevel@tonic-gate=item ffround ( -$scale ) 2707*0Sstevel@tonic-gate 2708*0Sstevel@tonic-gateRounds to the $scale'th place right from the '.', counting from the dot. 2709*0Sstevel@tonic-gate 2710*0Sstevel@tonic-gate=item ffround ( 0 ) 2711*0Sstevel@tonic-gate 2712*0Sstevel@tonic-gateRounds to an integer. 2713*0Sstevel@tonic-gate 2714*0Sstevel@tonic-gate=item fround ( +$scale ) 2715*0Sstevel@tonic-gate 2716*0Sstevel@tonic-gatePreserves accuracy to $scale digits from the left (aka significant digits) 2717*0Sstevel@tonic-gateand pads the rest with zeros. If the number is between 1 and -1, the 2718*0Sstevel@tonic-gatesignificant digits count from the first non-zero after the '.' 2719*0Sstevel@tonic-gate 2720*0Sstevel@tonic-gate=item fround ( -$scale ) and fround ( 0 ) 2721*0Sstevel@tonic-gate 2722*0Sstevel@tonic-gateThese are effectively no-ops. 2723*0Sstevel@tonic-gate 2724*0Sstevel@tonic-gate=back 2725*0Sstevel@tonic-gate 2726*0Sstevel@tonic-gateAll rounding functions take as a second parameter a rounding mode from one of 2727*0Sstevel@tonic-gatethe following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'. 2728*0Sstevel@tonic-gate 2729*0Sstevel@tonic-gateThe default rounding mode is 'even'. By using 2730*0Sstevel@tonic-gateC<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default 2731*0Sstevel@tonic-gatemode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is 2732*0Sstevel@tonic-gateno longer supported. 2733*0Sstevel@tonic-gateThe second parameter to the round functions then overrides the default 2734*0Sstevel@tonic-gatetemporarily. 2735*0Sstevel@tonic-gate 2736*0Sstevel@tonic-gateThe C<as_number()> function returns a BigInt from a Math::BigFloat. It uses 2737*0Sstevel@tonic-gate'trunc' as rounding mode to make it equivalent to: 2738*0Sstevel@tonic-gate 2739*0Sstevel@tonic-gate $x = 2.5; 2740*0Sstevel@tonic-gate $y = int($x) + 2; 2741*0Sstevel@tonic-gate 2742*0Sstevel@tonic-gateYou can override this by passing the desired rounding mode as parameter to 2743*0Sstevel@tonic-gateC<as_number()>: 2744*0Sstevel@tonic-gate 2745*0Sstevel@tonic-gate $x = Math::BigFloat->new(2.5); 2746*0Sstevel@tonic-gate $y = $x->as_number('odd'); # $y = 3 2747*0Sstevel@tonic-gate 2748*0Sstevel@tonic-gate=head1 EXAMPLES 2749*0Sstevel@tonic-gate 2750*0Sstevel@tonic-gate # not ready yet 2751*0Sstevel@tonic-gate 2752*0Sstevel@tonic-gate=head1 Autocreating constants 2753*0Sstevel@tonic-gate 2754*0Sstevel@tonic-gateAfter C<use Math::BigFloat ':constant'> all the floating point constants 2755*0Sstevel@tonic-gatein the given scope are converted to C<Math::BigFloat>. This conversion 2756*0Sstevel@tonic-gatehappens at compile time. 2757*0Sstevel@tonic-gate 2758*0Sstevel@tonic-gateIn particular 2759*0Sstevel@tonic-gate 2760*0Sstevel@tonic-gate perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' 2761*0Sstevel@tonic-gate 2762*0Sstevel@tonic-gateprints the value of C<2E-100>. Note that without conversion of 2763*0Sstevel@tonic-gateconstants the expression 2E-100 will be calculated as normal floating point 2764*0Sstevel@tonic-gatenumber. 2765*0Sstevel@tonic-gate 2766*0Sstevel@tonic-gatePlease note that ':constant' does not affect integer constants, nor binary 2767*0Sstevel@tonic-gatenor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to 2768*0Sstevel@tonic-gatework. 2769*0Sstevel@tonic-gate 2770*0Sstevel@tonic-gate=head2 Math library 2771*0Sstevel@tonic-gate 2772*0Sstevel@tonic-gateMath with the numbers is done (by default) by a module called 2773*0Sstevel@tonic-gateMath::BigInt::Calc. This is equivalent to saying: 2774*0Sstevel@tonic-gate 2775*0Sstevel@tonic-gate use Math::BigFloat lib => 'Calc'; 2776*0Sstevel@tonic-gate 2777*0Sstevel@tonic-gateYou can change this by using: 2778*0Sstevel@tonic-gate 2779*0Sstevel@tonic-gate use Math::BigFloat lib => 'BitVect'; 2780*0Sstevel@tonic-gate 2781*0Sstevel@tonic-gateThe following would first try to find Math::BigInt::Foo, then 2782*0Sstevel@tonic-gateMath::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: 2783*0Sstevel@tonic-gate 2784*0Sstevel@tonic-gate use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; 2785*0Sstevel@tonic-gate 2786*0Sstevel@tonic-gateCalc.pm uses as internal format an array of elements of some decimal base 2787*0Sstevel@tonic-gate(usually 1e7, but this might be differen for some systems) with the least 2788*0Sstevel@tonic-gatesignificant digit first, while BitVect.pm uses a bit vector of base 2, most 2789*0Sstevel@tonic-gatesignificant bit first. Other modules might use even different means of 2790*0Sstevel@tonic-gaterepresenting the numbers. See the respective module documentation for further 2791*0Sstevel@tonic-gatedetails. 2792*0Sstevel@tonic-gate 2793*0Sstevel@tonic-gatePlease note that Math::BigFloat does B<not> use the denoted library itself, 2794*0Sstevel@tonic-gatebut it merely passes the lib argument to Math::BigInt. So, instead of the need 2795*0Sstevel@tonic-gateto do: 2796*0Sstevel@tonic-gate 2797*0Sstevel@tonic-gate use Math::BigInt lib => 'GMP'; 2798*0Sstevel@tonic-gate use Math::BigFloat; 2799*0Sstevel@tonic-gate 2800*0Sstevel@tonic-gateyou can roll it all into one line: 2801*0Sstevel@tonic-gate 2802*0Sstevel@tonic-gate use Math::BigFloat lib => 'GMP'; 2803*0Sstevel@tonic-gate 2804*0Sstevel@tonic-gateIt is also possible to just require Math::BigFloat: 2805*0Sstevel@tonic-gate 2806*0Sstevel@tonic-gate require Math::BigFloat; 2807*0Sstevel@tonic-gate 2808*0Sstevel@tonic-gateThis will load the neccessary things (like BigInt) when they are needed, and 2809*0Sstevel@tonic-gateautomatically. 2810*0Sstevel@tonic-gate 2811*0Sstevel@tonic-gateUse the lib, Luke! And see L<Using Math::BigInt::Lite> for more details than 2812*0Sstevel@tonic-gateyou ever wanted to know about loading a different library. 2813*0Sstevel@tonic-gate 2814*0Sstevel@tonic-gate=head2 Using Math::BigInt::Lite 2815*0Sstevel@tonic-gate 2816*0Sstevel@tonic-gateIt is possible to use L<Math::BigInt::Lite> with Math::BigFloat: 2817*0Sstevel@tonic-gate 2818*0Sstevel@tonic-gate # 1 2819*0Sstevel@tonic-gate use Math::BigFloat with => 'Math::BigInt::Lite'; 2820*0Sstevel@tonic-gate 2821*0Sstevel@tonic-gateThere is no need to "use Math::BigInt" or "use Math::BigInt::Lite", but you 2822*0Sstevel@tonic-gatecan combine these if you want. For instance, you may want to use 2823*0Sstevel@tonic-gateMath::BigInt objects in your main script, too. 2824*0Sstevel@tonic-gate 2825*0Sstevel@tonic-gate # 2 2826*0Sstevel@tonic-gate use Math::BigInt; 2827*0Sstevel@tonic-gate use Math::BigFloat with => 'Math::BigInt::Lite'; 2828*0Sstevel@tonic-gate 2829*0Sstevel@tonic-gateOf course, you can combine this with the C<lib> parameter. 2830*0Sstevel@tonic-gate 2831*0Sstevel@tonic-gate # 3 2832*0Sstevel@tonic-gate use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari'; 2833*0Sstevel@tonic-gate 2834*0Sstevel@tonic-gateThere is no need for a "use Math::BigInt;" statement, even if you want to 2835*0Sstevel@tonic-gateuse Math::BigInt's, since Math::BigFloat will needs Math::BigInt and thus 2836*0Sstevel@tonic-gatealways loads it. But if you add it, add it B<before>: 2837*0Sstevel@tonic-gate 2838*0Sstevel@tonic-gate # 4 2839*0Sstevel@tonic-gate use Math::BigInt; 2840*0Sstevel@tonic-gate use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari'; 2841*0Sstevel@tonic-gate 2842*0Sstevel@tonic-gateNotice that the module with the last C<lib> will "win" and thus 2843*0Sstevel@tonic-gateit's lib will be used if the lib is available: 2844*0Sstevel@tonic-gate 2845*0Sstevel@tonic-gate # 5 2846*0Sstevel@tonic-gate use Math::BigInt lib => 'Bar,Baz'; 2847*0Sstevel@tonic-gate use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'Foo'; 2848*0Sstevel@tonic-gate 2849*0Sstevel@tonic-gateThat would try to load Foo, Bar, Baz and Calc (in that order). Or in other 2850*0Sstevel@tonic-gatewords, Math::BigFloat will try to retain previously loaded libs when you 2851*0Sstevel@tonic-gatedon't specify it onem but if you specify one, it will try to load them. 2852*0Sstevel@tonic-gate 2853*0Sstevel@tonic-gateActually, the lib loading order would be "Bar,Baz,Calc", and then 2854*0Sstevel@tonic-gate"Foo,Bar,Baz,Calc", but independend of which lib exists, the result is the 2855*0Sstevel@tonic-gatesame as trying the latter load alone, except for the fact that one of Bar or 2856*0Sstevel@tonic-gateBaz might be loaded needlessly in an intermidiate step (and thus hang around 2857*0Sstevel@tonic-gateand waste memory). If neither Bar nor Baz exist (or don't work/compile), they 2858*0Sstevel@tonic-gatewill still be tried to be loaded, but this is not as time/memory consuming as 2859*0Sstevel@tonic-gateactually loading one of them. Still, this type of usage is not recommended due 2860*0Sstevel@tonic-gateto these issues. 2861*0Sstevel@tonic-gate 2862*0Sstevel@tonic-gateThe old way (loading the lib only in BigInt) still works though: 2863*0Sstevel@tonic-gate 2864*0Sstevel@tonic-gate # 6 2865*0Sstevel@tonic-gate use Math::BigInt lib => 'Bar,Baz'; 2866*0Sstevel@tonic-gate use Math::BigFloat; 2867*0Sstevel@tonic-gate 2868*0Sstevel@tonic-gateYou can even load Math::BigInt afterwards: 2869*0Sstevel@tonic-gate 2870*0Sstevel@tonic-gate # 7 2871*0Sstevel@tonic-gate use Math::BigFloat; 2872*0Sstevel@tonic-gate use Math::BigInt lib => 'Bar,Baz'; 2873*0Sstevel@tonic-gate 2874*0Sstevel@tonic-gateBut this has the same problems like #5, it will first load Calc 2875*0Sstevel@tonic-gate(Math::BigFloat needs Math::BigInt and thus loads it) and then later Bar or 2876*0Sstevel@tonic-gateBaz, depending on which of them works and is usable/loadable. Since this 2877*0Sstevel@tonic-gateloads Calc unnecc., it is not recommended. 2878*0Sstevel@tonic-gate 2879*0Sstevel@tonic-gateSince it also possible to just require Math::BigFloat, this poses the question 2880*0Sstevel@tonic-gateabout what libary this will use: 2881*0Sstevel@tonic-gate 2882*0Sstevel@tonic-gate require Math::BigFloat; 2883*0Sstevel@tonic-gate my $x = Math::BigFloat->new(123); $x += 123; 2884*0Sstevel@tonic-gate 2885*0Sstevel@tonic-gateIt will use Calc. Please note that the call to import() is still done, but 2886*0Sstevel@tonic-gateonly when you use for the first time some Math::BigFloat math (it is triggered 2887*0Sstevel@tonic-gatevia any constructor, so the first time you create a Math::BigFloat, the load 2888*0Sstevel@tonic-gatewill happen in the background). This means: 2889*0Sstevel@tonic-gate 2890*0Sstevel@tonic-gate require Math::BigFloat; 2891*0Sstevel@tonic-gate Math::BigFloat->import ( lib => 'Foo,Bar' ); 2892*0Sstevel@tonic-gate 2893*0Sstevel@tonic-gatewould be the same as: 2894*0Sstevel@tonic-gate 2895*0Sstevel@tonic-gate use Math::BigFloat lib => 'Foo, Bar'; 2896*0Sstevel@tonic-gate 2897*0Sstevel@tonic-gateBut don't try to be clever to insert some operations in between: 2898*0Sstevel@tonic-gate 2899*0Sstevel@tonic-gate require Math::BigFloat; 2900*0Sstevel@tonic-gate my $x = Math::BigFloat->bone() + 4; # load BigInt and Calc 2901*0Sstevel@tonic-gate Math::BigFloat->import( lib => 'Pari' ); # load Pari, too 2902*0Sstevel@tonic-gate $x = Math::BigFloat->bone()+4; # now use Pari 2903*0Sstevel@tonic-gate 2904*0Sstevel@tonic-gateWhile this works, it loads Calc needlessly. But maybe you just wanted that? 2905*0Sstevel@tonic-gate 2906*0Sstevel@tonic-gateB<Examples #3 is highly recommended> for daily usage. 2907*0Sstevel@tonic-gate 2908*0Sstevel@tonic-gate=head1 BUGS 2909*0Sstevel@tonic-gate 2910*0Sstevel@tonic-gatePlease see the file BUGS in the CPAN distribution Math::BigInt for known bugs. 2911*0Sstevel@tonic-gate 2912*0Sstevel@tonic-gate=head1 CAVEATS 2913*0Sstevel@tonic-gate 2914*0Sstevel@tonic-gate=over 1 2915*0Sstevel@tonic-gate 2916*0Sstevel@tonic-gate=item stringify, bstr() 2917*0Sstevel@tonic-gate 2918*0Sstevel@tonic-gateBoth stringify and bstr() now drop the leading '+'. The old code would return 2919*0Sstevel@tonic-gate'+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for 2920*0Sstevel@tonic-gatereasoning and details. 2921*0Sstevel@tonic-gate 2922*0Sstevel@tonic-gate=item bdiv 2923*0Sstevel@tonic-gate 2924*0Sstevel@tonic-gateThe following will probably not do what you expect: 2925*0Sstevel@tonic-gate 2926*0Sstevel@tonic-gate print $c->bdiv(123.456),"\n"; 2927*0Sstevel@tonic-gate 2928*0Sstevel@tonic-gateIt prints both quotient and reminder since print works in list context. Also, 2929*0Sstevel@tonic-gatebdiv() will modify $c, so be carefull. You probably want to use 2930*0Sstevel@tonic-gate 2931*0Sstevel@tonic-gate print $c / 123.456,"\n"; 2932*0Sstevel@tonic-gate print scalar $c->bdiv(123.456),"\n"; # or if you want to modify $c 2933*0Sstevel@tonic-gate 2934*0Sstevel@tonic-gateinstead. 2935*0Sstevel@tonic-gate 2936*0Sstevel@tonic-gate=item Modifying and = 2937*0Sstevel@tonic-gate 2938*0Sstevel@tonic-gateBeware of: 2939*0Sstevel@tonic-gate 2940*0Sstevel@tonic-gate $x = Math::BigFloat->new(5); 2941*0Sstevel@tonic-gate $y = $x; 2942*0Sstevel@tonic-gate 2943*0Sstevel@tonic-gateIt will not do what you think, e.g. making a copy of $x. Instead it just makes 2944*0Sstevel@tonic-gatea second reference to the B<same> object and stores it in $y. Thus anything 2945*0Sstevel@tonic-gatethat modifies $x will modify $y (except overloaded math operators), and vice 2946*0Sstevel@tonic-gateversa. See L<Math::BigInt> for details and how to avoid that. 2947*0Sstevel@tonic-gate 2948*0Sstevel@tonic-gate=item bpow 2949*0Sstevel@tonic-gate 2950*0Sstevel@tonic-gateC<bpow()> now modifies the first argument, unlike the old code which left 2951*0Sstevel@tonic-gateit alone and only returned the result. This is to be consistent with 2952*0Sstevel@tonic-gateC<badd()> etc. The first will modify $x, the second one won't: 2953*0Sstevel@tonic-gate 2954*0Sstevel@tonic-gate print bpow($x,$i),"\n"; # modify $x 2955*0Sstevel@tonic-gate print $x->bpow($i),"\n"; # ditto 2956*0Sstevel@tonic-gate print $x ** $i,"\n"; # leave $x alone 2957*0Sstevel@tonic-gate 2958*0Sstevel@tonic-gate=back 2959*0Sstevel@tonic-gate 2960*0Sstevel@tonic-gate=head1 SEE ALSO 2961*0Sstevel@tonic-gate 2962*0Sstevel@tonic-gateL<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well as 2963*0Sstevel@tonic-gateL<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>. 2964*0Sstevel@tonic-gate 2965*0Sstevel@tonic-gateThe pragmas L<bignum>, L<bigint> and L<bigrat> might also be of interest 2966*0Sstevel@tonic-gatebecause they solve the autoupgrading/downgrading issue, at least partly. 2967*0Sstevel@tonic-gate 2968*0Sstevel@tonic-gateThe package at 2969*0Sstevel@tonic-gateL<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains 2970*0Sstevel@tonic-gatemore documentation including a full version history, testcases, empty 2971*0Sstevel@tonic-gatesubclass files and benchmarks. 2972*0Sstevel@tonic-gate 2973*0Sstevel@tonic-gate=head1 LICENSE 2974*0Sstevel@tonic-gate 2975*0Sstevel@tonic-gateThis program is free software; you may redistribute it and/or modify it under 2976*0Sstevel@tonic-gatethe same terms as Perl itself. 2977*0Sstevel@tonic-gate 2978*0Sstevel@tonic-gate=head1 AUTHORS 2979*0Sstevel@tonic-gate 2980*0Sstevel@tonic-gateMark Biggar, overloaded interface by Ilya Zakharevich. 2981*0Sstevel@tonic-gateCompletely rewritten by Tels http://bloodgate.com in 2001, 2002, and still 2982*0Sstevel@tonic-gateat it in 2003. 2983*0Sstevel@tonic-gate 2984*0Sstevel@tonic-gate=cut 2985