15759b3d2Safresh1package Math::BigInt::Lib; 25759b3d2Safresh1 35759b3d2Safresh1use 5.006001; 45759b3d2Safresh1use strict; 55759b3d2Safresh1use warnings; 65759b3d2Safresh1 7*5486feefSafresh1our $VERSION = '2.003002'; 8256a93a4Safresh1$VERSION =~ tr/_//d; 95759b3d2Safresh1 105759b3d2Safresh1use Carp; 115759b3d2Safresh1 125759b3d2Safresh1use overload 135759b3d2Safresh1 145759b3d2Safresh1 # overload key: with_assign 155759b3d2Safresh1 165759b3d2Safresh1 '+' => sub { 175759b3d2Safresh1 my $class = ref $_[0]; 185759b3d2Safresh1 my $x = $class -> _copy($_[0]); 195759b3d2Safresh1 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 205759b3d2Safresh1 return $class -> _add($x, $y); 215759b3d2Safresh1 }, 225759b3d2Safresh1 235759b3d2Safresh1 '-' => sub { 245759b3d2Safresh1 my $class = ref $_[0]; 255759b3d2Safresh1 my ($x, $y); 265759b3d2Safresh1 if ($_[2]) { # if swapped 275759b3d2Safresh1 $y = $_[0]; 285759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 295759b3d2Safresh1 } else { 305759b3d2Safresh1 $x = $class -> _copy($_[0]); 315759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 325759b3d2Safresh1 } 335759b3d2Safresh1 return $class -> _sub($x, $y); 345759b3d2Safresh1 }, 355759b3d2Safresh1 365759b3d2Safresh1 '*' => sub { 375759b3d2Safresh1 my $class = ref $_[0]; 385759b3d2Safresh1 my $x = $class -> _copy($_[0]); 395759b3d2Safresh1 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 405759b3d2Safresh1 return $class -> _mul($x, $y); 415759b3d2Safresh1 }, 425759b3d2Safresh1 435759b3d2Safresh1 '/' => sub { 445759b3d2Safresh1 my $class = ref $_[0]; 455759b3d2Safresh1 my ($x, $y); 465759b3d2Safresh1 if ($_[2]) { # if swapped 475759b3d2Safresh1 $y = $_[0]; 485759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 495759b3d2Safresh1 } else { 505759b3d2Safresh1 $x = $class -> _copy($_[0]); 515759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 525759b3d2Safresh1 } 535759b3d2Safresh1 return $class -> _div($x, $y); 545759b3d2Safresh1 }, 555759b3d2Safresh1 565759b3d2Safresh1 '%' => sub { 575759b3d2Safresh1 my $class = ref $_[0]; 585759b3d2Safresh1 my ($x, $y); 595759b3d2Safresh1 if ($_[2]) { # if swapped 605759b3d2Safresh1 $y = $_[0]; 615759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 625759b3d2Safresh1 } else { 635759b3d2Safresh1 $x = $class -> _copy($_[0]); 645759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 655759b3d2Safresh1 } 665759b3d2Safresh1 return $class -> _mod($x, $y); 675759b3d2Safresh1 }, 685759b3d2Safresh1 695759b3d2Safresh1 '**' => sub { 705759b3d2Safresh1 my $class = ref $_[0]; 715759b3d2Safresh1 my ($x, $y); 725759b3d2Safresh1 if ($_[2]) { # if swapped 735759b3d2Safresh1 $y = $_[0]; 745759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 755759b3d2Safresh1 } else { 765759b3d2Safresh1 $x = $class -> _copy($_[0]); 775759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 785759b3d2Safresh1 } 795759b3d2Safresh1 return $class -> _pow($x, $y); 805759b3d2Safresh1 }, 815759b3d2Safresh1 825759b3d2Safresh1 '<<' => sub { 835759b3d2Safresh1 my $class = ref $_[0]; 845759b3d2Safresh1 my ($x, $y); 855759b3d2Safresh1 if ($_[2]) { # if swapped 865759b3d2Safresh1 $y = $class -> _num($_[0]); 875759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 885759b3d2Safresh1 } else { 895759b3d2Safresh1 $x = $_[0]; 905759b3d2Safresh1 $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1]; 915759b3d2Safresh1 } 92256a93a4Safresh1 return $class -> _lsft($x, $y); 935759b3d2Safresh1 }, 945759b3d2Safresh1 955759b3d2Safresh1 '>>' => sub { 965759b3d2Safresh1 my $class = ref $_[0]; 975759b3d2Safresh1 my ($x, $y); 985759b3d2Safresh1 if ($_[2]) { # if swapped 995759b3d2Safresh1 $y = $_[0]; 1005759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1015759b3d2Safresh1 } else { 1025759b3d2Safresh1 $x = $class -> _copy($_[0]); 1035759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1045759b3d2Safresh1 } 105256a93a4Safresh1 return $class -> _rsft($x, $y); 1065759b3d2Safresh1 }, 1075759b3d2Safresh1 1085759b3d2Safresh1 # overload key: num_comparison 1095759b3d2Safresh1 1105759b3d2Safresh1 '<' => sub { 1115759b3d2Safresh1 my $class = ref $_[0]; 1125759b3d2Safresh1 my ($x, $y); 1135759b3d2Safresh1 if ($_[2]) { # if swapped 1145759b3d2Safresh1 $y = $_[0]; 1155759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1165759b3d2Safresh1 } else { 1175759b3d2Safresh1 $x = $class -> _copy($_[0]); 1185759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1195759b3d2Safresh1 } 1205759b3d2Safresh1 return $class -> _acmp($x, $y) < 0; 1215759b3d2Safresh1 }, 1225759b3d2Safresh1 1235759b3d2Safresh1 '<=' => sub { 1245759b3d2Safresh1 my $class = ref $_[0]; 1255759b3d2Safresh1 my ($x, $y); 1265759b3d2Safresh1 if ($_[2]) { # if swapped 1275759b3d2Safresh1 $y = $_[0]; 1285759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1295759b3d2Safresh1 } else { 1305759b3d2Safresh1 $x = $class -> _copy($_[0]); 1315759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1325759b3d2Safresh1 } 1335759b3d2Safresh1 return $class -> _acmp($x, $y) <= 0; 1345759b3d2Safresh1 }, 1355759b3d2Safresh1 1365759b3d2Safresh1 '>' => sub { 1375759b3d2Safresh1 my $class = ref $_[0]; 1385759b3d2Safresh1 my ($x, $y); 1395759b3d2Safresh1 if ($_[2]) { # if swapped 1405759b3d2Safresh1 $y = $_[0]; 1415759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1425759b3d2Safresh1 } else { 1435759b3d2Safresh1 $x = $class -> _copy($_[0]); 1445759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1455759b3d2Safresh1 } 1465759b3d2Safresh1 return $class -> _acmp($x, $y) > 0; 1475759b3d2Safresh1 }, 1485759b3d2Safresh1 1495759b3d2Safresh1 '>=' => sub { 1505759b3d2Safresh1 my $class = ref $_[0]; 1515759b3d2Safresh1 my ($x, $y); 1525759b3d2Safresh1 if ($_[2]) { # if swapped 1535759b3d2Safresh1 $y = $_[0]; 1545759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1555759b3d2Safresh1 } else { 1565759b3d2Safresh1 $x = $class -> _copy($_[0]); 1575759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1585759b3d2Safresh1 } 1595759b3d2Safresh1 return $class -> _acmp($x, $y) >= 0; 1605759b3d2Safresh1 }, 1615759b3d2Safresh1 1625759b3d2Safresh1 '==' => sub { 1635759b3d2Safresh1 my $class = ref $_[0]; 1645759b3d2Safresh1 my $x = $class -> _copy($_[0]); 1655759b3d2Safresh1 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1665759b3d2Safresh1 return $class -> _acmp($x, $y) == 0; 1675759b3d2Safresh1 }, 1685759b3d2Safresh1 1695759b3d2Safresh1 '!=' => sub { 1705759b3d2Safresh1 my $class = ref $_[0]; 1715759b3d2Safresh1 my $x = $class -> _copy($_[0]); 1725759b3d2Safresh1 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1735759b3d2Safresh1 return $class -> _acmp($x, $y) != 0; 1745759b3d2Safresh1 }, 1755759b3d2Safresh1 1765759b3d2Safresh1 # overload key: 3way_comparison 1775759b3d2Safresh1 1785759b3d2Safresh1 '<=>' => sub { 1795759b3d2Safresh1 my $class = ref $_[0]; 1805759b3d2Safresh1 my ($x, $y); 1815759b3d2Safresh1 if ($_[2]) { # if swapped 1825759b3d2Safresh1 $y = $_[0]; 1835759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1845759b3d2Safresh1 } else { 1855759b3d2Safresh1 $x = $class -> _copy($_[0]); 1865759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1875759b3d2Safresh1 } 1885759b3d2Safresh1 return $class -> _acmp($x, $y); 1895759b3d2Safresh1 }, 1905759b3d2Safresh1 1915759b3d2Safresh1 # overload key: binary 1925759b3d2Safresh1 1935759b3d2Safresh1 '&' => sub { 1945759b3d2Safresh1 my $class = ref $_[0]; 1955759b3d2Safresh1 my ($x, $y); 1965759b3d2Safresh1 if ($_[2]) { # if swapped 1975759b3d2Safresh1 $y = $_[0]; 1985759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 1995759b3d2Safresh1 } else { 2005759b3d2Safresh1 $x = $class -> _copy($_[0]); 2015759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 2025759b3d2Safresh1 } 2035759b3d2Safresh1 return $class -> _and($x, $y); 2045759b3d2Safresh1 }, 2055759b3d2Safresh1 2065759b3d2Safresh1 '|' => sub { 2075759b3d2Safresh1 my $class = ref $_[0]; 2085759b3d2Safresh1 my ($x, $y); 2095759b3d2Safresh1 if ($_[2]) { # if swapped 2105759b3d2Safresh1 $y = $_[0]; 2115759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 2125759b3d2Safresh1 } else { 2135759b3d2Safresh1 $x = $class -> _copy($_[0]); 2145759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 2155759b3d2Safresh1 } 2165759b3d2Safresh1 return $class -> _or($x, $y); 2175759b3d2Safresh1 }, 2185759b3d2Safresh1 2195759b3d2Safresh1 '^' => sub { 2205759b3d2Safresh1 my $class = ref $_[0]; 2215759b3d2Safresh1 my ($x, $y); 2225759b3d2Safresh1 if ($_[2]) { # if swapped 2235759b3d2Safresh1 $y = $_[0]; 2245759b3d2Safresh1 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 2255759b3d2Safresh1 } else { 2265759b3d2Safresh1 $x = $class -> _copy($_[0]); 2275759b3d2Safresh1 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 2285759b3d2Safresh1 } 2295759b3d2Safresh1 return $class -> _xor($x, $y); 2305759b3d2Safresh1 }, 2315759b3d2Safresh1 2325759b3d2Safresh1 # overload key: func 2335759b3d2Safresh1 2345759b3d2Safresh1 'abs' => sub { $_[0] }, 2355759b3d2Safresh1 2365759b3d2Safresh1 'sqrt' => sub { 2375759b3d2Safresh1 my $class = ref $_[0]; 2385759b3d2Safresh1 return $class -> _sqrt($class -> _copy($_[0])); 2395759b3d2Safresh1 }, 2405759b3d2Safresh1 2415759b3d2Safresh1 'int' => sub { $_[0] }, 2425759b3d2Safresh1 2435759b3d2Safresh1 # overload key: conversion 2445759b3d2Safresh1 2455759b3d2Safresh1 'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; }, 2465759b3d2Safresh1 2475759b3d2Safresh1 '""' => sub { ref($_[0]) -> _str($_[0]); }, 2485759b3d2Safresh1 2495759b3d2Safresh1 '0+' => sub { ref($_[0]) -> _num($_[0]); }, 2505759b3d2Safresh1 2515759b3d2Safresh1 '=' => sub { ref($_[0]) -> _copy($_[0]); }, 2525759b3d2Safresh1 2535759b3d2Safresh1 ; 2545759b3d2Safresh1 2555759b3d2Safresh1sub _new { 2565759b3d2Safresh1 croak "@{[(caller 0)[3]]} method not implemented"; 2575759b3d2Safresh1} 2585759b3d2Safresh1 2595759b3d2Safresh1sub _zero { 2605759b3d2Safresh1 my $class = shift; 2615759b3d2Safresh1 return $class -> _new("0"); 2625759b3d2Safresh1} 2635759b3d2Safresh1 2645759b3d2Safresh1sub _one { 2655759b3d2Safresh1 my $class = shift; 2665759b3d2Safresh1 return $class -> _new("1"); 2675759b3d2Safresh1} 2685759b3d2Safresh1 2695759b3d2Safresh1sub _two { 2705759b3d2Safresh1 my $class = shift; 2715759b3d2Safresh1 return $class -> _new("2"); 2725759b3d2Safresh1 2735759b3d2Safresh1} 2745759b3d2Safresh1sub _ten { 2755759b3d2Safresh1 my $class = shift; 2765759b3d2Safresh1 return $class -> _new("10"); 2775759b3d2Safresh1} 2785759b3d2Safresh1 2795759b3d2Safresh1sub _1ex { 2805759b3d2Safresh1 my ($class, $exp) = @_; 2815759b3d2Safresh1 $exp = $class -> _num($exp) if ref($exp); 2825759b3d2Safresh1 return $class -> _new("1" . ("0" x $exp)); 2835759b3d2Safresh1} 2845759b3d2Safresh1 2855759b3d2Safresh1sub _copy { 2865759b3d2Safresh1 my ($class, $x) = @_; 2875759b3d2Safresh1 return $class -> _new($class -> _str($x)); 2885759b3d2Safresh1} 2895759b3d2Safresh1 2905759b3d2Safresh1# catch and throw away 2915759b3d2Safresh1sub import { } 2925759b3d2Safresh1 2935759b3d2Safresh1############################################################################## 2945759b3d2Safresh1# convert back to string and number 2955759b3d2Safresh1 2965759b3d2Safresh1sub _str { 2975759b3d2Safresh1 # Convert number from internal base 1eN format to string format. Internal 2985759b3d2Safresh1 # format is always normalized, i.e., no leading zeros. 2995759b3d2Safresh1 croak "@{[(caller 0)[3]]} method not implemented"; 3005759b3d2Safresh1} 3015759b3d2Safresh1 3025759b3d2Safresh1sub _num { 3035759b3d2Safresh1 my ($class, $x) = @_; 3045759b3d2Safresh1 0 + $class -> _str($x); 3055759b3d2Safresh1} 3065759b3d2Safresh1 3075759b3d2Safresh1############################################################################## 3085759b3d2Safresh1# actual math code 3095759b3d2Safresh1 3105759b3d2Safresh1sub _add { 3115759b3d2Safresh1 croak "@{[(caller 0)[3]]} method not implemented"; 3125759b3d2Safresh1} 3135759b3d2Safresh1 3145759b3d2Safresh1sub _sub { 3155759b3d2Safresh1 croak "@{[(caller 0)[3]]} method not implemented"; 3165759b3d2Safresh1} 3175759b3d2Safresh1 3185759b3d2Safresh1sub _mul { 3195759b3d2Safresh1 my ($class, $x, $y) = @_; 3205759b3d2Safresh1 my $sum = $class -> _zero(); 3215759b3d2Safresh1 my $i = $class -> _zero(); 3225759b3d2Safresh1 while ($class -> _acmp($i, $y) < 0) { 3235759b3d2Safresh1 $sum = $class -> _add($sum, $x); 3245759b3d2Safresh1 $i = $class -> _inc($i); 3255759b3d2Safresh1 } 3265759b3d2Safresh1 return $sum; 3275759b3d2Safresh1} 3285759b3d2Safresh1 3295759b3d2Safresh1sub _div { 3305759b3d2Safresh1 my ($class, $x, $y) = @_; 3315759b3d2Safresh1 3325759b3d2Safresh1 croak "@{[(caller 0)[3]]} requires non-zero divisor" 3335759b3d2Safresh1 if $class -> _is_zero($y); 3345759b3d2Safresh1 3355759b3d2Safresh1 my $r = $class -> _copy($x); 3365759b3d2Safresh1 my $q = $class -> _zero(); 3375759b3d2Safresh1 while ($class -> _acmp($r, $y) >= 0) { 3385759b3d2Safresh1 $q = $class -> _inc($q); 3395759b3d2Safresh1 $r = $class -> _sub($r, $y); 3405759b3d2Safresh1 } 3415759b3d2Safresh1 3425759b3d2Safresh1 return $q, $r if wantarray; 3435759b3d2Safresh1 return $q; 3445759b3d2Safresh1} 3455759b3d2Safresh1 3465759b3d2Safresh1sub _inc { 3475759b3d2Safresh1 my ($class, $x) = @_; 3485759b3d2Safresh1 $class -> _add($x, $class -> _one()); 3495759b3d2Safresh1} 3505759b3d2Safresh1 3515759b3d2Safresh1sub _dec { 3525759b3d2Safresh1 my ($class, $x) = @_; 3535759b3d2Safresh1 $class -> _sub($x, $class -> _one()); 3545759b3d2Safresh1} 3555759b3d2Safresh1 356256a93a4Safresh1# Signed addition. If the flag is false, $xa might be modified, but not $ya. If 357256a93a4Safresh1# the false is true, $ya might be modified, but not $xa. 358256a93a4Safresh1 359256a93a4Safresh1sub _sadd { 360256a93a4Safresh1 my $class = shift; 361256a93a4Safresh1 my ($xa, $xs, $ya, $ys, $flag) = @_; 362256a93a4Safresh1 my ($za, $zs); 363256a93a4Safresh1 364256a93a4Safresh1 # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) 365256a93a4Safresh1 366256a93a4Safresh1 if ($xs eq $ys) { 367256a93a4Safresh1 if ($flag) { 368256a93a4Safresh1 $za = $class -> _add($ya, $xa); 369256a93a4Safresh1 } else { 370256a93a4Safresh1 $za = $class -> _add($xa, $ya); 371256a93a4Safresh1 } 372256a93a4Safresh1 $zs = $class -> _is_zero($za) ? '+' : $xs; 373256a93a4Safresh1 return $za, $zs; 374256a93a4Safresh1 } 375256a93a4Safresh1 376256a93a4Safresh1 my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y) 377256a93a4Safresh1 378256a93a4Safresh1 if ($acmp == 0) { # x = -y or -x = y 379256a93a4Safresh1 $za = $class -> _zero(); 380256a93a4Safresh1 $zs = '+'; 381256a93a4Safresh1 return $za, $zs; 382256a93a4Safresh1 } 383256a93a4Safresh1 384256a93a4Safresh1 if ($acmp > 0) { # abs(x) > abs(y) 385256a93a4Safresh1 $za = $class -> _sub($xa, $ya, $flag); 386256a93a4Safresh1 $zs = $xs; 387256a93a4Safresh1 } else { # abs(x) < abs(y) 388256a93a4Safresh1 $za = $class -> _sub($ya, $xa, !$flag); 389256a93a4Safresh1 $zs = $ys; 390256a93a4Safresh1 } 391256a93a4Safresh1 return $za, $zs; 392256a93a4Safresh1} 393256a93a4Safresh1 394256a93a4Safresh1# Signed subtraction. If the flag is false, $xa might be modified, but not $ya. 395256a93a4Safresh1# If the false is true, $ya might be modified, but not $xa. 396256a93a4Safresh1 397256a93a4Safresh1sub _ssub { 398256a93a4Safresh1 my $class = shift; 399256a93a4Safresh1 my ($xa, $xs, $ya, $ys, $flag) = @_; 400256a93a4Safresh1 401256a93a4Safresh1 # Swap sign of second operand and let _sadd() do the job. 402256a93a4Safresh1 $ys = $ys eq '+' ? '-' : '+'; 403256a93a4Safresh1 $class -> _sadd($xa, $xs, $ya, $ys, $flag); 404256a93a4Safresh1} 405256a93a4Safresh1 4065759b3d2Safresh1############################################################################## 4075759b3d2Safresh1# testing 4085759b3d2Safresh1 4095759b3d2Safresh1sub _acmp { 4105759b3d2Safresh1 # Compare two (absolute) values. Return -1, 0, or 1. 4115759b3d2Safresh1 my ($class, $x, $y) = @_; 4125759b3d2Safresh1 my $xstr = $class -> _str($x); 4135759b3d2Safresh1 my $ystr = $class -> _str($y); 4145759b3d2Safresh1 4155759b3d2Safresh1 length($xstr) <=> length($ystr) || $xstr cmp $ystr; 4165759b3d2Safresh1} 4175759b3d2Safresh1 4185759b3d2Safresh1sub _len { 4195759b3d2Safresh1 my ($class, $x) = @_; 4205759b3d2Safresh1 CORE::length($class -> _str($x)); 4215759b3d2Safresh1} 4225759b3d2Safresh1 4235759b3d2Safresh1sub _alen { 4245759b3d2Safresh1 my ($class, $x) = @_; 4255759b3d2Safresh1 $class -> _len($x); 4265759b3d2Safresh1} 4275759b3d2Safresh1 4285759b3d2Safresh1sub _digit { 4295759b3d2Safresh1 my ($class, $x, $n) = @_; 4305759b3d2Safresh1 substr($class ->_str($x), -($n+1), 1); 4315759b3d2Safresh1} 4325759b3d2Safresh1 433de8cc8edSafresh1sub _digitsum { 434de8cc8edSafresh1 my ($class, $x) = @_; 435de8cc8edSafresh1 436de8cc8edSafresh1 my $len = $class -> _len($x); 437de8cc8edSafresh1 my $sum = $class -> _zero(); 438de8cc8edSafresh1 for (my $i = 0 ; $i < $len ; ++$i) { 439de8cc8edSafresh1 my $digit = $class -> _digit($x, $i); 440de8cc8edSafresh1 $digit = $class -> _new($digit); 441de8cc8edSafresh1 $sum = $class -> _add($sum, $digit); 442de8cc8edSafresh1 } 443de8cc8edSafresh1 444de8cc8edSafresh1 return $sum; 445de8cc8edSafresh1} 446de8cc8edSafresh1 4475759b3d2Safresh1sub _zeros { 4485759b3d2Safresh1 my ($class, $x) = @_; 4495759b3d2Safresh1 my $str = $class -> _str($x); 4505759b3d2Safresh1 $str =~ /[^0](0*)\z/ ? CORE::length($1) : 0; 4515759b3d2Safresh1} 4525759b3d2Safresh1 4535759b3d2Safresh1############################################################################## 4545759b3d2Safresh1# _is_* routines 4555759b3d2Safresh1 4565759b3d2Safresh1sub _is_zero { 4575759b3d2Safresh1 # return true if arg is zero 4585759b3d2Safresh1 my ($class, $x) = @_; 4595759b3d2Safresh1 $class -> _str($x) == 0; 4605759b3d2Safresh1} 4615759b3d2Safresh1 4625759b3d2Safresh1sub _is_even { 4635759b3d2Safresh1 # return true if arg is even 4645759b3d2Safresh1 my ($class, $x) = @_; 4655759b3d2Safresh1 substr($class -> _str($x), -1, 1) % 2 == 0; 4665759b3d2Safresh1} 4675759b3d2Safresh1 4685759b3d2Safresh1sub _is_odd { 4695759b3d2Safresh1 # return true if arg is odd 4705759b3d2Safresh1 my ($class, $x) = @_; 4715759b3d2Safresh1 substr($class -> _str($x), -1, 1) % 2 != 0; 4725759b3d2Safresh1} 4735759b3d2Safresh1 4745759b3d2Safresh1sub _is_one { 4755759b3d2Safresh1 # return true if arg is one 4765759b3d2Safresh1 my ($class, $x) = @_; 4775759b3d2Safresh1 $class -> _str($x) == 1; 4785759b3d2Safresh1} 4795759b3d2Safresh1 4805759b3d2Safresh1sub _is_two { 4815759b3d2Safresh1 # return true if arg is two 4825759b3d2Safresh1 my ($class, $x) = @_; 4835759b3d2Safresh1 $class -> _str($x) == 2; 4845759b3d2Safresh1} 4855759b3d2Safresh1 4865759b3d2Safresh1sub _is_ten { 4875759b3d2Safresh1 # return true if arg is ten 4885759b3d2Safresh1 my ($class, $x) = @_; 4895759b3d2Safresh1 $class -> _str($x) == 10; 4905759b3d2Safresh1} 4915759b3d2Safresh1 4925759b3d2Safresh1############################################################################### 4935759b3d2Safresh1# check routine to test internal state for corruptions 4945759b3d2Safresh1 4955759b3d2Safresh1sub _check { 4965759b3d2Safresh1 # used by the test suite 4975759b3d2Safresh1 my ($class, $x) = @_; 4985759b3d2Safresh1 return "Input is undefined" unless defined $x; 4995759b3d2Safresh1 return "$x is not a reference" unless ref($x); 5005759b3d2Safresh1 return 0; 5015759b3d2Safresh1} 5025759b3d2Safresh1 5035759b3d2Safresh1############################################################################### 5045759b3d2Safresh1 5055759b3d2Safresh1sub _mod { 5065759b3d2Safresh1 # modulus 5075759b3d2Safresh1 my ($class, $x, $y) = @_; 5085759b3d2Safresh1 5095759b3d2Safresh1 croak "@{[(caller 0)[3]]} requires non-zero second operand" 5105759b3d2Safresh1 if $class -> _is_zero($y); 5115759b3d2Safresh1 5125759b3d2Safresh1 if ($class -> can('_div')) { 5135759b3d2Safresh1 $x = $class -> _copy($x); 5145759b3d2Safresh1 my ($q, $r) = $class -> _div($x, $y); 5155759b3d2Safresh1 return $r; 5165759b3d2Safresh1 } else { 5175759b3d2Safresh1 my $r = $class -> _copy($x); 5185759b3d2Safresh1 while ($class -> _acmp($r, $y) >= 0) { 5195759b3d2Safresh1 $r = $class -> _sub($r, $y); 5205759b3d2Safresh1 } 5215759b3d2Safresh1 return $r; 5225759b3d2Safresh1 } 5235759b3d2Safresh1} 5245759b3d2Safresh1 5255759b3d2Safresh1############################################################################## 5265759b3d2Safresh1# shifts 5275759b3d2Safresh1 5285759b3d2Safresh1sub _rsft { 5295759b3d2Safresh1 my ($class, $x, $n, $b) = @_; 5305759b3d2Safresh1 $b = $class -> _new($b) unless ref $b; 5315759b3d2Safresh1 return scalar $class -> _div($x, $class -> _pow($class -> _copy($b), $n)); 5325759b3d2Safresh1} 5335759b3d2Safresh1 5345759b3d2Safresh1sub _lsft { 5355759b3d2Safresh1 my ($class, $x, $n, $b) = @_; 5365759b3d2Safresh1 $b = $class -> _new($b) unless ref $b; 5375759b3d2Safresh1 return $class -> _mul($x, $class -> _pow($class -> _copy($b), $n)); 5385759b3d2Safresh1} 5395759b3d2Safresh1 5405759b3d2Safresh1sub _pow { 5415759b3d2Safresh1 # power of $x to $y 5425759b3d2Safresh1 my ($class, $x, $y) = @_; 5435759b3d2Safresh1 5445759b3d2Safresh1 if ($class -> _is_zero($y)) { 5455759b3d2Safresh1 return $class -> _one(); # y == 0 => x => 1 5465759b3d2Safresh1 } 5475759b3d2Safresh1 5485759b3d2Safresh1 if (($class -> _is_one($x)) || # x == 1 5495759b3d2Safresh1 ($class -> _is_one($y))) # or y == 1 5505759b3d2Safresh1 { 5515759b3d2Safresh1 return $x; 5525759b3d2Safresh1 } 5535759b3d2Safresh1 5545759b3d2Safresh1 if ($class -> _is_zero($x)) { 5555759b3d2Safresh1 return $class -> _zero(); # 0 ** y => 0 (if not y <= 0) 5565759b3d2Safresh1 } 5575759b3d2Safresh1 5585759b3d2Safresh1 my $pow2 = $class -> _one(); 5595759b3d2Safresh1 5605759b3d2Safresh1 my $y_bin = $class -> _as_bin($y); 5615759b3d2Safresh1 $y_bin =~ s/^0b//; 5625759b3d2Safresh1 my $len = length($y_bin); 5635759b3d2Safresh1 5645759b3d2Safresh1 while (--$len > 0) { 5655759b3d2Safresh1 $pow2 = $class -> _mul($pow2, $x) if substr($y_bin, $len, 1) eq '1'; 5665759b3d2Safresh1 $x = $class -> _mul($x, $x); 5675759b3d2Safresh1 } 5685759b3d2Safresh1 5695759b3d2Safresh1 $x = $class -> _mul($x, $pow2); 5705759b3d2Safresh1 return $x; 5715759b3d2Safresh1} 5725759b3d2Safresh1 5735759b3d2Safresh1sub _nok { 5745759b3d2Safresh1 # Return binomial coefficient (n over k). 5755759b3d2Safresh1 my ($class, $n, $k) = @_; 5765759b3d2Safresh1 5775759b3d2Safresh1 # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as 5785759b3d2Safresh1 # nok(n, n-k), to minimize the number if iterations in the loop. 5795759b3d2Safresh1 5805759b3d2Safresh1 { 5815759b3d2Safresh1 my $twok = $class -> _mul($class -> _two(), $class -> _copy($k)); 5825759b3d2Safresh1 if ($class -> _acmp($twok, $n) > 0) { 5835759b3d2Safresh1 $k = $class -> _sub($class -> _copy($n), $k); 5845759b3d2Safresh1 } 5855759b3d2Safresh1 } 5865759b3d2Safresh1 5875759b3d2Safresh1 # Example: 5885759b3d2Safresh1 # 5895759b3d2Safresh1 # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 5905759b3d2Safresh1 # | | = --------- = --------------- = --------- = ((5 * 6) / 2 * 7) / 3 5915759b3d2Safresh1 # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 5925759b3d2Safresh1 # 5935759b3d2Safresh1 # Equivalently, _nok(11, 5) is computed as 5945759b3d2Safresh1 # 5955759b3d2Safresh1 # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5 5965759b3d2Safresh1 5975759b3d2Safresh1 if ($class -> _is_zero($k)) { 5985759b3d2Safresh1 return $class -> _one(); 5995759b3d2Safresh1 } 6005759b3d2Safresh1 6015759b3d2Safresh1 # Make a copy of the original n, in case the subclass modifies n in-place. 6025759b3d2Safresh1 6035759b3d2Safresh1 my $n_orig = $class -> _copy($n); 6045759b3d2Safresh1 6055759b3d2Safresh1 # n = 5, f = 6, d = 2 (cf. example above) 6065759b3d2Safresh1 6075759b3d2Safresh1 $n = $class -> _sub($n, $k); 6085759b3d2Safresh1 $n = $class -> _inc($n); 6095759b3d2Safresh1 6105759b3d2Safresh1 my $f = $class -> _copy($n); 6115759b3d2Safresh1 $f = $class -> _inc($f); 6125759b3d2Safresh1 6135759b3d2Safresh1 my $d = $class -> _two(); 6145759b3d2Safresh1 6155759b3d2Safresh1 # while f <= n (the original n, that is) ... 6165759b3d2Safresh1 6175759b3d2Safresh1 while ($class -> _acmp($f, $n_orig) <= 0) { 6185759b3d2Safresh1 $n = $class -> _mul($n, $f); 6195759b3d2Safresh1 $n = $class -> _div($n, $d); 6205759b3d2Safresh1 $f = $class -> _inc($f); 6215759b3d2Safresh1 $d = $class -> _inc($d); 6225759b3d2Safresh1 } 6235759b3d2Safresh1 6245759b3d2Safresh1 return $n; 6255759b3d2Safresh1} 6265759b3d2Safresh1 627256a93a4Safresh1#sub _fac { 628256a93a4Safresh1# # factorial 629256a93a4Safresh1# my ($class, $x) = @_; 630256a93a4Safresh1# 631256a93a4Safresh1# my $two = $class -> _two(); 632256a93a4Safresh1# 633256a93a4Safresh1# if ($class -> _acmp($x, $two) < 0) { 634256a93a4Safresh1# return $class -> _one(); 635256a93a4Safresh1# } 636256a93a4Safresh1# 637256a93a4Safresh1# my $i = $class -> _copy($x); 638256a93a4Safresh1# while ($class -> _acmp($i, $two) > 0) { 639256a93a4Safresh1# $i = $class -> _dec($i); 640256a93a4Safresh1# $x = $class -> _mul($x, $i); 641256a93a4Safresh1# } 642256a93a4Safresh1# 643256a93a4Safresh1# return $x; 644256a93a4Safresh1#} 645256a93a4Safresh1 6465759b3d2Safresh1sub _fac { 6475759b3d2Safresh1 # factorial 6485759b3d2Safresh1 my ($class, $x) = @_; 6495759b3d2Safresh1 650256a93a4Safresh1 # This is an implementation of the split recursive algorithm. See 651256a93a4Safresh1 # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html 652256a93a4Safresh1 653256a93a4Safresh1 my $p = $class -> _one(); 654256a93a4Safresh1 my $r = $class -> _one(); 6555759b3d2Safresh1 my $two = $class -> _two(); 6565759b3d2Safresh1 657256a93a4Safresh1 my ($log2n) = $class -> _log_int($class -> _copy($x), $two); 658256a93a4Safresh1 my $h = $class -> _zero(); 659256a93a4Safresh1 my $shift = $class -> _zero(); 660256a93a4Safresh1 my $k = $class -> _one(); 6615759b3d2Safresh1 662256a93a4Safresh1 while ($class -> _acmp($h, $x)) { 663256a93a4Safresh1 $shift = $class -> _add($shift, $h); 664256a93a4Safresh1 $h = $class -> _rsft($class -> _copy($x), $log2n, $two); 665256a93a4Safresh1 $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n); 666256a93a4Safresh1 my $high = $class -> _copy($h); 667256a93a4Safresh1 $high = $class -> _dec($high) if $class -> _is_even($h); 668256a93a4Safresh1 while ($class -> _acmp($k, $high)) { 669256a93a4Safresh1 $k = $class -> _add($k, $two); 670256a93a4Safresh1 $p = $class -> _mul($p, $k); 6715759b3d2Safresh1 } 672256a93a4Safresh1 $r = $class -> _mul($r, $p); 673256a93a4Safresh1 } 674256a93a4Safresh1 return $class -> _lsft($r, $shift, $two); 6755759b3d2Safresh1} 6765759b3d2Safresh1 6775759b3d2Safresh1sub _dfac { 6785759b3d2Safresh1 # double factorial 6795759b3d2Safresh1 my ($class, $x) = @_; 6805759b3d2Safresh1 6815759b3d2Safresh1 my $two = $class -> _two(); 6825759b3d2Safresh1 6835759b3d2Safresh1 if ($class -> _acmp($x, $two) < 0) { 6845759b3d2Safresh1 return $class -> _one(); 6855759b3d2Safresh1 } 6865759b3d2Safresh1 6875759b3d2Safresh1 my $i = $class -> _copy($x); 6885759b3d2Safresh1 while ($class -> _acmp($i, $two) > 0) { 6895759b3d2Safresh1 $i = $class -> _sub($i, $two); 6905759b3d2Safresh1 $x = $class -> _mul($x, $i); 6915759b3d2Safresh1 } 6925759b3d2Safresh1 6935759b3d2Safresh1 return $x; 6945759b3d2Safresh1} 6955759b3d2Safresh1 6965759b3d2Safresh1sub _log_int { 6975759b3d2Safresh1 # calculate integer log of $x to base $base 6985759b3d2Safresh1 # calculate integer log of $x to base $base 6995759b3d2Safresh1 # ref to array, ref to array - return ref to array 7005759b3d2Safresh1 my ($class, $x, $base) = @_; 7015759b3d2Safresh1 7025759b3d2Safresh1 # X == 0 => NaN 7035759b3d2Safresh1 return if $class -> _is_zero($x); 7045759b3d2Safresh1 7055759b3d2Safresh1 $base = $class -> _new(2) unless defined($base); 7065759b3d2Safresh1 $base = $class -> _new($base) unless ref($base); 7075759b3d2Safresh1 7085759b3d2Safresh1 # BASE 0 or 1 => NaN 7095759b3d2Safresh1 return if $class -> _is_zero($base) || $class -> _is_one($base); 7105759b3d2Safresh1 7115759b3d2Safresh1 # X == 1 => 0 (is exact) 7125759b3d2Safresh1 if ($class -> _is_one($x)) { 713*5486feefSafresh1 return $class -> _zero(), 1 if wantarray; 714*5486feefSafresh1 return $class -> _zero(); 7155759b3d2Safresh1 } 7165759b3d2Safresh1 7175759b3d2Safresh1 my $cmp = $class -> _acmp($x, $base); 7185759b3d2Safresh1 7195759b3d2Safresh1 # X == BASE => 1 (is exact) 7205759b3d2Safresh1 if ($cmp == 0) { 721*5486feefSafresh1 return $class -> _one(), 1 if wantarray; 722*5486feefSafresh1 return $class -> _one(); 7235759b3d2Safresh1 } 7245759b3d2Safresh1 7255759b3d2Safresh1 # 1 < X < BASE => 0 (is truncated) 7265759b3d2Safresh1 if ($cmp < 0) { 727*5486feefSafresh1 return $class -> _zero(), 0 if wantarray; 728*5486feefSafresh1 return $class -> _zero(); 7295759b3d2Safresh1 } 7305759b3d2Safresh1 7315759b3d2Safresh1 my $y; 7325759b3d2Safresh1 7335759b3d2Safresh1 # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be) 7345759b3d2Safresh1 # = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10)) 7355759b3d2Safresh1 7365759b3d2Safresh1 { 7375759b3d2Safresh1 my $x_str = $class -> _str($x); 7385759b3d2Safresh1 my $b_str = $class -> _str($base); 7395759b3d2Safresh1 my $xm = "." . $x_str; 7405759b3d2Safresh1 my $bm = "." . $b_str; 7415759b3d2Safresh1 my $xe = length($x_str); 7425759b3d2Safresh1 my $be = length($b_str); 7435759b3d2Safresh1 my $log10 = log(10); 7445759b3d2Safresh1 my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10)); 7455759b3d2Safresh1 $y = $class -> _new($guess); 7465759b3d2Safresh1 } 7475759b3d2Safresh1 7485759b3d2Safresh1 my $trial = $class -> _pow($class -> _copy($base), $y); 7495759b3d2Safresh1 my $acmp = $class -> _acmp($trial, $x); 7505759b3d2Safresh1 7515759b3d2Safresh1 # Too small? 7525759b3d2Safresh1 7535759b3d2Safresh1 while ($acmp < 0) { 7545759b3d2Safresh1 $trial = $class -> _mul($trial, $base); 7555759b3d2Safresh1 $y = $class -> _inc($y); 7565759b3d2Safresh1 $acmp = $class -> _acmp($trial, $x); 7575759b3d2Safresh1 } 7585759b3d2Safresh1 7595759b3d2Safresh1 # Too big? 7605759b3d2Safresh1 7615759b3d2Safresh1 while ($acmp > 0) { 7625759b3d2Safresh1 $trial = $class -> _div($trial, $base); 7635759b3d2Safresh1 $y = $class -> _dec($y); 7645759b3d2Safresh1 $acmp = $class -> _acmp($trial, $x); 7655759b3d2Safresh1 } 7665759b3d2Safresh1 767*5486feefSafresh1 return wantarray ? ($y, 1) : $y if $acmp == 0; # result is exact 768*5486feefSafresh1 return wantarray ? ($y, 0) : $y; # result is too small 769*5486feefSafresh1} 770*5486feefSafresh1 771*5486feefSafresh1sub _ilog2 { 772*5486feefSafresh1 my ($class, $x) = @_; 773*5486feefSafresh1 774*5486feefSafresh1 return if $class -> _is_zero($x); 775*5486feefSafresh1 776*5486feefSafresh1 my $str = $class -> _to_hex($x); 777*5486feefSafresh1 778*5486feefSafresh1 # First do the bits in all but the most significant hex digit. 779*5486feefSafresh1 780*5486feefSafresh1 my $y = $class -> _new(length($str) - 1); 781*5486feefSafresh1 $y = $class -> _mul($y, $class -> _new(4)); 782*5486feefSafresh1 783*5486feefSafresh1 # Now add the number of bits in the most significant hex digit. 784*5486feefSafresh1 785*5486feefSafresh1 my $n = int log(hex(substr($str, 0, 1))) / log(2); 786*5486feefSafresh1 $y = $class -> _add($y, $class -> _new($n)); 787*5486feefSafresh1 return $y unless wantarray; 788*5486feefSafresh1 789*5486feefSafresh1 my $pow2 = $class -> _lsft($class -> _one(), $y, 2); 790*5486feefSafresh1 my $is_exact = $class -> _acmp($x, $pow2) == 0 ? 1 : 0; 791*5486feefSafresh1 return $y, $is_exact; 792*5486feefSafresh1} 793*5486feefSafresh1 794*5486feefSafresh1sub _ilog10 { 795*5486feefSafresh1 my ($class, $x) = @_; 796*5486feefSafresh1 797*5486feefSafresh1 return if $class -> _is_zero($x); 798*5486feefSafresh1 799*5486feefSafresh1 my $str = $class -> _str($x); 800*5486feefSafresh1 my $len = length($str); 801*5486feefSafresh1 my $y = $class -> _new($len - 1); 802*5486feefSafresh1 return $y unless wantarray; 803*5486feefSafresh1 804*5486feefSafresh1 #my $pow10 = $class -> _1ex($y); 805*5486feefSafresh1 #my $is_exact = $class -> _acmp($x, $pow10) ? 1 : 0; 806*5486feefSafresh1 807*5486feefSafresh1 my $is_exact = $str =~ /^10*$/ ? 1 : 0; 808*5486feefSafresh1 return $y, $is_exact; 809*5486feefSafresh1} 810*5486feefSafresh1 811*5486feefSafresh1sub _clog2 { 812*5486feefSafresh1 my ($class, $x) = @_; 813*5486feefSafresh1 814*5486feefSafresh1 return if $class -> _is_zero($x); 815*5486feefSafresh1 816*5486feefSafresh1 my $str = $class -> _to_hex($x); 817*5486feefSafresh1 818*5486feefSafresh1 # First do the bits in all but the most significant hex digit. 819*5486feefSafresh1 820*5486feefSafresh1 my $y = $class -> _new(length($str) - 1); 821*5486feefSafresh1 $y = $class -> _mul($y, $class -> _new(4)); 822*5486feefSafresh1 823*5486feefSafresh1 # Now add the number of bits in the most significant hex digit. 824*5486feefSafresh1 825*5486feefSafresh1 my $n = int log(hex(substr($str, 0, 1))) / log(2); 826*5486feefSafresh1 $y = $class -> _add($y, $class -> _new($n)); 827*5486feefSafresh1 828*5486feefSafresh1 # $y is now 1 too small unless $y is an exact power of 2. 829*5486feefSafresh1 830*5486feefSafresh1 my $pow2 = $class -> _lsft($class -> _one(), $y, 2); 831*5486feefSafresh1 my $is_exact = $class -> _acmp($x, $pow2) == 0 ? 1 : 0; 832*5486feefSafresh1 $y = $class -> _inc($y) if $is_exact == 0; 833*5486feefSafresh1 return $y, $is_exact if wantarray; 834*5486feefSafresh1 return $y; 835*5486feefSafresh1} 836*5486feefSafresh1 837*5486feefSafresh1sub _clog10 { 838*5486feefSafresh1 my ($class, $x) = @_; 839*5486feefSafresh1 840*5486feefSafresh1 return if $class -> _is_zero($x); 841*5486feefSafresh1 842*5486feefSafresh1 my $str = $class -> _str($x); 843*5486feefSafresh1 my $len = length($str); 844*5486feefSafresh1 845*5486feefSafresh1 if ($str =~ /^10*$/) { 846*5486feefSafresh1 my $y = $class -> _new($len - 1); 847*5486feefSafresh1 return $y, 1 if wantarray; 848*5486feefSafresh1 return $y; 849*5486feefSafresh1 } 850*5486feefSafresh1 851*5486feefSafresh1 my $y = $class -> _new($len); 852*5486feefSafresh1 return $y, 0 if wantarray; 853*5486feefSafresh1 return $y; 8545759b3d2Safresh1} 8555759b3d2Safresh1 8565759b3d2Safresh1sub _sqrt { 8575759b3d2Safresh1 # square-root of $y in place 8585759b3d2Safresh1 my ($class, $y) = @_; 8595759b3d2Safresh1 8605759b3d2Safresh1 return $y if $class -> _is_zero($y); 8615759b3d2Safresh1 8625759b3d2Safresh1 my $y_str = $class -> _str($y); 8635759b3d2Safresh1 my $y_len = length($y_str); 8645759b3d2Safresh1 8655759b3d2Safresh1 # Compute the guess $x. 8665759b3d2Safresh1 8675759b3d2Safresh1 my $xm; 8685759b3d2Safresh1 my $xe; 8695759b3d2Safresh1 if ($y_len % 2 == 0) { 8705759b3d2Safresh1 $xm = sqrt("." . $y_str); 8715759b3d2Safresh1 $xe = $y_len / 2; 8725759b3d2Safresh1 $xm = sprintf "%.0f", int($xm * 1e15); 8735759b3d2Safresh1 $xe -= 15; 8745759b3d2Safresh1 } else { 8755759b3d2Safresh1 $xm = sqrt(".0" . $y_str); 8765759b3d2Safresh1 $xe = ($y_len + 1) / 2; 8775759b3d2Safresh1 $xm = sprintf "%.0f", int($xm * 1e16); 8785759b3d2Safresh1 $xe -= 16; 8795759b3d2Safresh1 } 8805759b3d2Safresh1 8815759b3d2Safresh1 my $x; 8825759b3d2Safresh1 if ($xe < 0) { 8835759b3d2Safresh1 $x = substr $xm, 0, length($xm) + $xe; 8845759b3d2Safresh1 } else { 8855759b3d2Safresh1 $x = $xm . ("0" x $xe); 8865759b3d2Safresh1 } 8875759b3d2Safresh1 8885759b3d2Safresh1 $x = $class -> _new($x); 8895759b3d2Safresh1 8905759b3d2Safresh1 # Newton's method for computing square root of y 8915759b3d2Safresh1 # 8925759b3d2Safresh1 # x(i+1) = x(i) - f(x(i)) / f'(x(i)) 8935759b3d2Safresh1 # = x(i) - (x(i)^2 - y) / (2 * x(i)) # use if x(i)^2 > y 894256a93a4Safresh1 # = x(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y 8955759b3d2Safresh1 8965759b3d2Safresh1 # Determine if x, our guess, is too small, correct, or too large. 8975759b3d2Safresh1 8985759b3d2Safresh1 my $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 8995759b3d2Safresh1 my $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 9005759b3d2Safresh1 9015759b3d2Safresh1 # Only assign a value to this variable if we will be using it. 9025759b3d2Safresh1 9035759b3d2Safresh1 my $two; 9045759b3d2Safresh1 $two = $class -> _two() if $acmp != 0; 9055759b3d2Safresh1 9065759b3d2Safresh1 # If x is too small, do one iteration of Newton's method. Since the 9075759b3d2Safresh1 # function f(x) = x^2 - y is concave and monotonically increasing, the next 9085759b3d2Safresh1 # guess for x will either be correct or too large. 9095759b3d2Safresh1 9105759b3d2Safresh1 if ($acmp < 0) { 9115759b3d2Safresh1 9125759b3d2Safresh1 # x(i+1) = x(i) + (y - x(i)^2) / (2 * x(i)) 9135759b3d2Safresh1 9145759b3d2Safresh1 my $numer = $class -> _sub($class -> _copy($y), $xsq); # y - x(i)^2 9155759b3d2Safresh1 my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i) 9165759b3d2Safresh1 my $delta = $class -> _div($numer, $denom); 9175759b3d2Safresh1 9185759b3d2Safresh1 unless ($class -> _is_zero($delta)) { 9195759b3d2Safresh1 $x = $class -> _add($x, $delta); 9205759b3d2Safresh1 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 9215759b3d2Safresh1 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 9225759b3d2Safresh1 } 9235759b3d2Safresh1 } 9245759b3d2Safresh1 9255759b3d2Safresh1 # If our guess for x is too large, apply Newton's method repeatedly until 9265759b3d2Safresh1 # we either have got the correct value, or the delta is zero. 9275759b3d2Safresh1 9285759b3d2Safresh1 while ($acmp > 0) { 9295759b3d2Safresh1 9305759b3d2Safresh1 # x(i+1) = x(i) - (x(i)^2 - y) / (2 * x(i)) 9315759b3d2Safresh1 9325759b3d2Safresh1 my $numer = $class -> _sub($xsq, $y); # x(i)^2 - y 9335759b3d2Safresh1 my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i) 9345759b3d2Safresh1 my $delta = $class -> _div($numer, $denom); 9355759b3d2Safresh1 last if $class -> _is_zero($delta); 9365759b3d2Safresh1 9375759b3d2Safresh1 $x = $class -> _sub($x, $delta); 9385759b3d2Safresh1 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 9395759b3d2Safresh1 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 9405759b3d2Safresh1 } 9415759b3d2Safresh1 9425759b3d2Safresh1 # When the delta is zero, our value for x might still be too large. We 9435759b3d2Safresh1 # require that the outout is either exact or too small (i.e., rounded down 9445759b3d2Safresh1 # to the nearest integer), so do a final check. 9455759b3d2Safresh1 9465759b3d2Safresh1 while ($acmp > 0) { 9475759b3d2Safresh1 $x = $class -> _dec($x); 9485759b3d2Safresh1 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 9495759b3d2Safresh1 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 9505759b3d2Safresh1 } 9515759b3d2Safresh1 9525759b3d2Safresh1 return $x; 9535759b3d2Safresh1} 9545759b3d2Safresh1 9555759b3d2Safresh1sub _root { 9565759b3d2Safresh1 my ($class, $y, $n) = @_; 9575759b3d2Safresh1 9585759b3d2Safresh1 return $y if $class -> _is_zero($y) || $class -> _is_one($y) || 9595759b3d2Safresh1 $class -> _is_one($n); 9605759b3d2Safresh1 9615759b3d2Safresh1 # If y <= n, the result is always (truncated to) 1. 9625759b3d2Safresh1 9635759b3d2Safresh1 return $class -> _one() if $class -> _acmp($y, $n) <= 0; 9645759b3d2Safresh1 9655759b3d2Safresh1 # Compute the initial guess x of y^(1/n). When n is large, Newton's method 9665759b3d2Safresh1 # converges slowly if the "guess" (initial value) is poor, so we need a 9675759b3d2Safresh1 # good guess. It the guess is too small, the next guess will be too large, 9685759b3d2Safresh1 # and from then on all guesses are too large. 9695759b3d2Safresh1 9705759b3d2Safresh1 my $DEBUG = 0; 9715759b3d2Safresh1 9725759b3d2Safresh1 # Split y into mantissa and exponent in base 10, so that 9735759b3d2Safresh1 # 9745759b3d2Safresh1 # y = xm * 10^xe, where 0 < xm < 1 and xe is an integer 9755759b3d2Safresh1 9765759b3d2Safresh1 my $y_str = $class -> _str($y); 9775759b3d2Safresh1 my $ym = "." . $y_str; 9785759b3d2Safresh1 my $ye = length($y_str); 9795759b3d2Safresh1 9805759b3d2Safresh1 # From this compute the approximate base 10 logarithm of y 9815759b3d2Safresh1 # 9825759b3d2Safresh1 # log_10(y) = log_10(ym) + log_10(ye^10) 9835759b3d2Safresh1 # = log(ym)/log(10) + ye 9845759b3d2Safresh1 9855759b3d2Safresh1 my $log10y = log($ym) / log(10) + $ye; 9865759b3d2Safresh1 9875759b3d2Safresh1 # And from this compute the approximate base 10 logarithm of x, where 9885759b3d2Safresh1 # x = y^(1/n) 9895759b3d2Safresh1 # 9905759b3d2Safresh1 # log_10(x) = log_10(y)/n 9915759b3d2Safresh1 9925759b3d2Safresh1 my $log10x = $log10y / $class -> _num($n); 9935759b3d2Safresh1 9945759b3d2Safresh1 # From this compute xm and xe, the mantissa and exponent (in base 10) of x, 9955759b3d2Safresh1 # where 1 < xm <= 10 and xe is an integer. 9965759b3d2Safresh1 9975759b3d2Safresh1 my $xe = int $log10x; 9985759b3d2Safresh1 my $xm = 10 ** ($log10x - $xe); 9995759b3d2Safresh1 10005759b3d2Safresh1 # Scale the mantissa and exponent to increase the integer part of ym, which 10015759b3d2Safresh1 # gives us better accuracy. 10025759b3d2Safresh1 10035759b3d2Safresh1 if ($DEBUG) { 10045759b3d2Safresh1 print "\n"; 10055759b3d2Safresh1 print "y_str = $y_str\n"; 10065759b3d2Safresh1 print "ym = $ym\n"; 10075759b3d2Safresh1 print "ye = $ye\n"; 10085759b3d2Safresh1 print "log10y = $log10y\n"; 10095759b3d2Safresh1 print "log10x = $log10x\n"; 10105759b3d2Safresh1 print "xm = $xm\n"; 10115759b3d2Safresh1 print "xe = $xe\n"; 10125759b3d2Safresh1 } 10135759b3d2Safresh1 10145759b3d2Safresh1 my $d = $xe < 15 ? $xe : 15; 10155759b3d2Safresh1 $xm *= 10 ** $d; 10165759b3d2Safresh1 $xe -= $d; 10175759b3d2Safresh1 10185759b3d2Safresh1 if ($DEBUG) { 10195759b3d2Safresh1 print "\n"; 10205759b3d2Safresh1 print "xm = $xm\n"; 10215759b3d2Safresh1 print "xe = $xe\n"; 10225759b3d2Safresh1 } 10235759b3d2Safresh1 10245759b3d2Safresh1 # If the mantissa is not an integer, round up to nearest integer, and then 10255759b3d2Safresh1 # convert the number to a string. It is important to always round up due to 10265759b3d2Safresh1 # how Newton's method behaves in this case. If the initial guess is too 10275759b3d2Safresh1 # small, the next guess will be too large, after which every succeeding 10285759b3d2Safresh1 # guess converges the correct value from above. Now, if the initial guess 10295759b3d2Safresh1 # is too small and n is large, the next guess will be much too large and 10305759b3d2Safresh1 # require a large number of iterations to get close to the solution. 10315759b3d2Safresh1 # Because of this, we are likely to find the solution faster if we make 10325759b3d2Safresh1 # sure the initial guess is not too small. 10335759b3d2Safresh1 10345759b3d2Safresh1 my $xm_int = int($xm); 10355759b3d2Safresh1 my $x_str = sprintf '%.0f', $xm > $xm_int ? $xm_int + 1 : $xm_int; 10365759b3d2Safresh1 $x_str .= "0" x $xe; 10375759b3d2Safresh1 10385759b3d2Safresh1 my $x = $class -> _new($x_str); 10395759b3d2Safresh1 10405759b3d2Safresh1 if ($DEBUG) { 10415759b3d2Safresh1 print "xm = $xm\n"; 10425759b3d2Safresh1 print "xe = $xe\n"; 10435759b3d2Safresh1 print "\n"; 10445759b3d2Safresh1 print "x_str = $x_str (initial guess)\n"; 10455759b3d2Safresh1 print "\n"; 10465759b3d2Safresh1 } 10475759b3d2Safresh1 10485759b3d2Safresh1 # Use Newton's method for computing n'th root of y. 10495759b3d2Safresh1 # 10505759b3d2Safresh1 # x(i+1) = x(i) - f(x(i)) / f'(x(i)) 10515759b3d2Safresh1 # = x(i) - (x(i)^n - y) / (n * x(i)^(n-1)) # use if x(i)^n > y 10525759b3d2Safresh1 # = x(i) + (y - x(i)^n) / (n * x(i)^(n-1)) # use if x(i)^n < y 10535759b3d2Safresh1 10545759b3d2Safresh1 # Determine if x, our guess, is too small, correct, or too large. Rather 10555759b3d2Safresh1 # than computing x(i)^n and x(i)^(n-1) directly, compute x(i)^(n-1) and 10565759b3d2Safresh1 # then the same value multiplied by x. 10575759b3d2Safresh1 10585759b3d2Safresh1 my $nm1 = $class -> _dec($class -> _copy($n)); # n-1 10595759b3d2Safresh1 my $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 10605759b3d2Safresh1 my $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 10615759b3d2Safresh1 my $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 10625759b3d2Safresh1 10635759b3d2Safresh1 if ($DEBUG) { 10645759b3d2Safresh1 print "\n"; 10655759b3d2Safresh1 print "x = ", $class -> _str($x), "\n"; 10665759b3d2Safresh1 print "x^n = ", $class -> _str($xpown), "\n"; 10675759b3d2Safresh1 print "y = ", $class -> _str($y), "\n"; 10685759b3d2Safresh1 print "acmp = $acmp\n"; 10695759b3d2Safresh1 } 10705759b3d2Safresh1 10715759b3d2Safresh1 # If x is too small, do one iteration of Newton's method. Since the 10725759b3d2Safresh1 # function f(x) = x^n - y is concave and monotonically increasing, the next 10735759b3d2Safresh1 # guess for x will either be correct or too large. 10745759b3d2Safresh1 10755759b3d2Safresh1 if ($acmp < 0) { 10765759b3d2Safresh1 10775759b3d2Safresh1 # x(i+1) = x(i) + (y - x(i)^n) / (n * x(i)^(n-1)) 10785759b3d2Safresh1 10795759b3d2Safresh1 my $numer = $class -> _sub($class -> _copy($y), $xpown); # y - x(i)^n 10805759b3d2Safresh1 my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1) 10815759b3d2Safresh1 my $delta = $class -> _div($numer, $denom); 10825759b3d2Safresh1 10835759b3d2Safresh1 if ($DEBUG) { 10845759b3d2Safresh1 print "\n"; 10855759b3d2Safresh1 print "numer = ", $class -> _str($numer), "\n"; 10865759b3d2Safresh1 print "denom = ", $class -> _str($denom), "\n"; 10875759b3d2Safresh1 print "delta = ", $class -> _str($delta), "\n"; 10885759b3d2Safresh1 } 10895759b3d2Safresh1 10905759b3d2Safresh1 unless ($class -> _is_zero($delta)) { 10915759b3d2Safresh1 $x = $class -> _add($x, $delta); 10925759b3d2Safresh1 $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 10935759b3d2Safresh1 $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 10945759b3d2Safresh1 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 10955759b3d2Safresh1 10965759b3d2Safresh1 if ($DEBUG) { 10975759b3d2Safresh1 print "\n"; 10985759b3d2Safresh1 print "x = ", $class -> _str($x), "\n"; 10995759b3d2Safresh1 print "x^n = ", $class -> _str($xpown), "\n"; 11005759b3d2Safresh1 print "y = ", $class -> _str($y), "\n"; 11015759b3d2Safresh1 print "acmp = $acmp\n"; 11025759b3d2Safresh1 } 11035759b3d2Safresh1 } 11045759b3d2Safresh1 } 11055759b3d2Safresh1 11065759b3d2Safresh1 # If our guess for x is too large, apply Newton's method repeatedly until 11075759b3d2Safresh1 # we either have got the correct value, or the delta is zero. 11085759b3d2Safresh1 11095759b3d2Safresh1 while ($acmp > 0) { 11105759b3d2Safresh1 11115759b3d2Safresh1 # x(i+1) = x(i) - (x(i)^n - y) / (n * x(i)^(n-1)) 11125759b3d2Safresh1 11135759b3d2Safresh1 my $numer = $class -> _sub($class -> _copy($xpown), $y); # x(i)^n - y 11145759b3d2Safresh1 my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1) 11155759b3d2Safresh1 11165759b3d2Safresh1 if ($DEBUG) { 11175759b3d2Safresh1 print "numer = ", $class -> _str($numer), "\n"; 11185759b3d2Safresh1 print "denom = ", $class -> _str($denom), "\n"; 11195759b3d2Safresh1 } 11205759b3d2Safresh1 11215759b3d2Safresh1 my $delta = $class -> _div($numer, $denom); 11225759b3d2Safresh1 11235759b3d2Safresh1 if ($DEBUG) { 11245759b3d2Safresh1 print "delta = ", $class -> _str($delta), "\n"; 11255759b3d2Safresh1 } 11265759b3d2Safresh1 11275759b3d2Safresh1 last if $class -> _is_zero($delta); 11285759b3d2Safresh1 11295759b3d2Safresh1 $x = $class -> _sub($x, $delta); 11305759b3d2Safresh1 $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 11315759b3d2Safresh1 $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 11325759b3d2Safresh1 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 11335759b3d2Safresh1 11345759b3d2Safresh1 if ($DEBUG) { 11355759b3d2Safresh1 print "\n"; 11365759b3d2Safresh1 print "x = ", $class -> _str($x), "\n"; 11375759b3d2Safresh1 print "x^n = ", $class -> _str($xpown), "\n"; 11385759b3d2Safresh1 print "y = ", $class -> _str($y), "\n"; 11395759b3d2Safresh1 print "acmp = $acmp\n"; 11405759b3d2Safresh1 } 11415759b3d2Safresh1 } 11425759b3d2Safresh1 11435759b3d2Safresh1 # When the delta is zero, our value for x might still be too large. We 11445759b3d2Safresh1 # require that the outout is either exact or too small (i.e., rounded down 11455759b3d2Safresh1 # to the nearest integer), so do a final check. 11465759b3d2Safresh1 11475759b3d2Safresh1 while ($acmp > 0) { 11485759b3d2Safresh1 $x = $class -> _dec($x); 11495759b3d2Safresh1 $xpown = $class -> _pow($class -> _copy($x), $n); # x(i)^n 11505759b3d2Safresh1 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 11515759b3d2Safresh1 } 11525759b3d2Safresh1 11535759b3d2Safresh1 return $x; 11545759b3d2Safresh1} 11555759b3d2Safresh1 11565759b3d2Safresh1############################################################################## 11575759b3d2Safresh1# binary stuff 11585759b3d2Safresh1 11595759b3d2Safresh1sub _and { 11605759b3d2Safresh1 my ($class, $x, $y) = @_; 11615759b3d2Safresh1 11625759b3d2Safresh1 return $x if $class -> _acmp($x, $y) == 0; 11635759b3d2Safresh1 11645759b3d2Safresh1 my $m = $class -> _one(); 11655759b3d2Safresh1 my $mask = $class -> _new("32768"); 11665759b3d2Safresh1 11675759b3d2Safresh1 my ($xr, $yr); # remainders after division 11685759b3d2Safresh1 11695759b3d2Safresh1 my $xc = $class -> _copy($x); 11705759b3d2Safresh1 my $yc = $class -> _copy($y); 11715759b3d2Safresh1 my $z = $class -> _zero(); 11725759b3d2Safresh1 11735759b3d2Safresh1 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 11745759b3d2Safresh1 ($xc, $xr) = $class -> _div($xc, $mask); 11755759b3d2Safresh1 ($yc, $yr) = $class -> _div($yc, $mask); 11765759b3d2Safresh1 my $bits = $class -> _new($class -> _num($xr) & $class -> _num($yr)); 11775759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($bits, $m)); 11785759b3d2Safresh1 $m = $class -> _mul($m, $mask); 11795759b3d2Safresh1 } 11805759b3d2Safresh1 11815759b3d2Safresh1 return $z; 11825759b3d2Safresh1} 11835759b3d2Safresh1 11845759b3d2Safresh1sub _xor { 11855759b3d2Safresh1 my ($class, $x, $y) = @_; 11865759b3d2Safresh1 11875759b3d2Safresh1 return $class -> _zero() if $class -> _acmp($x, $y) == 0; 11885759b3d2Safresh1 11895759b3d2Safresh1 my $m = $class -> _one(); 11905759b3d2Safresh1 my $mask = $class -> _new("32768"); 11915759b3d2Safresh1 11925759b3d2Safresh1 my ($xr, $yr); # remainders after division 11935759b3d2Safresh1 11945759b3d2Safresh1 my $xc = $class -> _copy($x); 11955759b3d2Safresh1 my $yc = $class -> _copy($y); 11965759b3d2Safresh1 my $z = $class -> _zero(); 11975759b3d2Safresh1 11985759b3d2Safresh1 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 11995759b3d2Safresh1 ($xc, $xr) = $class -> _div($xc, $mask); 12005759b3d2Safresh1 ($yc, $yr) = $class -> _div($yc, $mask); 12015759b3d2Safresh1 my $bits = $class -> _new($class -> _num($xr) ^ $class -> _num($yr)); 12025759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($bits, $m)); 12035759b3d2Safresh1 $m = $class -> _mul($m, $mask); 12045759b3d2Safresh1 } 12055759b3d2Safresh1 12065759b3d2Safresh1 # The loop above stops when the smallest of the two numbers is exhausted. 12075759b3d2Safresh1 # The remainder of the longer one will survive bit-by-bit, so we simple 12085759b3d2Safresh1 # multiply-add it in. 12095759b3d2Safresh1 12105759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($xc, $m)) 12115759b3d2Safresh1 unless $class -> _is_zero($xc); 12125759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($yc, $m)) 12135759b3d2Safresh1 unless $class -> _is_zero($yc); 12145759b3d2Safresh1 12155759b3d2Safresh1 return $z; 12165759b3d2Safresh1} 12175759b3d2Safresh1 12185759b3d2Safresh1sub _or { 12195759b3d2Safresh1 my ($class, $x, $y) = @_; 12205759b3d2Safresh1 12215759b3d2Safresh1 return $x if $class -> _acmp($x, $y) == 0; # shortcut (see _and) 12225759b3d2Safresh1 12235759b3d2Safresh1 my $m = $class -> _one(); 12245759b3d2Safresh1 my $mask = $class -> _new("32768"); 12255759b3d2Safresh1 12265759b3d2Safresh1 my ($xr, $yr); # remainders after division 12275759b3d2Safresh1 12285759b3d2Safresh1 my $xc = $class -> _copy($x); 12295759b3d2Safresh1 my $yc = $class -> _copy($y); 12305759b3d2Safresh1 my $z = $class -> _zero(); 12315759b3d2Safresh1 12325759b3d2Safresh1 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 12335759b3d2Safresh1 ($xc, $xr) = $class -> _div($xc, $mask); 12345759b3d2Safresh1 ($yc, $yr) = $class -> _div($yc, $mask); 12355759b3d2Safresh1 my $bits = $class -> _new($class -> _num($xr) | $class -> _num($yr)); 12365759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($bits, $m)); 12375759b3d2Safresh1 $m = $class -> _mul($m, $mask); 12385759b3d2Safresh1 } 12395759b3d2Safresh1 12405759b3d2Safresh1 # The loop above stops when the smallest of the two numbers is exhausted. 12415759b3d2Safresh1 # The remainder of the longer one will survive bit-by-bit, so we simple 12425759b3d2Safresh1 # multiply-add it in. 12435759b3d2Safresh1 12445759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($xc, $m)) 12455759b3d2Safresh1 unless $class -> _is_zero($xc); 12465759b3d2Safresh1 $z = $class -> _add($z, $class -> _mul($yc, $m)) 12475759b3d2Safresh1 unless $class -> _is_zero($yc); 12485759b3d2Safresh1 12495759b3d2Safresh1 return $z; 12505759b3d2Safresh1} 12515759b3d2Safresh1 1252f3efcd01Safresh1sub _sand { 1253f3efcd01Safresh1 my ($class, $x, $sx, $y, $sy) = @_; 1254f3efcd01Safresh1 1255f3efcd01Safresh1 return ($class -> _zero(), '+') 1256f3efcd01Safresh1 if $class -> _is_zero($x) || $class -> _is_zero($y); 1257f3efcd01Safresh1 1258f3efcd01Safresh1 my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+'; 1259f3efcd01Safresh1 1260f3efcd01Safresh1 my ($bx, $by); 1261f3efcd01Safresh1 1262f3efcd01Safresh1 if ($sx eq '-') { # if x is negative 1263f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1264f3efcd01Safresh1 $bx = $class -> _copy($x); 1265f3efcd01Safresh1 $bx = $class -> _dec($bx); 1266f3efcd01Safresh1 $bx = $class -> _as_hex($bx); 1267f3efcd01Safresh1 $bx =~ s/^-?0x//; 1268f3efcd01Safresh1 $bx =~ tr<0123456789abcdef> 1269f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1270f3efcd01Safresh1 } else { # if x is positive 1271f3efcd01Safresh1 $bx = $class -> _as_hex($x); # get binary representation 1272f3efcd01Safresh1 $bx =~ s/^-?0x//; 1273f3efcd01Safresh1 $bx =~ tr<fedcba9876543210> 1274f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1275f3efcd01Safresh1 } 1276f3efcd01Safresh1 1277f3efcd01Safresh1 if ($sy eq '-') { # if y is negative 1278f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1279f3efcd01Safresh1 $by = $class -> _copy($y); 1280f3efcd01Safresh1 $by = $class -> _dec($by); 1281f3efcd01Safresh1 $by = $class -> _as_hex($by); 1282f3efcd01Safresh1 $by =~ s/^-?0x//; 1283f3efcd01Safresh1 $by =~ tr<0123456789abcdef> 1284f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1285f3efcd01Safresh1 } else { 1286f3efcd01Safresh1 $by = $class -> _as_hex($y); # get binary representation 1287f3efcd01Safresh1 $by =~ s/^-?0x//; 1288f3efcd01Safresh1 $by =~ tr<fedcba9876543210> 1289f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1290f3efcd01Safresh1 } 1291f3efcd01Safresh1 1292f3efcd01Safresh1 # now we have bit-strings from X and Y, reverse them for padding 1293f3efcd01Safresh1 $bx = reverse $bx; 1294f3efcd01Safresh1 $by = reverse $by; 1295f3efcd01Safresh1 1296f3efcd01Safresh1 # padd the shorter string 1297f3efcd01Safresh1 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1298f3efcd01Safresh1 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1299f3efcd01Safresh1 my $diff = CORE::length($bx) - CORE::length($by); 1300f3efcd01Safresh1 if ($diff > 0) { 1301f3efcd01Safresh1 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1302f3efcd01Safresh1 $by .= $yy x $diff; 1303f3efcd01Safresh1 } elsif ($diff < 0) { 1304f3efcd01Safresh1 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1305f3efcd01Safresh1 $bx .= $xx x abs($diff); 1306f3efcd01Safresh1 } 1307f3efcd01Safresh1 1308f3efcd01Safresh1 # and the strings together 1309f3efcd01Safresh1 my $r = $bx & $by; 1310f3efcd01Safresh1 1311f3efcd01Safresh1 # and reverse the result again 1312f3efcd01Safresh1 $bx = reverse $r; 1313f3efcd01Safresh1 1314f3efcd01Safresh1 # One of $bx or $by was negative, so need to flip bits in the result. In both 1315f3efcd01Safresh1 # cases (one or two of them negative, or both positive) we need to get the 1316f3efcd01Safresh1 # characters back. 1317f3efcd01Safresh1 if ($sign eq '-') { 1318f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1319f3efcd01Safresh1 <0123456789abcdef>; 1320f3efcd01Safresh1 } else { 1321f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1322f3efcd01Safresh1 <fedcba9876543210>; 1323f3efcd01Safresh1 } 1324f3efcd01Safresh1 1325f3efcd01Safresh1 # leading zeros will be stripped by _from_hex() 1326f3efcd01Safresh1 $bx = '0x' . $bx; 1327f3efcd01Safresh1 $bx = $class -> _from_hex($bx); 1328f3efcd01Safresh1 1329f3efcd01Safresh1 $bx = $class -> _inc($bx) if $sign eq '-'; 1330f3efcd01Safresh1 1331f3efcd01Safresh1 # avoid negative zero 1332f3efcd01Safresh1 $sign = '+' if $class -> _is_zero($bx); 1333f3efcd01Safresh1 1334f3efcd01Safresh1 return $bx, $sign; 1335f3efcd01Safresh1} 1336f3efcd01Safresh1 1337f3efcd01Safresh1sub _sxor { 1338f3efcd01Safresh1 my ($class, $x, $sx, $y, $sy) = @_; 1339f3efcd01Safresh1 1340f3efcd01Safresh1 return ($class -> _zero(), '+') 1341f3efcd01Safresh1 if $class -> _is_zero($x) && $class -> _is_zero($y); 1342f3efcd01Safresh1 1343f3efcd01Safresh1 my $sign = $sx ne $sy ? '-' : '+'; 1344f3efcd01Safresh1 1345f3efcd01Safresh1 my ($bx, $by); 1346f3efcd01Safresh1 1347f3efcd01Safresh1 if ($sx eq '-') { # if x is negative 1348f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1349f3efcd01Safresh1 $bx = $class -> _copy($x); 1350f3efcd01Safresh1 $bx = $class -> _dec($bx); 1351f3efcd01Safresh1 $bx = $class -> _as_hex($bx); 1352f3efcd01Safresh1 $bx =~ s/^-?0x//; 1353f3efcd01Safresh1 $bx =~ tr<0123456789abcdef> 1354f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1355f3efcd01Safresh1 } else { # if x is positive 1356f3efcd01Safresh1 $bx = $class -> _as_hex($x); # get binary representation 1357f3efcd01Safresh1 $bx =~ s/^-?0x//; 1358f3efcd01Safresh1 $bx =~ tr<fedcba9876543210> 1359f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1360f3efcd01Safresh1 } 1361f3efcd01Safresh1 1362f3efcd01Safresh1 if ($sy eq '-') { # if y is negative 1363f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1364f3efcd01Safresh1 $by = $class -> _copy($y); 1365f3efcd01Safresh1 $by = $class -> _dec($by); 1366f3efcd01Safresh1 $by = $class -> _as_hex($by); 1367f3efcd01Safresh1 $by =~ s/^-?0x//; 1368f3efcd01Safresh1 $by =~ tr<0123456789abcdef> 1369f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1370f3efcd01Safresh1 } else { 1371f3efcd01Safresh1 $by = $class -> _as_hex($y); # get binary representation 1372f3efcd01Safresh1 $by =~ s/^-?0x//; 1373f3efcd01Safresh1 $by =~ tr<fedcba9876543210> 1374f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1375f3efcd01Safresh1 } 1376f3efcd01Safresh1 1377f3efcd01Safresh1 # now we have bit-strings from X and Y, reverse them for padding 1378f3efcd01Safresh1 $bx = reverse $bx; 1379f3efcd01Safresh1 $by = reverse $by; 1380f3efcd01Safresh1 1381f3efcd01Safresh1 # padd the shorter string 1382f3efcd01Safresh1 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1383f3efcd01Safresh1 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1384f3efcd01Safresh1 my $diff = CORE::length($bx) - CORE::length($by); 1385f3efcd01Safresh1 if ($diff > 0) { 1386f3efcd01Safresh1 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1387f3efcd01Safresh1 $by .= $yy x $diff; 1388f3efcd01Safresh1 } elsif ($diff < 0) { 1389f3efcd01Safresh1 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1390f3efcd01Safresh1 $bx .= $xx x abs($diff); 1391f3efcd01Safresh1 } 1392f3efcd01Safresh1 1393f3efcd01Safresh1 # xor the strings together 1394f3efcd01Safresh1 my $r = $bx ^ $by; 1395f3efcd01Safresh1 1396f3efcd01Safresh1 # and reverse the result again 1397f3efcd01Safresh1 $bx = reverse $r; 1398f3efcd01Safresh1 1399f3efcd01Safresh1 # One of $bx or $by was negative, so need to flip bits in the result. In both 1400f3efcd01Safresh1 # cases (one or two of them negative, or both positive) we need to get the 1401f3efcd01Safresh1 # characters back. 1402f3efcd01Safresh1 if ($sign eq '-') { 1403f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1404f3efcd01Safresh1 <0123456789abcdef>; 1405f3efcd01Safresh1 } else { 1406f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1407f3efcd01Safresh1 <fedcba9876543210>; 1408f3efcd01Safresh1 } 1409f3efcd01Safresh1 1410f3efcd01Safresh1 # leading zeros will be stripped by _from_hex() 1411f3efcd01Safresh1 $bx = '0x' . $bx; 1412f3efcd01Safresh1 $bx = $class -> _from_hex($bx); 1413f3efcd01Safresh1 1414f3efcd01Safresh1 $bx = $class -> _inc($bx) if $sign eq '-'; 1415f3efcd01Safresh1 1416f3efcd01Safresh1 # avoid negative zero 1417f3efcd01Safresh1 $sign = '+' if $class -> _is_zero($bx); 1418f3efcd01Safresh1 1419f3efcd01Safresh1 return $bx, $sign; 1420f3efcd01Safresh1} 1421f3efcd01Safresh1 1422f3efcd01Safresh1sub _sor { 1423f3efcd01Safresh1 my ($class, $x, $sx, $y, $sy) = @_; 1424f3efcd01Safresh1 1425f3efcd01Safresh1 return ($class -> _zero(), '+') 1426f3efcd01Safresh1 if $class -> _is_zero($x) && $class -> _is_zero($y); 1427f3efcd01Safresh1 1428f3efcd01Safresh1 my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+'; 1429f3efcd01Safresh1 1430f3efcd01Safresh1 my ($bx, $by); 1431f3efcd01Safresh1 1432f3efcd01Safresh1 if ($sx eq '-') { # if x is negative 1433f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1434f3efcd01Safresh1 $bx = $class -> _copy($x); 1435f3efcd01Safresh1 $bx = $class -> _dec($bx); 1436f3efcd01Safresh1 $bx = $class -> _as_hex($bx); 1437f3efcd01Safresh1 $bx =~ s/^-?0x//; 1438f3efcd01Safresh1 $bx =~ tr<0123456789abcdef> 1439f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1440f3efcd01Safresh1 } else { # if x is positive 1441f3efcd01Safresh1 $bx = $class -> _as_hex($x); # get binary representation 1442f3efcd01Safresh1 $bx =~ s/^-?0x//; 1443f3efcd01Safresh1 $bx =~ tr<fedcba9876543210> 1444f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1445f3efcd01Safresh1 } 1446f3efcd01Safresh1 1447f3efcd01Safresh1 if ($sy eq '-') { # if y is negative 1448f3efcd01Safresh1 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1449f3efcd01Safresh1 $by = $class -> _copy($y); 1450f3efcd01Safresh1 $by = $class -> _dec($by); 1451f3efcd01Safresh1 $by = $class -> _as_hex($by); 1452f3efcd01Safresh1 $by =~ s/^-?0x//; 1453f3efcd01Safresh1 $by =~ tr<0123456789abcdef> 1454f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1455f3efcd01Safresh1 } else { 1456f3efcd01Safresh1 $by = $class -> _as_hex($y); # get binary representation 1457f3efcd01Safresh1 $by =~ s/^-?0x//; 1458f3efcd01Safresh1 $by =~ tr<fedcba9876543210> 1459f3efcd01Safresh1 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1460f3efcd01Safresh1 } 1461f3efcd01Safresh1 1462f3efcd01Safresh1 # now we have bit-strings from X and Y, reverse them for padding 1463f3efcd01Safresh1 $bx = reverse $bx; 1464f3efcd01Safresh1 $by = reverse $by; 1465f3efcd01Safresh1 1466f3efcd01Safresh1 # padd the shorter string 1467f3efcd01Safresh1 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1468f3efcd01Safresh1 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1469f3efcd01Safresh1 my $diff = CORE::length($bx) - CORE::length($by); 1470f3efcd01Safresh1 if ($diff > 0) { 1471f3efcd01Safresh1 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1472f3efcd01Safresh1 $by .= $yy x $diff; 1473f3efcd01Safresh1 } elsif ($diff < 0) { 1474f3efcd01Safresh1 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1475f3efcd01Safresh1 $bx .= $xx x abs($diff); 1476f3efcd01Safresh1 } 1477f3efcd01Safresh1 1478f3efcd01Safresh1 # or the strings together 1479f3efcd01Safresh1 my $r = $bx | $by; 1480f3efcd01Safresh1 1481f3efcd01Safresh1 # and reverse the result again 1482f3efcd01Safresh1 $bx = reverse $r; 1483f3efcd01Safresh1 1484f3efcd01Safresh1 # One of $bx or $by was negative, so need to flip bits in the result. In both 1485f3efcd01Safresh1 # cases (one or two of them negative, or both positive) we need to get the 1486f3efcd01Safresh1 # characters back. 1487f3efcd01Safresh1 if ($sign eq '-') { 1488f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1489f3efcd01Safresh1 <0123456789abcdef>; 1490f3efcd01Safresh1 } else { 1491f3efcd01Safresh1 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1492f3efcd01Safresh1 <fedcba9876543210>; 1493f3efcd01Safresh1 } 1494f3efcd01Safresh1 1495f3efcd01Safresh1 # leading zeros will be stripped by _from_hex() 1496f3efcd01Safresh1 $bx = '0x' . $bx; 1497f3efcd01Safresh1 $bx = $class -> _from_hex($bx); 1498f3efcd01Safresh1 1499f3efcd01Safresh1 $bx = $class -> _inc($bx) if $sign eq '-'; 1500f3efcd01Safresh1 1501f3efcd01Safresh1 # avoid negative zero 1502f3efcd01Safresh1 $sign = '+' if $class -> _is_zero($bx); 1503f3efcd01Safresh1 1504f3efcd01Safresh1 return $bx, $sign; 1505f3efcd01Safresh1} 1506f3efcd01Safresh1 15075759b3d2Safresh1sub _to_bin { 15085759b3d2Safresh1 # convert the number to a string of binary digits without prefix 15095759b3d2Safresh1 my ($class, $x) = @_; 15105759b3d2Safresh1 my $str = ''; 15115759b3d2Safresh1 my $tmp = $class -> _copy($x); 15125759b3d2Safresh1 my $chunk = $class -> _new("16777216"); # 2^24 = 24 binary digits 15135759b3d2Safresh1 my $rem; 15145759b3d2Safresh1 until ($class -> _acmp($tmp, $chunk) < 0) { 15155759b3d2Safresh1 ($tmp, $rem) = $class -> _div($tmp, $chunk); 15165759b3d2Safresh1 $str = sprintf("%024b", $class -> _num($rem)) . $str; 15175759b3d2Safresh1 } 15185759b3d2Safresh1 unless ($class -> _is_zero($tmp)) { 15195759b3d2Safresh1 $str = sprintf("%b", $class -> _num($tmp)) . $str; 15205759b3d2Safresh1 } 15215759b3d2Safresh1 return length($str) ? $str : '0'; 15225759b3d2Safresh1} 15235759b3d2Safresh1 15245759b3d2Safresh1sub _to_oct { 15255759b3d2Safresh1 # convert the number to a string of octal digits without prefix 15265759b3d2Safresh1 my ($class, $x) = @_; 15275759b3d2Safresh1 my $str = ''; 15285759b3d2Safresh1 my $tmp = $class -> _copy($x); 15295759b3d2Safresh1 my $chunk = $class -> _new("16777216"); # 2^24 = 8 octal digits 15305759b3d2Safresh1 my $rem; 15315759b3d2Safresh1 until ($class -> _acmp($tmp, $chunk) < 0) { 15325759b3d2Safresh1 ($tmp, $rem) = $class -> _div($tmp, $chunk); 15335759b3d2Safresh1 $str = sprintf("%08o", $class -> _num($rem)) . $str; 15345759b3d2Safresh1 } 15355759b3d2Safresh1 unless ($class -> _is_zero($tmp)) { 15365759b3d2Safresh1 $str = sprintf("%o", $class -> _num($tmp)) . $str; 15375759b3d2Safresh1 } 15385759b3d2Safresh1 return length($str) ? $str : '0'; 15395759b3d2Safresh1} 15405759b3d2Safresh1 15415759b3d2Safresh1sub _to_hex { 15425759b3d2Safresh1 # convert the number to a string of hexadecimal digits without prefix 15435759b3d2Safresh1 my ($class, $x) = @_; 15445759b3d2Safresh1 my $str = ''; 15455759b3d2Safresh1 my $tmp = $class -> _copy($x); 15465759b3d2Safresh1 my $chunk = $class -> _new("16777216"); # 2^24 = 6 hexadecimal digits 15475759b3d2Safresh1 my $rem; 15485759b3d2Safresh1 until ($class -> _acmp($tmp, $chunk) < 0) { 15495759b3d2Safresh1 ($tmp, $rem) = $class -> _div($tmp, $chunk); 15505759b3d2Safresh1 $str = sprintf("%06x", $class -> _num($rem)) . $str; 15515759b3d2Safresh1 } 15525759b3d2Safresh1 unless ($class -> _is_zero($tmp)) { 15535759b3d2Safresh1 $str = sprintf("%x", $class -> _num($tmp)) . $str; 15545759b3d2Safresh1 } 15555759b3d2Safresh1 return length($str) ? $str : '0'; 15565759b3d2Safresh1} 15575759b3d2Safresh1 15585759b3d2Safresh1sub _as_bin { 15595759b3d2Safresh1 # convert the number to a string of binary digits with prefix 15605759b3d2Safresh1 my ($class, $x) = @_; 15615759b3d2Safresh1 return '0b' . $class -> _to_bin($x); 15625759b3d2Safresh1} 15635759b3d2Safresh1 15645759b3d2Safresh1sub _as_oct { 15655759b3d2Safresh1 # convert the number to a string of octal digits with prefix 15665759b3d2Safresh1 my ($class, $x) = @_; 15675759b3d2Safresh1 return '0' . $class -> _to_oct($x); # yes, 0 becomes "00" 15685759b3d2Safresh1} 15695759b3d2Safresh1 15705759b3d2Safresh1sub _as_hex { 15715759b3d2Safresh1 # convert the number to a string of hexadecimal digits with prefix 15725759b3d2Safresh1 my ($class, $x) = @_; 15735759b3d2Safresh1 return '0x' . $class -> _to_hex($x); 15745759b3d2Safresh1} 15755759b3d2Safresh1 15765759b3d2Safresh1sub _to_bytes { 15775759b3d2Safresh1 # convert the number to a string of bytes 15785759b3d2Safresh1 my ($class, $x) = @_; 15795759b3d2Safresh1 my $str = ''; 15805759b3d2Safresh1 my $tmp = $class -> _copy($x); 15815759b3d2Safresh1 my $chunk = $class -> _new("65536"); 15825759b3d2Safresh1 my $rem; 15835759b3d2Safresh1 until ($class -> _is_zero($tmp)) { 15845759b3d2Safresh1 ($tmp, $rem) = $class -> _div($tmp, $chunk); 15855759b3d2Safresh1 $str = pack('n', $class -> _num($rem)) . $str; 15865759b3d2Safresh1 } 15875759b3d2Safresh1 $str =~ s/^\0+//; 15885759b3d2Safresh1 return length($str) ? $str : "\x00"; 15895759b3d2Safresh1} 15905759b3d2Safresh1 15915759b3d2Safresh1*_as_bytes = \&_to_bytes; 15925759b3d2Safresh1 1593f3efcd01Safresh1sub _to_base { 1594f3efcd01Safresh1 # convert the number to a string of digits in various bases 1595f3efcd01Safresh1 my $class = shift; 1596f3efcd01Safresh1 my $x = shift; 1597f3efcd01Safresh1 my $base = shift; 1598f3efcd01Safresh1 $base = $class -> _new($base) unless ref($base); 1599f3efcd01Safresh1 1600f3efcd01Safresh1 my $collseq; 1601f3efcd01Safresh1 if (@_) { 1602256a93a4Safresh1 $collseq = shift; 1603256a93a4Safresh1 croak "The collation sequence must be a non-empty string" 1604256a93a4Safresh1 unless defined($collseq) && length($collseq); 1605f3efcd01Safresh1 } else { 1606de8cc8edSafresh1 if ($class -> _acmp($base, $class -> _new("94")) <= 0) { 1607de8cc8edSafresh1 $collseq = '0123456789' # 48 .. 57 1608de8cc8edSafresh1 . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 1609de8cc8edSafresh1 . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 1610de8cc8edSafresh1 . '!"#$%&\'()*+,-./' # 33 .. 47 1611de8cc8edSafresh1 . ':;<=>?@' # 58 .. 64 1612de8cc8edSafresh1 . '[\\]^_`' # 91 .. 96 1613de8cc8edSafresh1 . '{|}~'; # 123 .. 126 1614f3efcd01Safresh1 } else { 1615de8cc8edSafresh1 croak "When base > 94, a collation sequence must be given"; 1616f3efcd01Safresh1 } 1617f3efcd01Safresh1 } 1618f3efcd01Safresh1 1619f3efcd01Safresh1 my @collseq = split '', $collseq; 1620f3efcd01Safresh1 1621f3efcd01Safresh1 my $str = ''; 1622f3efcd01Safresh1 my $tmp = $class -> _copy($x); 1623f3efcd01Safresh1 my $rem; 1624f3efcd01Safresh1 until ($class -> _is_zero($tmp)) { 1625f3efcd01Safresh1 ($tmp, $rem) = $class -> _div($tmp, $base); 1626f3efcd01Safresh1 my $num = $class -> _num($rem); 1627f3efcd01Safresh1 croak "no character to represent '$num' in collation sequence", 1628f3efcd01Safresh1 " (collation sequence is too short)" if $num > $#collseq; 1629f3efcd01Safresh1 my $chr = $collseq[$num]; 1630f3efcd01Safresh1 $str = $chr . $str; 1631f3efcd01Safresh1 } 1632256a93a4Safresh1 return $collseq[0] unless length $str; 1633f3efcd01Safresh1 return $str; 1634f3efcd01Safresh1} 1635f3efcd01Safresh1 1636256a93a4Safresh1sub _to_base_num { 1637256a93a4Safresh1 # Convert the number to an array of integers in any base. 1638256a93a4Safresh1 my ($class, $x, $base) = @_; 1639256a93a4Safresh1 1640256a93a4Safresh1 # Make sure the base is an object and >= 2. 1641256a93a4Safresh1 $base = $class -> _new($base) unless ref($base); 1642256a93a4Safresh1 my $two = $class -> _two(); 1643256a93a4Safresh1 croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0; 1644256a93a4Safresh1 1645256a93a4Safresh1 my $out = []; 1646256a93a4Safresh1 my $xcopy = $class -> _copy($x); 1647256a93a4Safresh1 my $rem; 1648256a93a4Safresh1 1649256a93a4Safresh1 # Do all except the last (most significant) element. 1650256a93a4Safresh1 until ($class -> _acmp($xcopy, $base) < 0) { 1651256a93a4Safresh1 ($xcopy, $rem) = $class -> _div($xcopy, $base); 1652256a93a4Safresh1 unshift @$out, $rem; 1653256a93a4Safresh1 } 1654256a93a4Safresh1 1655256a93a4Safresh1 # Do the last (most significant element). 1656256a93a4Safresh1 unless ($class -> _is_zero($xcopy)) { 1657256a93a4Safresh1 unshift @$out, $xcopy; 1658256a93a4Safresh1 } 1659256a93a4Safresh1 1660256a93a4Safresh1 # $out is empty if $x is zero. 1661256a93a4Safresh1 unshift @$out, $class -> _zero() unless @$out; 1662256a93a4Safresh1 1663256a93a4Safresh1 return $out; 1664256a93a4Safresh1} 1665256a93a4Safresh1 16665759b3d2Safresh1sub _from_hex { 16675759b3d2Safresh1 # Convert a string of hexadecimal digits to a number. 16685759b3d2Safresh1 16695759b3d2Safresh1 my ($class, $hex) = @_; 16705759b3d2Safresh1 $hex =~ s/^0[xX]//; 16715759b3d2Safresh1 16725759b3d2Safresh1 # Find the largest number of hexadecimal digits that we can safely use with 16735759b3d2Safresh1 # 32 bit integers. There are 4 bits pr hexadecimal digit, and we use only 16745759b3d2Safresh1 # 31 bits to play safe. This gives us int(31 / 4) = 7. 16755759b3d2Safresh1 16765759b3d2Safresh1 my $len = length $hex; 16775759b3d2Safresh1 my $rem = 1 + ($len - 1) % 7; 16785759b3d2Safresh1 16795759b3d2Safresh1 # Do the first chunk. 16805759b3d2Safresh1 16815759b3d2Safresh1 my $ret = $class -> _new(int hex substr $hex, 0, $rem); 16825759b3d2Safresh1 return $ret if $rem == $len; 16835759b3d2Safresh1 16845759b3d2Safresh1 # Do the remaining chunks, if any. 16855759b3d2Safresh1 16865759b3d2Safresh1 my $shift = $class -> _new(1 << (4 * 7)); 16875759b3d2Safresh1 for (my $offset = $rem ; $offset < $len ; $offset += 7) { 16885759b3d2Safresh1 my $part = int hex substr $hex, $offset, 7; 16895759b3d2Safresh1 $ret = $class -> _mul($ret, $shift); 16905759b3d2Safresh1 $ret = $class -> _add($ret, $class -> _new($part)); 16915759b3d2Safresh1 } 16925759b3d2Safresh1 16935759b3d2Safresh1 return $ret; 16945759b3d2Safresh1} 16955759b3d2Safresh1 16965759b3d2Safresh1sub _from_oct { 16975759b3d2Safresh1 # Convert a string of octal digits to a number. 16985759b3d2Safresh1 16995759b3d2Safresh1 my ($class, $oct) = @_; 17005759b3d2Safresh1 17015759b3d2Safresh1 # Find the largest number of octal digits that we can safely use with 32 17025759b3d2Safresh1 # bit integers. There are 3 bits pr octal digit, and we use only 31 bits to 17035759b3d2Safresh1 # play safe. This gives us int(31 / 3) = 10. 17045759b3d2Safresh1 17055759b3d2Safresh1 my $len = length $oct; 17065759b3d2Safresh1 my $rem = 1 + ($len - 1) % 10; 17075759b3d2Safresh1 17085759b3d2Safresh1 # Do the first chunk. 17095759b3d2Safresh1 17105759b3d2Safresh1 my $ret = $class -> _new(int oct substr $oct, 0, $rem); 17115759b3d2Safresh1 return $ret if $rem == $len; 17125759b3d2Safresh1 17135759b3d2Safresh1 # Do the remaining chunks, if any. 17145759b3d2Safresh1 17155759b3d2Safresh1 my $shift = $class -> _new(1 << (3 * 10)); 17165759b3d2Safresh1 for (my $offset = $rem ; $offset < $len ; $offset += 10) { 17175759b3d2Safresh1 my $part = int oct substr $oct, $offset, 10; 17185759b3d2Safresh1 $ret = $class -> _mul($ret, $shift); 17195759b3d2Safresh1 $ret = $class -> _add($ret, $class -> _new($part)); 17205759b3d2Safresh1 } 17215759b3d2Safresh1 17225759b3d2Safresh1 return $ret; 17235759b3d2Safresh1} 17245759b3d2Safresh1 17255759b3d2Safresh1sub _from_bin { 17265759b3d2Safresh1 # Convert a string of binary digits to a number. 17275759b3d2Safresh1 17285759b3d2Safresh1 my ($class, $bin) = @_; 17295759b3d2Safresh1 $bin =~ s/^0[bB]//; 17305759b3d2Safresh1 17315759b3d2Safresh1 # The largest number of binary digits that we can safely use with 32 bit 17325759b3d2Safresh1 # integers is 31. We use only 31 bits to play safe. 17335759b3d2Safresh1 17345759b3d2Safresh1 my $len = length $bin; 17355759b3d2Safresh1 my $rem = 1 + ($len - 1) % 31; 17365759b3d2Safresh1 17375759b3d2Safresh1 # Do the first chunk. 17385759b3d2Safresh1 17395759b3d2Safresh1 my $ret = $class -> _new(int oct '0b' . substr $bin, 0, $rem); 17405759b3d2Safresh1 return $ret if $rem == $len; 17415759b3d2Safresh1 17425759b3d2Safresh1 # Do the remaining chunks, if any. 17435759b3d2Safresh1 17445759b3d2Safresh1 my $shift = $class -> _new(1 << 31); 17455759b3d2Safresh1 for (my $offset = $rem ; $offset < $len ; $offset += 31) { 17465759b3d2Safresh1 my $part = int oct '0b' . substr $bin, $offset, 31; 17475759b3d2Safresh1 $ret = $class -> _mul($ret, $shift); 17485759b3d2Safresh1 $ret = $class -> _add($ret, $class -> _new($part)); 17495759b3d2Safresh1 } 17505759b3d2Safresh1 17515759b3d2Safresh1 return $ret; 17525759b3d2Safresh1} 17535759b3d2Safresh1 17545759b3d2Safresh1sub _from_bytes { 17555759b3d2Safresh1 # convert string of bytes to a number 17565759b3d2Safresh1 my ($class, $str) = @_; 17575759b3d2Safresh1 my $x = $class -> _zero(); 17585759b3d2Safresh1 my $base = $class -> _new("256"); 17595759b3d2Safresh1 my $n = length($str); 17605759b3d2Safresh1 for (my $i = 0 ; $i < $n ; ++$i) { 17615759b3d2Safresh1 $x = $class -> _mul($x, $base); 17625759b3d2Safresh1 my $byteval = $class -> _new(unpack 'C', substr($str, $i, 1)); 17635759b3d2Safresh1 $x = $class -> _add($x, $byteval); 17645759b3d2Safresh1 } 17655759b3d2Safresh1 return $x; 17665759b3d2Safresh1} 17675759b3d2Safresh1 1768f3efcd01Safresh1sub _from_base { 1769f3efcd01Safresh1 # convert a string to a decimal number 1770f3efcd01Safresh1 my $class = shift; 1771f3efcd01Safresh1 my $str = shift; 1772f3efcd01Safresh1 my $base = shift; 1773f3efcd01Safresh1 $base = $class -> _new($base) unless ref($base); 1774f3efcd01Safresh1 1775f3efcd01Safresh1 my $n = length($str); 1776f3efcd01Safresh1 my $x = $class -> _zero(); 1777f3efcd01Safresh1 1778f3efcd01Safresh1 my $collseq; 1779f3efcd01Safresh1 if (@_) { 1780f3efcd01Safresh1 $collseq = shift(); 1781f3efcd01Safresh1 } else { 1782f3efcd01Safresh1 if ($class -> _acmp($base, $class -> _new("36")) <= 0) { 1783f3efcd01Safresh1 $str = uc $str; 1784f3efcd01Safresh1 $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; 1785de8cc8edSafresh1 } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) { 1786de8cc8edSafresh1 $collseq = '0123456789' # 48 .. 57 1787de8cc8edSafresh1 . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 1788de8cc8edSafresh1 . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 1789de8cc8edSafresh1 . '!"#$%&\'()*+,-./' # 33 .. 47 1790de8cc8edSafresh1 . ':;<=>?@' # 58 .. 64 1791de8cc8edSafresh1 . '[\\]^_`' # 91 .. 96 1792de8cc8edSafresh1 . '{|}~'; # 123 .. 126 1793f3efcd01Safresh1 } else { 1794de8cc8edSafresh1 croak "When base > 94, a collation sequence must be given"; 1795f3efcd01Safresh1 } 1796f3efcd01Safresh1 $collseq = substr $collseq, 0, $class -> _num($base); 1797f3efcd01Safresh1 } 1798f3efcd01Safresh1 1799f3efcd01Safresh1 # Create a mapping from each character in the collation sequence to the 1800f3efcd01Safresh1 # corresponding integer. Check for duplicates in the collation sequence. 1801f3efcd01Safresh1 1802f3efcd01Safresh1 my @collseq = split '', $collseq; 1803f3efcd01Safresh1 my %collseq; 1804f3efcd01Safresh1 for my $num (0 .. $#collseq) { 1805f3efcd01Safresh1 my $chr = $collseq[$num]; 1806f3efcd01Safresh1 die "duplicate character '$chr' in collation sequence" 1807f3efcd01Safresh1 if exists $collseq{$chr}; 1808f3efcd01Safresh1 $collseq{$chr} = $num; 1809f3efcd01Safresh1 } 1810f3efcd01Safresh1 1811f3efcd01Safresh1 for (my $i = 0 ; $i < $n ; ++$i) { 1812f3efcd01Safresh1 my $chr = substr($str, $i, 1); 1813f3efcd01Safresh1 die "input character '$chr' does not exist in collation sequence" 1814f3efcd01Safresh1 unless exists $collseq{$chr}; 1815f3efcd01Safresh1 $x = $class -> _mul($x, $base); 1816f3efcd01Safresh1 my $num = $class -> _new($collseq{$chr}); 1817f3efcd01Safresh1 $x = $class -> _add($x, $num); 1818f3efcd01Safresh1 } 1819f3efcd01Safresh1 1820f3efcd01Safresh1 return $x; 1821f3efcd01Safresh1} 1822f3efcd01Safresh1 1823256a93a4Safresh1sub _from_base_num { 1824256a93a4Safresh1 # Convert an array in the given base to a number. 1825256a93a4Safresh1 my ($class, $in, $base) = @_; 1826256a93a4Safresh1 1827256a93a4Safresh1 # Make sure the base is an object and >= 2. 1828256a93a4Safresh1 $base = $class -> _new($base) unless ref($base); 1829256a93a4Safresh1 my $two = $class -> _two(); 1830256a93a4Safresh1 croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0; 1831256a93a4Safresh1 1832256a93a4Safresh1 # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in; 1833256a93a4Safresh1 1834256a93a4Safresh1 my $ele = $in -> [0]; 1835256a93a4Safresh1 1836256a93a4Safresh1 $ele = $class -> _new($ele) unless ref($ele); 1837256a93a4Safresh1 my $x = $class -> _copy($ele); 1838256a93a4Safresh1 1839256a93a4Safresh1 for my $i (1 .. $#$in) { 1840256a93a4Safresh1 $x = $class -> _mul($x, $base); 1841256a93a4Safresh1 $ele = $in -> [$i]; 1842256a93a4Safresh1 $ele = $class -> _new($ele) unless ref($ele); 1843256a93a4Safresh1 $x = $class -> _add($x, $ele); 1844256a93a4Safresh1 } 1845256a93a4Safresh1 1846256a93a4Safresh1 return $x; 1847256a93a4Safresh1} 1848256a93a4Safresh1 18495759b3d2Safresh1############################################################################## 18505759b3d2Safresh1# special modulus functions 18515759b3d2Safresh1 18525759b3d2Safresh1sub _modinv { 18535759b3d2Safresh1 # modular multiplicative inverse 18545759b3d2Safresh1 my ($class, $x, $y) = @_; 18555759b3d2Safresh1 18565759b3d2Safresh1 # modulo zero 18575759b3d2Safresh1 if ($class -> _is_zero($y)) { 1858f2a19305Safresh1 return; 18595759b3d2Safresh1 } 18605759b3d2Safresh1 18615759b3d2Safresh1 # modulo one 18625759b3d2Safresh1 if ($class -> _is_one($y)) { 18635759b3d2Safresh1 return ($class -> _zero(), '+'); 18645759b3d2Safresh1 } 18655759b3d2Safresh1 18665759b3d2Safresh1 my $u = $class -> _zero(); 18675759b3d2Safresh1 my $v = $class -> _one(); 18685759b3d2Safresh1 my $a = $class -> _copy($y); 18695759b3d2Safresh1 my $b = $class -> _copy($x); 18705759b3d2Safresh1 18715759b3d2Safresh1 # Euclid's Algorithm for bgcd(). 18725759b3d2Safresh1 18735759b3d2Safresh1 my $q; 18745759b3d2Safresh1 my $sign = 1; 18755759b3d2Safresh1 { 18765759b3d2Safresh1 ($a, $q, $b) = ($b, $class -> _div($a, $b)); 18775759b3d2Safresh1 last if $class -> _is_zero($b); 18785759b3d2Safresh1 18795759b3d2Safresh1 my $vq = $class -> _mul($class -> _copy($v), $q); 18805759b3d2Safresh1 my $t = $class -> _add($vq, $u); 18815759b3d2Safresh1 $u = $v; 18825759b3d2Safresh1 $v = $t; 18835759b3d2Safresh1 $sign = -$sign; 18845759b3d2Safresh1 redo; 18855759b3d2Safresh1 } 18865759b3d2Safresh1 18875759b3d2Safresh1 # if the gcd is not 1, there exists no modular multiplicative inverse 1888f2a19305Safresh1 return unless $class -> _is_one($a); 18895759b3d2Safresh1 18905759b3d2Safresh1 ($v, $sign == 1 ? '+' : '-'); 18915759b3d2Safresh1} 18925759b3d2Safresh1 18935759b3d2Safresh1sub _modpow { 18945759b3d2Safresh1 # modulus of power ($x ** $y) % $z 18955759b3d2Safresh1 my ($class, $num, $exp, $mod) = @_; 18965759b3d2Safresh1 18975759b3d2Safresh1 # a^b (mod 1) = 0 for all a and b 18985759b3d2Safresh1 if ($class -> _is_one($mod)) { 18995759b3d2Safresh1 return $class -> _zero(); 19005759b3d2Safresh1 } 19015759b3d2Safresh1 19025759b3d2Safresh1 # 0^a (mod m) = 0 if m != 0, a != 0 19035759b3d2Safresh1 # 0^0 (mod m) = 1 if m != 0 19045759b3d2Safresh1 if ($class -> _is_zero($num)) { 19055759b3d2Safresh1 return $class -> _is_zero($exp) ? $class -> _one() 19065759b3d2Safresh1 : $class -> _zero(); 19075759b3d2Safresh1 } 19085759b3d2Safresh1 19095759b3d2Safresh1 # $num = $class -> _mod($num, $mod); # this does not make it faster 19105759b3d2Safresh1 19115759b3d2Safresh1 my $acc = $class -> _copy($num); 19125759b3d2Safresh1 my $t = $class -> _one(); 19135759b3d2Safresh1 19145759b3d2Safresh1 my $expbin = $class -> _as_bin($exp); 19155759b3d2Safresh1 $expbin =~ s/^0b//; 19165759b3d2Safresh1 my $len = length($expbin); 19175759b3d2Safresh1 19185759b3d2Safresh1 while (--$len >= 0) { 19195759b3d2Safresh1 if (substr($expbin, $len, 1) eq '1') { 19205759b3d2Safresh1 $t = $class -> _mul($t, $acc); 19215759b3d2Safresh1 $t = $class -> _mod($t, $mod); 19225759b3d2Safresh1 } 19235759b3d2Safresh1 $acc = $class -> _mul($acc, $acc); 19245759b3d2Safresh1 $acc = $class -> _mod($acc, $mod); 19255759b3d2Safresh1 } 19265759b3d2Safresh1 return $t; 19275759b3d2Safresh1} 19285759b3d2Safresh1 19295759b3d2Safresh1sub _gcd { 19305759b3d2Safresh1 # Greatest common divisor. 19315759b3d2Safresh1 19325759b3d2Safresh1 my ($class, $x, $y) = @_; 19335759b3d2Safresh1 19345759b3d2Safresh1 # gcd(0, 0) = 0 19355759b3d2Safresh1 # gcd(0, a) = a, if a != 0 19365759b3d2Safresh1 19375759b3d2Safresh1 if ($class -> _acmp($x, $y) == 0) { 19385759b3d2Safresh1 return $class -> _copy($x); 19395759b3d2Safresh1 } 19405759b3d2Safresh1 19415759b3d2Safresh1 if ($class -> _is_zero($x)) { 19425759b3d2Safresh1 if ($class -> _is_zero($y)) { 19435759b3d2Safresh1 return $class -> _zero(); 19445759b3d2Safresh1 } else { 19455759b3d2Safresh1 return $class -> _copy($y); 19465759b3d2Safresh1 } 19475759b3d2Safresh1 } else { 19485759b3d2Safresh1 if ($class -> _is_zero($y)) { 19495759b3d2Safresh1 return $class -> _copy($x); 19505759b3d2Safresh1 } else { 19515759b3d2Safresh1 19525759b3d2Safresh1 # Until $y is zero ... 19535759b3d2Safresh1 19545759b3d2Safresh1 $x = $class -> _copy($x); 19555759b3d2Safresh1 until ($class -> _is_zero($y)) { 19565759b3d2Safresh1 19575759b3d2Safresh1 # Compute remainder. 19585759b3d2Safresh1 19595759b3d2Safresh1 $x = $class -> _mod($x, $y); 19605759b3d2Safresh1 19615759b3d2Safresh1 # Swap $x and $y. 19625759b3d2Safresh1 19635759b3d2Safresh1 my $tmp = $x; 19645759b3d2Safresh1 $x = $class -> _copy($y); 19655759b3d2Safresh1 $y = $tmp; 19665759b3d2Safresh1 } 19675759b3d2Safresh1 19685759b3d2Safresh1 return $x; 19695759b3d2Safresh1 } 19705759b3d2Safresh1 } 19715759b3d2Safresh1} 19725759b3d2Safresh1 19735759b3d2Safresh1sub _lcm { 19745759b3d2Safresh1 # Least common multiple. 19755759b3d2Safresh1 19765759b3d2Safresh1 my ($class, $x, $y) = @_; 19775759b3d2Safresh1 19785759b3d2Safresh1 # lcm(0, x) = 0 for all x 19795759b3d2Safresh1 19805759b3d2Safresh1 return $class -> _zero() 19815759b3d2Safresh1 if ($class -> _is_zero($x) || 19825759b3d2Safresh1 $class -> _is_zero($y)); 19835759b3d2Safresh1 19845759b3d2Safresh1 my $gcd = $class -> _gcd($class -> _copy($x), $y); 19855759b3d2Safresh1 $x = $class -> _div($x, $gcd); 19865759b3d2Safresh1 $x = $class -> _mul($x, $y); 19875759b3d2Safresh1 return $x; 19885759b3d2Safresh1} 19895759b3d2Safresh1 19905759b3d2Safresh1sub _lucas { 19915759b3d2Safresh1 my ($class, $n) = @_; 19925759b3d2Safresh1 19935759b3d2Safresh1 $n = $class -> _num($n) if ref $n; 19945759b3d2Safresh1 19955759b3d2Safresh1 # In list context, use lucas(n) = lucas(n-1) + lucas(n-2) 19965759b3d2Safresh1 19975759b3d2Safresh1 if (wantarray) { 19985759b3d2Safresh1 my @y; 19995759b3d2Safresh1 20005759b3d2Safresh1 push @y, $class -> _two(); 20015759b3d2Safresh1 return @y if $n == 0; 20025759b3d2Safresh1 20035759b3d2Safresh1 push @y, $class -> _one(); 20045759b3d2Safresh1 return @y if $n == 1; 20055759b3d2Safresh1 20065759b3d2Safresh1 for (my $i = 2 ; $i <= $n ; ++ $i) { 20075759b3d2Safresh1 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]); 20085759b3d2Safresh1 } 20095759b3d2Safresh1 20105759b3d2Safresh1 return @y; 20115759b3d2Safresh1 } 20125759b3d2Safresh1 20135759b3d2Safresh1 # In scalar context use that lucas(n) = fib(n-1) + fib(n+1). 20145759b3d2Safresh1 # 20155759b3d2Safresh1 # Remember that _fib() behaves differently in scalar context and list 20165759b3d2Safresh1 # context, so we must add scalar() to get the desired behaviour. 20175759b3d2Safresh1 20185759b3d2Safresh1 return $class -> _two() if $n == 0; 20195759b3d2Safresh1 2020256a93a4Safresh1 return $class -> _add(scalar($class -> _fib($n - 1)), 2021256a93a4Safresh1 scalar($class -> _fib($n + 1))); 20225759b3d2Safresh1} 20235759b3d2Safresh1 20245759b3d2Safresh1sub _fib { 20255759b3d2Safresh1 my ($class, $n) = @_; 20265759b3d2Safresh1 20275759b3d2Safresh1 $n = $class -> _num($n) if ref $n; 20285759b3d2Safresh1 20295759b3d2Safresh1 # In list context, use fib(n) = fib(n-1) + fib(n-2) 20305759b3d2Safresh1 20315759b3d2Safresh1 if (wantarray) { 20325759b3d2Safresh1 my @y; 20335759b3d2Safresh1 20345759b3d2Safresh1 push @y, $class -> _zero(); 20355759b3d2Safresh1 return @y if $n == 0; 20365759b3d2Safresh1 20375759b3d2Safresh1 push @y, $class -> _one(); 20385759b3d2Safresh1 return @y if $n == 1; 20395759b3d2Safresh1 20405759b3d2Safresh1 for (my $i = 2 ; $i <= $n ; ++ $i) { 20415759b3d2Safresh1 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]); 20425759b3d2Safresh1 } 20435759b3d2Safresh1 20445759b3d2Safresh1 return @y; 20455759b3d2Safresh1 } 20465759b3d2Safresh1 20475759b3d2Safresh1 # In scalar context use a fast algorithm that is much faster than the 20485759b3d2Safresh1 # recursive algorith used in list context. 20495759b3d2Safresh1 20505759b3d2Safresh1 my $cache = {}; 20515759b3d2Safresh1 my $two = $class -> _two(); 20525759b3d2Safresh1 my $fib; 20535759b3d2Safresh1 20545759b3d2Safresh1 $fib = sub { 20555759b3d2Safresh1 my $n = shift; 20565759b3d2Safresh1 return $class -> _zero() if $n <= 0; 20575759b3d2Safresh1 return $class -> _one() if $n <= 2; 20585759b3d2Safresh1 return $cache -> {$n} if exists $cache -> {$n}; 20595759b3d2Safresh1 20605759b3d2Safresh1 my $k = int($n / 2); 20615759b3d2Safresh1 my $a = $fib -> ($k + 1); 20625759b3d2Safresh1 my $b = $fib -> ($k); 20635759b3d2Safresh1 my $y; 20645759b3d2Safresh1 20655759b3d2Safresh1 if ($n % 2 == 1) { 20665759b3d2Safresh1 # a*a + b*b 20675759b3d2Safresh1 $y = $class -> _add($class -> _mul($class -> _copy($a), $a), 20685759b3d2Safresh1 $class -> _mul($class -> _copy($b), $b)); 20695759b3d2Safresh1 } else { 20705759b3d2Safresh1 # (2*a - b)*b 20715759b3d2Safresh1 $y = $class -> _mul($class -> _sub($class -> _mul( 20725759b3d2Safresh1 $class -> _copy($two), $a), $b), $b); 20735759b3d2Safresh1 } 20745759b3d2Safresh1 20755759b3d2Safresh1 $cache -> {$n} = $y; 20765759b3d2Safresh1 return $y; 20775759b3d2Safresh1 }; 20785759b3d2Safresh1 20795759b3d2Safresh1 return $fib -> ($n); 20805759b3d2Safresh1} 20815759b3d2Safresh1 20825759b3d2Safresh1############################################################################## 20835759b3d2Safresh1############################################################################## 20845759b3d2Safresh1 20855759b3d2Safresh11; 20865759b3d2Safresh1 20875759b3d2Safresh1__END__ 20885759b3d2Safresh1 20895759b3d2Safresh1=pod 20905759b3d2Safresh1 20915759b3d2Safresh1=head1 NAME 20925759b3d2Safresh1 20935759b3d2Safresh1Math::BigInt::Lib - virtual parent class for Math::BigInt libraries 20945759b3d2Safresh1 20955759b3d2Safresh1=head1 SYNOPSIS 20965759b3d2Safresh1 20975759b3d2Safresh1 # In the backend library for Math::BigInt et al. 20985759b3d2Safresh1 20995759b3d2Safresh1 package Math::BigInt::MyBackend; 21005759b3d2Safresh1 2101256a93a4Safresh1 use Math::BigInt::Lib; 2102256a93a4Safresh1 our @ISA = qw< Math::BigInt::Lib >; 21035759b3d2Safresh1 21045759b3d2Safresh1 sub _new { ... } 21055759b3d2Safresh1 sub _str { ... } 21065759b3d2Safresh1 sub _add { ... } 21075759b3d2Safresh1 str _sub { ... } 21085759b3d2Safresh1 ... 21095759b3d2Safresh1 21105759b3d2Safresh1 # In your main program. 21115759b3d2Safresh1 21125759b3d2Safresh1 use Math::BigInt lib => 'MyBackend'; 21135759b3d2Safresh1 21145759b3d2Safresh1=head1 DESCRIPTION 21155759b3d2Safresh1 21165759b3d2Safresh1This module provides support for big integer calculations. It is not intended 21175759b3d2Safresh1to be used directly, but rather as a parent class for backend libraries used by 21185759b3d2Safresh1Math::BigInt, Math::BigFloat, Math::BigRat, and related modules. 21195759b3d2Safresh1 21205759b3d2Safresh1Other backend libraries include Math::BigInt::Calc, Math::BigInt::FastCalc, 21215759b3d2Safresh1Math::BigInt::GMP, and Math::BigInt::Pari. 21225759b3d2Safresh1 21235759b3d2Safresh1In order to allow for multiple big integer libraries, Math::BigInt was 21245759b3d2Safresh1rewritten to use a plug-in library for core math routines. Any module which 21255759b3d2Safresh1conforms to the API can be used by Math::BigInt by using this in your program: 21265759b3d2Safresh1 21275759b3d2Safresh1 use Math::BigInt lib => 'libname'; 21285759b3d2Safresh1 21295759b3d2Safresh1'libname' is either the long name, like 'Math::BigInt::Pari', or only the short 21305759b3d2Safresh1version, like 'Pari'. 21315759b3d2Safresh1 21325759b3d2Safresh1=head2 General Notes 21335759b3d2Safresh1 21345759b3d2Safresh1A library only needs to deal with unsigned big integers. Testing of input 21355759b3d2Safresh1parameter validity is done by the caller, so there is no need to worry about 21365759b3d2Safresh1underflow (e.g., in C<_sub()> and C<_dec()>) or about division by zero (e.g., 21375759b3d2Safresh1in C<_div()> and C<_mod()>)) or similar cases. 21385759b3d2Safresh1 21395759b3d2Safresh1Some libraries use methods that don't modify their argument, and some libraries 21405759b3d2Safresh1don't even use objects, but rather unblessed references. Because of this, 21415759b3d2Safresh1liberary methods are always called as class methods, not instance methods: 21425759b3d2Safresh1 21435759b3d2Safresh1 $x = Class -> method($x, $y); # like this 21445759b3d2Safresh1 $x = $x -> method($y); # not like this ... 21455759b3d2Safresh1 $x -> method($y); # ... or like this 21465759b3d2Safresh1 21475759b3d2Safresh1And with boolean methods 21485759b3d2Safresh1 21495759b3d2Safresh1 $bool = Class -> method($x, $y); # like this 21505759b3d2Safresh1 $bool = $x -> method($y); # not like this 21515759b3d2Safresh1 21525759b3d2Safresh1Return values are always objects, strings, Perl scalars, or true/false for 21535759b3d2Safresh1comparison routines. 21545759b3d2Safresh1 21555759b3d2Safresh1=head3 API version 21565759b3d2Safresh1 21575759b3d2Safresh1=over 4 21585759b3d2Safresh1 21595759b3d2Safresh1=item CLASS-E<gt>api_version() 21605759b3d2Safresh1 2161de8cc8edSafresh1This method is no longer used and can be omitted. Methods that are not 2162de8cc8edSafresh1implemented by a subclass will be inherited from this class. 21635759b3d2Safresh1 21645759b3d2Safresh1=back 21655759b3d2Safresh1 21665759b3d2Safresh1=head3 Constructors 21675759b3d2Safresh1 21685759b3d2Safresh1The following methods are mandatory: _new(), _str(), _add(), and _sub(). 21695759b3d2Safresh1However, computations will be very slow without _mul() and _div(). 21705759b3d2Safresh1 21715759b3d2Safresh1=over 4 21725759b3d2Safresh1 21735759b3d2Safresh1=item CLASS-E<gt>_new(STR) 21745759b3d2Safresh1 21755759b3d2Safresh1Convert a string representing an unsigned decimal number to an object 21765759b3d2Safresh1representing the same number. The input is normalized, i.e., it matches 21775759b3d2Safresh1C<^(0|[1-9]\d*)$>. 21785759b3d2Safresh1 21795759b3d2Safresh1=item CLASS-E<gt>_zero() 21805759b3d2Safresh1 21815759b3d2Safresh1Return an object representing the number zero. 21825759b3d2Safresh1 21835759b3d2Safresh1=item CLASS-E<gt>_one() 21845759b3d2Safresh1 21855759b3d2Safresh1Return an object representing the number one. 21865759b3d2Safresh1 21875759b3d2Safresh1=item CLASS-E<gt>_two() 21885759b3d2Safresh1 21895759b3d2Safresh1Return an object representing the number two. 21905759b3d2Safresh1 21915759b3d2Safresh1=item CLASS-E<gt>_ten() 21925759b3d2Safresh1 21935759b3d2Safresh1Return an object representing the number ten. 21945759b3d2Safresh1 21955759b3d2Safresh1=item CLASS-E<gt>_from_bin(STR) 21965759b3d2Safresh1 21975759b3d2Safresh1Return an object given a string representing a binary number. The input has a 21985759b3d2Safresh1'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>. 21995759b3d2Safresh1 22005759b3d2Safresh1=item CLASS-E<gt>_from_oct(STR) 22015759b3d2Safresh1 22025759b3d2Safresh1Return an object given a string representing an octal number. The input has a 22035759b3d2Safresh1'0' prefix and matches the regular expression C<^0[1-7]*$>. 22045759b3d2Safresh1 22055759b3d2Safresh1=item CLASS-E<gt>_from_hex(STR) 22065759b3d2Safresh1 22075759b3d2Safresh1Return an object given a string representing a hexadecimal number. The input 22085759b3d2Safresh1has a '0x' prefix and matches the regular expression 22095759b3d2Safresh1C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>. 22105759b3d2Safresh1 22115759b3d2Safresh1=item CLASS-E<gt>_from_bytes(STR) 22125759b3d2Safresh1 22135759b3d2Safresh1Returns an object given a byte string representing the number. The byte string 22145759b3d2Safresh1is in big endian byte order, so the two-byte input string "\x01\x00" should 22155759b3d2Safresh1give an output value representing the number 256. 22165759b3d2Safresh1 2217f3efcd01Safresh1=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ) 2218f3efcd01Safresh1 2219f3efcd01Safresh1Returns an object given a string STR, a base BASE, and a collation sequence 2220f3efcd01Safresh1COLLSEQ. Each character in STR represents a numerical value identical to the 2221f3efcd01Safresh1character's position in COLLSEQ. All characters in STR must be present in 2222f3efcd01Safresh1COLLSEQ. 2223f3efcd01Safresh1 2224de8cc8edSafresh1If BASE is less than or equal to 94, and a collation sequence is not specified, 2225de8cc8edSafresh1the following default collation sequence is used. It contains of all the 94 2226de8cc8edSafresh1printable ASCII characters except space/blank: 2227de8cc8edSafresh1 2228de8cc8edSafresh1 0123456789 # ASCII 48 to 57 2229de8cc8edSafresh1 ABCDEFGHIJKLMNOPQRSTUVWXYZ # ASCII 65 to 90 2230de8cc8edSafresh1 abcdefghijklmnopqrstuvwxyz # ASCII 97 to 122 2231de8cc8edSafresh1 !"#$%&'()*+,-./ # ASCII 33 to 47 2232de8cc8edSafresh1 :;<=>?@ # ASCII 58 to 64 2233de8cc8edSafresh1 [\]^_` # ASCII 91 to 96 2234de8cc8edSafresh1 {|}~ # ASCII 123 to 126 2235de8cc8edSafresh1 2236de8cc8edSafresh1If the default collation sequence is used, and the BASE is less than or equal 2237de8cc8edSafresh1to 36, the letter case in STR is ignored. 2238f3efcd01Safresh1 2239f3efcd01Safresh1For instance, with base 3 and collation sequence "-/|", the character "-" 2240f3efcd01Safresh1represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the 2241f3efcd01Safresh1output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15. 2242f3efcd01Safresh1 2243f3efcd01Safresh1The following examples show standard binary, octal, decimal, and hexadecimal 2244f3efcd01Safresh1conversion. All examples return 250. 2245f3efcd01Safresh1 2246f3efcd01Safresh1 $x = $class -> _from_base("11111010", 2) 2247f3efcd01Safresh1 $x = $class -> _from_base("372", 8) 2248f3efcd01Safresh1 $x = $class -> _from_base("250", 10) 2249f3efcd01Safresh1 $x = $class -> _from_base("FA", 16) 2250f3efcd01Safresh1 2251f3efcd01Safresh1Some more examples, all returning 250: 2252f3efcd01Safresh1 2253de8cc8edSafresh1 $x = $class -> _from_base("100021", 3) 2254de8cc8edSafresh1 $x = $class -> _from_base("3322", 4) 2255de8cc8edSafresh1 $x = $class -> _from_base("2000", 5) 2256f3efcd01Safresh1 $x = $class -> _from_base("caaa", 5, "abcde") 2257de8cc8edSafresh1 $x = $class -> _from_base("42", 62) 2258de8cc8edSafresh1 $x = $class -> _from_base("2!", 94) 2259f3efcd01Safresh1 2260256a93a4Safresh1=item CLASS-E<gt>_from_base_num(ARRAY, BASE) 2261256a93a4Safresh1 2262256a93a4Safresh1Returns an object given an array of values and a base. This method is 2263256a93a4Safresh1equivalent to C<_from_base()>, but works on numbers in an array rather than 2264256a93a4Safresh1characters in a string. Unlike C<_from_base()>, all input values may be 2265256a93a4Safresh1arbitrarily large. 2266256a93a4Safresh1 2267256a93a4Safresh1 $x = $class -> _from_base_num([1, 1, 0, 1], 2) # $x is 13 2268256a93a4Safresh1 $x = $class -> _from_base_num([3, 125, 39], 128) # $x is 65191 2269256a93a4Safresh1 22705759b3d2Safresh1=back 22715759b3d2Safresh1 22725759b3d2Safresh1=head3 Mathematical functions 22735759b3d2Safresh1 22745759b3d2Safresh1=over 4 22755759b3d2Safresh1 22765759b3d2Safresh1=item CLASS-E<gt>_add(OBJ1, OBJ2) 22775759b3d2Safresh1 2278256a93a4Safresh1Addition. Returns the result of adding OBJ2 to OBJ1. 22795759b3d2Safresh1 22805759b3d2Safresh1=item CLASS-E<gt>_mul(OBJ1, OBJ2) 22815759b3d2Safresh1 2282256a93a4Safresh1Multiplication. Returns the result of multiplying OBJ2 and OBJ1. 22835759b3d2Safresh1 22845759b3d2Safresh1=item CLASS-E<gt>_div(OBJ1, OBJ2) 22855759b3d2Safresh1 2286256a93a4Safresh1Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2 2287256a93a4Safresh1and truncating the result to an integer. In list context, return the quotient 2288256a93a4Safresh1and the remainder. 22895759b3d2Safresh1 22905759b3d2Safresh1=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG) 22915759b3d2Safresh1 22925759b3d2Safresh1=item CLASS-E<gt>_sub(OBJ1, OBJ2) 22935759b3d2Safresh1 2294256a93a4Safresh1Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false 2295256a93a4Safresh1or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. 2296256a93a4Safresh1 2297256a93a4Safresh1=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2) 2298256a93a4Safresh1 2299256a93a4Safresh1Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with 2300256a93a4Safresh1sign SIGN1. 2301256a93a4Safresh1 2302256a93a4Safresh1 ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); 2303256a93a4Safresh1 2304256a93a4Safresh1=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2) 2305256a93a4Safresh1 2306256a93a4Safresh1Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to 2307256a93a4Safresh1OBJ1 with sign SIGN1. 2308256a93a4Safresh1 2309256a93a4Safresh1 ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); 23105759b3d2Safresh1 23115759b3d2Safresh1=item CLASS-E<gt>_dec(OBJ) 23125759b3d2Safresh1 23135759b3d2Safresh1Returns the result after decrementing OBJ by one. 23145759b3d2Safresh1 23155759b3d2Safresh1=item CLASS-E<gt>_inc(OBJ) 23165759b3d2Safresh1 23175759b3d2Safresh1Returns the result after incrementing OBJ by one. 23185759b3d2Safresh1 23195759b3d2Safresh1=item CLASS-E<gt>_mod(OBJ1, OBJ2) 23205759b3d2Safresh1 23215759b3d2Safresh1Returns OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2. 23225759b3d2Safresh1 23235759b3d2Safresh1=item CLASS-E<gt>_sqrt(OBJ) 23245759b3d2Safresh1 23255759b3d2Safresh1Returns the square root of OBJ, truncated to an integer. 23265759b3d2Safresh1 23275759b3d2Safresh1=item CLASS-E<gt>_root(OBJ, N) 23285759b3d2Safresh1 23295759b3d2Safresh1Returns the Nth root of OBJ, truncated to an integer. 23305759b3d2Safresh1 23315759b3d2Safresh1=item CLASS-E<gt>_fac(OBJ) 23325759b3d2Safresh1 23335759b3d2Safresh1Returns the factorial of OBJ, i.e., the product of all positive integers up to 23345759b3d2Safresh1and including OBJ. 23355759b3d2Safresh1 23365759b3d2Safresh1=item CLASS-E<gt>_dfac(OBJ) 23375759b3d2Safresh1 23385759b3d2Safresh1Returns the double factorial of OBJ. If OBJ is an even integer, returns the 23395759b3d2Safresh1product of all positive, even integers up to and including OBJ, i.e., 23405759b3d2Safresh12*4*6*...*OBJ. If OBJ is an odd integer, returns the product of all positive, 23415759b3d2Safresh1odd integers, i.e., 1*3*5*...*OBJ. 23425759b3d2Safresh1 23435759b3d2Safresh1=item CLASS-E<gt>_pow(OBJ1, OBJ2) 23445759b3d2Safresh1 23455759b3d2Safresh1Returns OBJ1 raised to the power of OBJ2. By convention, 0**0 = 1. 23465759b3d2Safresh1 23475759b3d2Safresh1=item CLASS-E<gt>_modinv(OBJ1, OBJ2) 23485759b3d2Safresh1 23495759b3d2Safresh1Returns the modular multiplicative inverse, i.e., return OBJ3 so that 23505759b3d2Safresh1 23515759b3d2Safresh1 (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2 23525759b3d2Safresh1 23535759b3d2Safresh1The result is returned as two arguments. If the modular multiplicative inverse 23545759b3d2Safresh1does not exist, both arguments are undefined. Otherwise, the arguments are a 23555759b3d2Safresh1number (object) and its sign ("+" or "-"). 23565759b3d2Safresh1 23575759b3d2Safresh1The output value, with its sign, must either be a positive value in the range 23585759b3d2Safresh11,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input 23595759b3d2Safresh1arguments are objects representing the numbers 7 and 5, the method must either 23605759b3d2Safresh1return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1 23615759b3d2Safresh1% 5, or an object representing the number 2 and a "-" sign, since (-2*7) % 5 = 1 23625759b3d2Safresh1% 5. 23635759b3d2Safresh1 23645759b3d2Safresh1=item CLASS-E<gt>_modpow(OBJ1, OBJ2, OBJ3) 23655759b3d2Safresh1 23665759b3d2Safresh1Returns the modular exponentiation, i.e., (OBJ1 ** OBJ2) % OBJ3. 23675759b3d2Safresh1 23685759b3d2Safresh1=item CLASS-E<gt>_rsft(OBJ, N, B) 23695759b3d2Safresh1 23705759b3d2Safresh1Returns the result after shifting OBJ N digits to thee right in base B. This is 23715759b3d2Safresh1equivalent to performing integer division by B**N and discarding the remainder, 23725759b3d2Safresh1except that it might be much faster. 23735759b3d2Safresh1 23745759b3d2Safresh1For instance, if the object $obj represents the hexadecimal number 0xabcde, 23755759b3d2Safresh1then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The 23765759b3d2Safresh1"remainer", 0xde, is discarded and not returned. 23775759b3d2Safresh1 23785759b3d2Safresh1=item CLASS-E<gt>_lsft(OBJ, N, B) 23795759b3d2Safresh1 23805759b3d2Safresh1Returns the result after shifting OBJ N digits to the left in base B. This is 23815759b3d2Safresh1equivalent to multiplying by B**N, except that it might be much faster. 23825759b3d2Safresh1 23835759b3d2Safresh1=item CLASS-E<gt>_log_int(OBJ, B) 23845759b3d2Safresh1 23855759b3d2Safresh1Returns the logarithm of OBJ to base BASE truncted to an integer. This method 23865759b3d2Safresh1has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; 23875759b3d2Safresh1it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ, 23885759b3d2Safresh1and undef if it is unknown whether OBJ is the exact result. 23895759b3d2Safresh1 2390*5486feefSafresh1=item CLASS-E<gt>_ilog2(OBJ) 2391*5486feefSafresh1 2392*5486feefSafresh1Returns the base 2 logarithm of OBJ rounded downwards to the nearest integer, 2393*5486feefSafresh1i.e., C<int(log2(OBJ))>. In list context, this method returns two output 2394*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ 2395*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it 2396*5486feefSafresh1is unknown whether OBJ is the exact result. 2397*5486feefSafresh1 2398*5486feefSafresh1This method is equivalent to the more general method _log_int() when it is used 2399*5486feefSafresh1with base 2 argument, but _ilog2() method might be faster. 2400*5486feefSafresh1 2401*5486feefSafresh1=item CLASS-E<gt>_ilog10(OBJ) 2402*5486feefSafresh1 2403*5486feefSafresh1Returns the base 10 logarithm of OBJ rounded downwards to the nearest integer, 2404*5486feefSafresh1i.e., C<int(log2(OBJ))>. In list context, this method returns two output 2405*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ 2406*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it 2407*5486feefSafresh1is unknown whether OBJ is the exact result. 2408*5486feefSafresh1 2409*5486feefSafresh1This method is equivalent to the more general method _log_int() when it is used 2410*5486feefSafresh1with base 10 argument, but _ilog10() method might be faster. 2411*5486feefSafresh1 2412*5486feefSafresh1Also, the output from _ilog10() is always 1 smaller than the output from 2413*5486feefSafresh1_len(). 2414*5486feefSafresh1 2415*5486feefSafresh1=item CLASS-E<gt>_clog2(OBJ) 2416*5486feefSafresh1 2417*5486feefSafresh1Returns the base 2 logarithm of OBJ rounded upwards to the nearest integer, 2418*5486feefSafresh1i.e., C<ceil(log2(OBJ))>. In list context, this method returns two output 2419*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ 2420*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it 2421*5486feefSafresh1is unknown whether OBJ is the exact result. 2422*5486feefSafresh1 2423*5486feefSafresh1=item CLASS-E<gt>_clog10(OBJ) 2424*5486feefSafresh1 2425*5486feefSafresh1Returns the base 10 logarithm of OBJ rounded upnwards to the nearest integer, 2426*5486feefSafresh1i.e., C<ceil(log2(OBJ))>. In list context, this method returns two output 2427*5486feefSafresh1arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ 2428*5486feefSafresh1is the exact result, 0 if the result was truncted to give OBJ, and undef if it 2429*5486feefSafresh1is unknown whether OBJ is the exact result. 2430*5486feefSafresh1 24315759b3d2Safresh1=item CLASS-E<gt>_gcd(OBJ1, OBJ2) 24325759b3d2Safresh1 24335759b3d2Safresh1Returns the greatest common divisor of OBJ1 and OBJ2. 24345759b3d2Safresh1 24355759b3d2Safresh1=item CLASS-E<gt>_lcm(OBJ1, OBJ2) 24365759b3d2Safresh1 24375759b3d2Safresh1Return the least common multiple of OBJ1 and OBJ2. 24385759b3d2Safresh1 24395759b3d2Safresh1=item CLASS-E<gt>_fib(OBJ) 24405759b3d2Safresh1 24415759b3d2Safresh1In scalar context, returns the nth Fibonacci number: _fib(0) returns 0, _fib(1) 24425759b3d2Safresh1returns 1, _fib(2) returns 1, _fib(3) returns 2 etc. In list context, returns 24435759b3d2Safresh1the Fibonacci numbers from F(0) to F(n): 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ... 24445759b3d2Safresh1 24455759b3d2Safresh1=item CLASS-E<gt>_lucas(OBJ) 24465759b3d2Safresh1 24475759b3d2Safresh1In scalar context, returns the nth Lucas number: _lucas(0) returns 2, _lucas(1) 24485759b3d2Safresh1returns 1, _lucas(2) returns 3, etc. In list context, returns the Lucas numbers 24495759b3d2Safresh1from L(0) to L(n): 2, 1, 3, 4, 7, 11, 18, 29,47, 76, ... 24505759b3d2Safresh1 24515759b3d2Safresh1=back 24525759b3d2Safresh1 24535759b3d2Safresh1=head3 Bitwise operators 24545759b3d2Safresh1 24555759b3d2Safresh1=over 4 24565759b3d2Safresh1 24575759b3d2Safresh1=item CLASS-E<gt>_and(OBJ1, OBJ2) 24585759b3d2Safresh1 24595759b3d2Safresh1Returns bitwise and. 24605759b3d2Safresh1 24615759b3d2Safresh1=item CLASS-E<gt>_or(OBJ1, OBJ2) 24625759b3d2Safresh1 2463f3efcd01Safresh1Returns bitwise or. 24645759b3d2Safresh1 24655759b3d2Safresh1=item CLASS-E<gt>_xor(OBJ1, OBJ2) 24665759b3d2Safresh1 2467f3efcd01Safresh1Returns bitwise exclusive or. 2468f3efcd01Safresh1 2469f3efcd01Safresh1=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2) 2470f3efcd01Safresh1 2471f3efcd01Safresh1Returns bitwise signed and. 2472f3efcd01Safresh1 2473f3efcd01Safresh1=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2) 2474f3efcd01Safresh1 2475f3efcd01Safresh1Returns bitwise signed or. 2476f3efcd01Safresh1 2477f3efcd01Safresh1=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2) 2478f3efcd01Safresh1 2479f3efcd01Safresh1Returns bitwise signed exclusive or. 24805759b3d2Safresh1 24815759b3d2Safresh1=back 24825759b3d2Safresh1 24835759b3d2Safresh1=head3 Boolean operators 24845759b3d2Safresh1 24855759b3d2Safresh1=over 4 24865759b3d2Safresh1 24875759b3d2Safresh1=item CLASS-E<gt>_is_zero(OBJ) 24885759b3d2Safresh1 24895759b3d2Safresh1Returns a true value if OBJ is zero, and false value otherwise. 24905759b3d2Safresh1 24915759b3d2Safresh1=item CLASS-E<gt>_is_one(OBJ) 24925759b3d2Safresh1 24935759b3d2Safresh1Returns a true value if OBJ is one, and false value otherwise. 24945759b3d2Safresh1 24955759b3d2Safresh1=item CLASS-E<gt>_is_two(OBJ) 24965759b3d2Safresh1 24975759b3d2Safresh1Returns a true value if OBJ is two, and false value otherwise. 24985759b3d2Safresh1 24995759b3d2Safresh1=item CLASS-E<gt>_is_ten(OBJ) 25005759b3d2Safresh1 25015759b3d2Safresh1Returns a true value if OBJ is ten, and false value otherwise. 25025759b3d2Safresh1 25035759b3d2Safresh1=item CLASS-E<gt>_is_even(OBJ) 25045759b3d2Safresh1 25055759b3d2Safresh1Return a true value if OBJ is an even integer, and a false value otherwise. 25065759b3d2Safresh1 25075759b3d2Safresh1=item CLASS-E<gt>_is_odd(OBJ) 25085759b3d2Safresh1 25095759b3d2Safresh1Return a true value if OBJ is an even integer, and a false value otherwise. 25105759b3d2Safresh1 25115759b3d2Safresh1=item CLASS-E<gt>_acmp(OBJ1, OBJ2) 25125759b3d2Safresh1 25135759b3d2Safresh1Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is numerically less than, 25145759b3d2Safresh1equal to, or larger than OBJ2, respectively. 25155759b3d2Safresh1 25165759b3d2Safresh1=back 25175759b3d2Safresh1 25185759b3d2Safresh1=head3 String conversion 25195759b3d2Safresh1 25205759b3d2Safresh1=over 4 25215759b3d2Safresh1 25225759b3d2Safresh1=item CLASS-E<gt>_str(OBJ) 25235759b3d2Safresh1 25245759b3d2Safresh1Returns a string representing OBJ in decimal notation. The returned string 25255759b3d2Safresh1should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>. 25265759b3d2Safresh1 25275759b3d2Safresh1=item CLASS-E<gt>_to_bin(OBJ) 25285759b3d2Safresh1 25295759b3d2Safresh1Returns the binary string representation of OBJ. 25305759b3d2Safresh1 25315759b3d2Safresh1=item CLASS-E<gt>_to_oct(OBJ) 25325759b3d2Safresh1 25335759b3d2Safresh1Returns the octal string representation of the number. 25345759b3d2Safresh1 25355759b3d2Safresh1=item CLASS-E<gt>_to_hex(OBJ) 25365759b3d2Safresh1 25375759b3d2Safresh1Returns the hexadecimal string representation of the number. 25385759b3d2Safresh1 25395759b3d2Safresh1=item CLASS-E<gt>_to_bytes(OBJ) 25405759b3d2Safresh1 25415759b3d2Safresh1Returns a byte string representation of OBJ. The byte string is in big endian 25425759b3d2Safresh1byte order, so if OBJ represents the number 256, the output should be the 25435759b3d2Safresh1two-byte string "\x01\x00". 25445759b3d2Safresh1 2545f3efcd01Safresh1=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ) 2546f3efcd01Safresh1 2547f3efcd01Safresh1Returns a string representation of OBJ in base BASE with collation sequence 2548f3efcd01Safresh1COLLSEQ. 2549f3efcd01Safresh1 2550f3efcd01Safresh1 $val = $class -> _new("210"); 2551f3efcd01Safresh1 $str = $class -> _to_base($val, 10, "xyz") # $str is "zyx" 2552f3efcd01Safresh1 2553f3efcd01Safresh1 $val = $class -> _new("32"); 2554f3efcd01Safresh1 $str = $class -> _to_base($val, 2, "-|") # $str is "|-----" 2555f3efcd01Safresh1 2556f3efcd01Safresh1See _from_base() for more information. 2557f3efcd01Safresh1 2558256a93a4Safresh1=item CLASS-E<gt>_to_base_num(OBJ, BASE) 2559256a93a4Safresh1 2560256a93a4Safresh1Converts the given number to the given base. This method is equivalent to 2561256a93a4Safresh1C<_to_base()>, but returns numbers in an array rather than characters in a 2562256a93a4Safresh1string. In the output, the first element is the most significant. Unlike 2563256a93a4Safresh1C<_to_base()>, all input values may be arbitrarily large. 2564256a93a4Safresh1 2565256a93a4Safresh1 $x = $class -> _to_base_num(13, 2) # $x is [1, 1, 0, 1] 2566256a93a4Safresh1 $x = $class -> _to_base_num(65191, 128) # $x is [3, 125, 39] 2567256a93a4Safresh1 25685759b3d2Safresh1=item CLASS-E<gt>_as_bin(OBJ) 25695759b3d2Safresh1 25705759b3d2Safresh1Like C<_to_bin()> but with a '0b' prefix. 25715759b3d2Safresh1 25725759b3d2Safresh1=item CLASS-E<gt>_as_oct(OBJ) 25735759b3d2Safresh1 25745759b3d2Safresh1Like C<_to_oct()> but with a '0' prefix. 25755759b3d2Safresh1 25765759b3d2Safresh1=item CLASS-E<gt>_as_hex(OBJ) 25775759b3d2Safresh1 25785759b3d2Safresh1Like C<_to_hex()> but with a '0x' prefix. 25795759b3d2Safresh1 25805759b3d2Safresh1=item CLASS-E<gt>_as_bytes(OBJ) 25815759b3d2Safresh1 25825759b3d2Safresh1This is an alias to C<_to_bytes()>. 25835759b3d2Safresh1 25845759b3d2Safresh1=back 25855759b3d2Safresh1 25865759b3d2Safresh1=head3 Numeric conversion 25875759b3d2Safresh1 25885759b3d2Safresh1=over 4 25895759b3d2Safresh1 25905759b3d2Safresh1=item CLASS-E<gt>_num(OBJ) 25915759b3d2Safresh1 25925759b3d2Safresh1Returns a Perl scalar number representing the number OBJ as close as 25935759b3d2Safresh1possible. Since Perl scalars have limited precision, the returned value might 25945759b3d2Safresh1not be exactly the same as OBJ. 25955759b3d2Safresh1 25965759b3d2Safresh1=back 25975759b3d2Safresh1 25985759b3d2Safresh1=head3 Miscellaneous 25995759b3d2Safresh1 26005759b3d2Safresh1=over 4 26015759b3d2Safresh1 26025759b3d2Safresh1=item CLASS-E<gt>_copy(OBJ) 26035759b3d2Safresh1 26045759b3d2Safresh1Returns a true copy OBJ. 26055759b3d2Safresh1 26065759b3d2Safresh1=item CLASS-E<gt>_len(OBJ) 26075759b3d2Safresh1 26085759b3d2Safresh1Returns the number of the decimal digits in OBJ. The output is a Perl scalar. 26095759b3d2Safresh1 26105759b3d2Safresh1=item CLASS-E<gt>_zeros(OBJ) 26115759b3d2Safresh1 26125759b3d2Safresh1Returns the number of trailing decimal zeros. The output is a Perl scalar. The 26135759b3d2Safresh1number zero has no trailing decimal zeros. 26145759b3d2Safresh1 26155759b3d2Safresh1=item CLASS-E<gt>_digit(OBJ, N) 26165759b3d2Safresh1 26175759b3d2Safresh1Returns the Nth digit in OBJ as a Perl scalar. N is a Perl scalar, where zero 26185759b3d2Safresh1refers to the rightmost (least significant) digit, and negative values count 26195759b3d2Safresh1from the left (most significant digit). If $obj represents the number 123, then 26205759b3d2Safresh1 26215759b3d2Safresh1 CLASS->_digit($obj, 0) # returns 3 26225759b3d2Safresh1 CLASS->_digit($obj, 1) # returns 2 26235759b3d2Safresh1 CLASS->_digit($obj, 2) # returns 1 26245759b3d2Safresh1 CLASS->_digit($obj, -1) # returns 1 26255759b3d2Safresh1 2626de8cc8edSafresh1=item CLASS-E<gt>_digitsum(OBJ) 2627de8cc8edSafresh1 2628de8cc8edSafresh1Returns the sum of the base 10 digits. 2629de8cc8edSafresh1 26305759b3d2Safresh1=item CLASS-E<gt>_check(OBJ) 26315759b3d2Safresh1 26325759b3d2Safresh1Returns true if the object is invalid and false otherwise. Preferably, the true 26335759b3d2Safresh1value is a string describing the problem with the object. This is a check 26345759b3d2Safresh1routine to test the internal state of the object for corruption. 26355759b3d2Safresh1 26365759b3d2Safresh1=item CLASS-E<gt>_set(OBJ) 26375759b3d2Safresh1 26385759b3d2Safresh1xxx 26395759b3d2Safresh1 26405759b3d2Safresh1=back 26415759b3d2Safresh1 26425759b3d2Safresh1=head2 API version 2 26435759b3d2Safresh1 26445759b3d2Safresh1The following methods are required for an API version of 2 or greater. 26455759b3d2Safresh1 26465759b3d2Safresh1=head3 Constructors 26475759b3d2Safresh1 26485759b3d2Safresh1=over 4 26495759b3d2Safresh1 26505759b3d2Safresh1=item CLASS-E<gt>_1ex(N) 26515759b3d2Safresh1 26525759b3d2Safresh1Return an object representing the number 10**N where N E<gt>= 0 is a Perl 26535759b3d2Safresh1scalar. 26545759b3d2Safresh1 26555759b3d2Safresh1=back 26565759b3d2Safresh1 26575759b3d2Safresh1=head3 Mathematical functions 26585759b3d2Safresh1 26595759b3d2Safresh1=over 4 26605759b3d2Safresh1 26615759b3d2Safresh1=item CLASS-E<gt>_nok(OBJ1, OBJ2) 26625759b3d2Safresh1 26635759b3d2Safresh1Return the binomial coefficient OBJ1 over OBJ1. 26645759b3d2Safresh1 26655759b3d2Safresh1=back 26665759b3d2Safresh1 26675759b3d2Safresh1=head3 Miscellaneous 26685759b3d2Safresh1 26695759b3d2Safresh1=over 4 26705759b3d2Safresh1 26715759b3d2Safresh1=item CLASS-E<gt>_alen(OBJ) 26725759b3d2Safresh1 26735759b3d2Safresh1Return the approximate number of decimal digits of the object. The output is a 26745759b3d2Safresh1Perl scalar. 26755759b3d2Safresh1 26765759b3d2Safresh1=back 26775759b3d2Safresh1 26785759b3d2Safresh1=head1 WRAP YOUR OWN 26795759b3d2Safresh1 26805759b3d2Safresh1If you want to port your own favourite C library for big numbers to the 26815759b3d2Safresh1Math::BigInt interface, you can take any of the already existing modules as a 26825759b3d2Safresh1rough guideline. You should really wrap up the latest Math::BigInt and 26835759b3d2Safresh1Math::BigFloat testsuites with your module, and replace in them any of the 26845759b3d2Safresh1following: 26855759b3d2Safresh1 26865759b3d2Safresh1 use Math::BigInt; 26875759b3d2Safresh1 26885759b3d2Safresh1by this: 26895759b3d2Safresh1 26905759b3d2Safresh1 use Math::BigInt lib => 'yourlib'; 26915759b3d2Safresh1 26925759b3d2Safresh1This way you ensure that your library really works 100% within Math::BigInt. 26935759b3d2Safresh1 26945759b3d2Safresh1=head1 BUGS 26955759b3d2Safresh1 26965759b3d2Safresh1Please report any bugs or feature requests to 26975759b3d2Safresh1C<bug-math-bigint at rt.cpan.org>, or through the web interface at 26985759b3d2Safresh1L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> 26995759b3d2Safresh1(requires login). 27005759b3d2Safresh1We will be notified, and then you'll automatically be notified of progress on 27015759b3d2Safresh1your bug as I make changes. 27025759b3d2Safresh1 27035759b3d2Safresh1=head1 SUPPORT 27045759b3d2Safresh1 27055759b3d2Safresh1You can find documentation for this module with the perldoc command. 27065759b3d2Safresh1 27075759b3d2Safresh1 perldoc Math::BigInt::Calc 27085759b3d2Safresh1 27095759b3d2Safresh1You can also look for information at: 27105759b3d2Safresh1 27115759b3d2Safresh1=over 4 27125759b3d2Safresh1 2713*5486feefSafresh1=item * GitHub Source Repository 2714*5486feefSafresh1 2715*5486feefSafresh1L<https://github.com/pjacklam/p5-Math-BigInt> 2716*5486feefSafresh1 27175759b3d2Safresh1=item * RT: CPAN's request tracker 27185759b3d2Safresh1 27195759b3d2Safresh1L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt> 27205759b3d2Safresh1 2721de8cc8edSafresh1=item * MetaCPAN 27225759b3d2Safresh1 2723de8cc8edSafresh1L<https://metacpan.org/release/Math-BigInt> 27245759b3d2Safresh1 27255759b3d2Safresh1=item * CPAN Testers Matrix 27265759b3d2Safresh1 27275759b3d2Safresh1L<http://matrix.cpantesters.org/?dist=Math-BigInt> 27285759b3d2Safresh1 27295759b3d2Safresh1=back 27305759b3d2Safresh1 27315759b3d2Safresh1=head1 LICENSE 27325759b3d2Safresh1 27335759b3d2Safresh1This program is free software; you may redistribute it and/or modify it under 27345759b3d2Safresh1the same terms as Perl itself. 27355759b3d2Safresh1 27365759b3d2Safresh1=head1 AUTHOR 27375759b3d2Safresh1 2738256a93a4Safresh1Peter John Acklam, E<lt>pjacklam@gmail.comE<gt> 27395759b3d2Safresh1 27405759b3d2Safresh1Code and documentation based on the Math::BigInt::Calc module by Tels 27415759b3d2Safresh1E<lt>nospam-abuse@bloodgate.comE<gt> 27425759b3d2Safresh1 27435759b3d2Safresh1=head1 SEE ALSO 27445759b3d2Safresh1 27455759b3d2Safresh1L<Math::BigInt>, L<Math::BigInt::Calc>, L<Math::BigInt::GMP>, 27465759b3d2Safresh1L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>. 27475759b3d2Safresh1 27485759b3d2Safresh1=cut 2749