1package Math::BigInt::Lib; 2 3use 5.006001; 4use strict; 5use warnings; 6 7our $VERSION = '1.999818'; 8 9use Carp; 10 11use overload 12 13 # overload key: with_assign 14 15 '+' => sub { 16 my $class = ref $_[0]; 17 my $x = $class -> _copy($_[0]); 18 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 19 return $class -> _add($x, $y); 20 }, 21 22 '-' => sub { 23 my $class = ref $_[0]; 24 my ($x, $y); 25 if ($_[2]) { # if swapped 26 $y = $_[0]; 27 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 28 } else { 29 $x = $class -> _copy($_[0]); 30 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 31 } 32 return $class -> _sub($x, $y); 33 }, 34 35 '*' => sub { 36 my $class = ref $_[0]; 37 my $x = $class -> _copy($_[0]); 38 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 39 return $class -> _mul($x, $y); 40 }, 41 42 '/' => sub { 43 my $class = ref $_[0]; 44 my ($x, $y); 45 if ($_[2]) { # if swapped 46 $y = $_[0]; 47 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 48 } else { 49 $x = $class -> _copy($_[0]); 50 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 51 } 52 return $class -> _div($x, $y); 53 }, 54 55 '%' => sub { 56 my $class = ref $_[0]; 57 my ($x, $y); 58 if ($_[2]) { # if swapped 59 $y = $_[0]; 60 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 61 } else { 62 $x = $class -> _copy($_[0]); 63 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 64 } 65 return $class -> _mod($x, $y); 66 }, 67 68 '**' => sub { 69 my $class = ref $_[0]; 70 my ($x, $y); 71 if ($_[2]) { # if swapped 72 $y = $_[0]; 73 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 74 } else { 75 $x = $class -> _copy($_[0]); 76 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 77 } 78 return $class -> _pow($x, $y); 79 }, 80 81 '<<' => sub { 82 my $class = ref $_[0]; 83 my ($x, $y); 84 if ($_[2]) { # if swapped 85 $y = $class -> _num($_[0]); 86 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 87 } else { 88 $x = $_[0]; 89 $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1]; 90 } 91 return $class -> _blsft($x, $y); 92 }, 93 94 '>>' => sub { 95 my $class = ref $_[0]; 96 my ($x, $y); 97 if ($_[2]) { # if swapped 98 $y = $_[0]; 99 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 100 } else { 101 $x = $class -> _copy($_[0]); 102 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 103 } 104 return $class -> _brsft($x, $y); 105 }, 106 107 # overload key: num_comparison 108 109 '<' => sub { 110 my $class = ref $_[0]; 111 my ($x, $y); 112 if ($_[2]) { # if swapped 113 $y = $_[0]; 114 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 115 } else { 116 $x = $class -> _copy($_[0]); 117 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 118 } 119 return $class -> _acmp($x, $y) < 0; 120 }, 121 122 '<=' => sub { 123 my $class = ref $_[0]; 124 my ($x, $y); 125 if ($_[2]) { # if swapped 126 $y = $_[0]; 127 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 128 } else { 129 $x = $class -> _copy($_[0]); 130 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 131 } 132 return $class -> _acmp($x, $y) <= 0; 133 }, 134 135 '>' => sub { 136 my $class = ref $_[0]; 137 my ($x, $y); 138 if ($_[2]) { # if swapped 139 $y = $_[0]; 140 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 141 } else { 142 $x = $class -> _copy($_[0]); 143 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 144 } 145 return $class -> _acmp($x, $y) > 0; 146 }, 147 148 '>=' => sub { 149 my $class = ref $_[0]; 150 my ($x, $y); 151 if ($_[2]) { # if swapped 152 $y = $_[0]; 153 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 154 } else { 155 $x = $class -> _copy($_[0]); 156 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 157 } 158 return $class -> _acmp($x, $y) >= 0; 159 }, 160 161 '==' => sub { 162 my $class = ref $_[0]; 163 my $x = $class -> _copy($_[0]); 164 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 165 return $class -> _acmp($x, $y) == 0; 166 }, 167 168 '!=' => sub { 169 my $class = ref $_[0]; 170 my $x = $class -> _copy($_[0]); 171 my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 172 return $class -> _acmp($x, $y) != 0; 173 }, 174 175 # overload key: 3way_comparison 176 177 '<=>' => sub { 178 my $class = ref $_[0]; 179 my ($x, $y); 180 if ($_[2]) { # if swapped 181 $y = $_[0]; 182 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 183 } else { 184 $x = $class -> _copy($_[0]); 185 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 186 } 187 return $class -> _acmp($x, $y); 188 }, 189 190 # overload key: binary 191 192 '&' => sub { 193 my $class = ref $_[0]; 194 my ($x, $y); 195 if ($_[2]) { # if swapped 196 $y = $_[0]; 197 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 198 } else { 199 $x = $class -> _copy($_[0]); 200 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 201 } 202 return $class -> _and($x, $y); 203 }, 204 205 '|' => sub { 206 my $class = ref $_[0]; 207 my ($x, $y); 208 if ($_[2]) { # if swapped 209 $y = $_[0]; 210 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 211 } else { 212 $x = $class -> _copy($_[0]); 213 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 214 } 215 return $class -> _or($x, $y); 216 }, 217 218 '^' => sub { 219 my $class = ref $_[0]; 220 my ($x, $y); 221 if ($_[2]) { # if swapped 222 $y = $_[0]; 223 $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 224 } else { 225 $x = $class -> _copy($_[0]); 226 $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]); 227 } 228 return $class -> _xor($x, $y); 229 }, 230 231 # overload key: func 232 233 'abs' => sub { $_[0] }, 234 235 'sqrt' => sub { 236 my $class = ref $_[0]; 237 return $class -> _sqrt($class -> _copy($_[0])); 238 }, 239 240 'int' => sub { $_[0] }, 241 242 # overload key: conversion 243 244 'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; }, 245 246 '""' => sub { ref($_[0]) -> _str($_[0]); }, 247 248 '0+' => sub { ref($_[0]) -> _num($_[0]); }, 249 250 '=' => sub { ref($_[0]) -> _copy($_[0]); }, 251 252 ; 253 254sub _new { 255 croak "@{[(caller 0)[3]]} method not implemented"; 256} 257 258sub _zero { 259 my $class = shift; 260 return $class -> _new("0"); 261} 262 263sub _one { 264 my $class = shift; 265 return $class -> _new("1"); 266} 267 268sub _two { 269 my $class = shift; 270 return $class -> _new("2"); 271 272} 273sub _ten { 274 my $class = shift; 275 return $class -> _new("10"); 276} 277 278sub _1ex { 279 my ($class, $exp) = @_; 280 $exp = $class -> _num($exp) if ref($exp); 281 return $class -> _new("1" . ("0" x $exp)); 282} 283 284sub _copy { 285 my ($class, $x) = @_; 286 return $class -> _new($class -> _str($x)); 287} 288 289# catch and throw away 290sub import { } 291 292############################################################################## 293# convert back to string and number 294 295sub _str { 296 # Convert number from internal base 1eN format to string format. Internal 297 # format is always normalized, i.e., no leading zeros. 298 croak "@{[(caller 0)[3]]} method not implemented"; 299} 300 301sub _num { 302 my ($class, $x) = @_; 303 0 + $class -> _str($x); 304} 305 306############################################################################## 307# actual math code 308 309sub _add { 310 croak "@{[(caller 0)[3]]} method not implemented"; 311} 312 313sub _sub { 314 croak "@{[(caller 0)[3]]} method not implemented"; 315} 316 317sub _mul { 318 my ($class, $x, $y) = @_; 319 my $sum = $class -> _zero(); 320 my $i = $class -> _zero(); 321 while ($class -> _acmp($i, $y) < 0) { 322 $sum = $class -> _add($sum, $x); 323 $i = $class -> _inc($i); 324 } 325 return $sum; 326} 327 328sub _div { 329 my ($class, $x, $y) = @_; 330 331 croak "@{[(caller 0)[3]]} requires non-zero divisor" 332 if $class -> _is_zero($y); 333 334 my $r = $class -> _copy($x); 335 my $q = $class -> _zero(); 336 while ($class -> _acmp($r, $y) >= 0) { 337 $q = $class -> _inc($q); 338 $r = $class -> _sub($r, $y); 339 } 340 341 return $q, $r if wantarray; 342 return $q; 343} 344 345sub _inc { 346 my ($class, $x) = @_; 347 $class -> _add($x, $class -> _one()); 348} 349 350sub _dec { 351 my ($class, $x) = @_; 352 $class -> _sub($x, $class -> _one()); 353} 354 355############################################################################## 356# testing 357 358sub _acmp { 359 # Compare two (absolute) values. Return -1, 0, or 1. 360 my ($class, $x, $y) = @_; 361 my $xstr = $class -> _str($x); 362 my $ystr = $class -> _str($y); 363 364 length($xstr) <=> length($ystr) || $xstr cmp $ystr; 365} 366 367sub _len { 368 my ($class, $x) = @_; 369 CORE::length($class -> _str($x)); 370} 371 372sub _alen { 373 my ($class, $x) = @_; 374 $class -> _len($x); 375} 376 377sub _digit { 378 my ($class, $x, $n) = @_; 379 substr($class ->_str($x), -($n+1), 1); 380} 381 382sub _digitsum { 383 my ($class, $x) = @_; 384 385 my $len = $class -> _len($x); 386 my $sum = $class -> _zero(); 387 for (my $i = 0 ; $i < $len ; ++$i) { 388 my $digit = $class -> _digit($x, $i); 389 $digit = $class -> _new($digit); 390 $sum = $class -> _add($sum, $digit); 391 } 392 393 return $sum; 394} 395 396sub _zeros { 397 my ($class, $x) = @_; 398 my $str = $class -> _str($x); 399 $str =~ /[^0](0*)\z/ ? CORE::length($1) : 0; 400} 401 402############################################################################## 403# _is_* routines 404 405sub _is_zero { 406 # return true if arg is zero 407 my ($class, $x) = @_; 408 $class -> _str($x) == 0; 409} 410 411sub _is_even { 412 # return true if arg is even 413 my ($class, $x) = @_; 414 substr($class -> _str($x), -1, 1) % 2 == 0; 415} 416 417sub _is_odd { 418 # return true if arg is odd 419 my ($class, $x) = @_; 420 substr($class -> _str($x), -1, 1) % 2 != 0; 421} 422 423sub _is_one { 424 # return true if arg is one 425 my ($class, $x) = @_; 426 $class -> _str($x) == 1; 427} 428 429sub _is_two { 430 # return true if arg is two 431 my ($class, $x) = @_; 432 $class -> _str($x) == 2; 433} 434 435sub _is_ten { 436 # return true if arg is ten 437 my ($class, $x) = @_; 438 $class -> _str($x) == 10; 439} 440 441############################################################################### 442# check routine to test internal state for corruptions 443 444sub _check { 445 # used by the test suite 446 my ($class, $x) = @_; 447 return "Input is undefined" unless defined $x; 448 return "$x is not a reference" unless ref($x); 449 return 0; 450} 451 452############################################################################### 453 454sub _mod { 455 # modulus 456 my ($class, $x, $y) = @_; 457 458 croak "@{[(caller 0)[3]]} requires non-zero second operand" 459 if $class -> _is_zero($y); 460 461 if ($class -> can('_div')) { 462 $x = $class -> _copy($x); 463 my ($q, $r) = $class -> _div($x, $y); 464 return $r; 465 } else { 466 my $r = $class -> _copy($x); 467 while ($class -> _acmp($r, $y) >= 0) { 468 $r = $class -> _sub($r, $y); 469 } 470 return $r; 471 } 472} 473 474############################################################################## 475# shifts 476 477sub _rsft { 478 my ($class, $x, $n, $b) = @_; 479 $b = $class -> _new($b) unless ref $b; 480 return scalar $class -> _div($x, $class -> _pow($class -> _copy($b), $n)); 481} 482 483sub _lsft { 484 my ($class, $x, $n, $b) = @_; 485 $b = $class -> _new($b) unless ref $b; 486 return $class -> _mul($x, $class -> _pow($class -> _copy($b), $n)); 487} 488 489sub _pow { 490 # power of $x to $y 491 my ($class, $x, $y) = @_; 492 493 if ($class -> _is_zero($y)) { 494 return $class -> _one(); # y == 0 => x => 1 495 } 496 497 if (($class -> _is_one($x)) || # x == 1 498 ($class -> _is_one($y))) # or y == 1 499 { 500 return $x; 501 } 502 503 if ($class -> _is_zero($x)) { 504 return $class -> _zero(); # 0 ** y => 0 (if not y <= 0) 505 } 506 507 my $pow2 = $class -> _one(); 508 509 my $y_bin = $class -> _as_bin($y); 510 $y_bin =~ s/^0b//; 511 my $len = length($y_bin); 512 513 while (--$len > 0) { 514 $pow2 = $class -> _mul($pow2, $x) if substr($y_bin, $len, 1) eq '1'; 515 $x = $class -> _mul($x, $x); 516 } 517 518 $x = $class -> _mul($x, $pow2); 519 return $x; 520} 521 522sub _nok { 523 # Return binomial coefficient (n over k). 524 my ($class, $n, $k) = @_; 525 526 # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as 527 # nok(n, n-k), to minimize the number if iterations in the loop. 528 529 { 530 my $twok = $class -> _mul($class -> _two(), $class -> _copy($k)); 531 if ($class -> _acmp($twok, $n) > 0) { 532 $k = $class -> _sub($class -> _copy($n), $k); 533 } 534 } 535 536 # Example: 537 # 538 # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 539 # | | = --------- = --------------- = --------- = ((5 * 6) / 2 * 7) / 3 540 # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 541 # 542 # Equivalently, _nok(11, 5) is computed as 543 # 544 # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5 545 546 if ($class -> _is_zero($k)) { 547 return $class -> _one(); 548 } 549 550 # Make a copy of the original n, in case the subclass modifies n in-place. 551 552 my $n_orig = $class -> _copy($n); 553 554 # n = 5, f = 6, d = 2 (cf. example above) 555 556 $n = $class -> _sub($n, $k); 557 $n = $class -> _inc($n); 558 559 my $f = $class -> _copy($n); 560 $f = $class -> _inc($f); 561 562 my $d = $class -> _two(); 563 564 # while f <= n (the original n, that is) ... 565 566 while ($class -> _acmp($f, $n_orig) <= 0) { 567 $n = $class -> _mul($n, $f); 568 $n = $class -> _div($n, $d); 569 $f = $class -> _inc($f); 570 $d = $class -> _inc($d); 571 } 572 573 return $n; 574} 575 576sub _fac { 577 # factorial 578 my ($class, $x) = @_; 579 580 my $two = $class -> _two(); 581 582 if ($class -> _acmp($x, $two) < 0) { 583 return $class -> _one(); 584 } 585 586 my $i = $class -> _copy($x); 587 while ($class -> _acmp($i, $two) > 0) { 588 $i = $class -> _dec($i); 589 $x = $class -> _mul($x, $i); 590 } 591 592 return $x; 593} 594 595sub _dfac { 596 # double factorial 597 my ($class, $x) = @_; 598 599 my $two = $class -> _two(); 600 601 if ($class -> _acmp($x, $two) < 0) { 602 return $class -> _one(); 603 } 604 605 my $i = $class -> _copy($x); 606 while ($class -> _acmp($i, $two) > 0) { 607 $i = $class -> _sub($i, $two); 608 $x = $class -> _mul($x, $i); 609 } 610 611 return $x; 612} 613 614sub _log_int { 615 # calculate integer log of $x to base $base 616 # calculate integer log of $x to base $base 617 # ref to array, ref to array - return ref to array 618 my ($class, $x, $base) = @_; 619 620 # X == 0 => NaN 621 return if $class -> _is_zero($x); 622 623 $base = $class -> _new(2) unless defined($base); 624 $base = $class -> _new($base) unless ref($base); 625 626 # BASE 0 or 1 => NaN 627 return if $class -> _is_zero($base) || $class -> _is_one($base); 628 629 # X == 1 => 0 (is exact) 630 if ($class -> _is_one($x)) { 631 return $class -> _zero(), 1; 632 } 633 634 my $cmp = $class -> _acmp($x, $base); 635 636 # X == BASE => 1 (is exact) 637 if ($cmp == 0) { 638 return $class -> _one(), 1; 639 } 640 641 # 1 < X < BASE => 0 (is truncated) 642 if ($cmp < 0) { 643 return $class -> _zero(), 0; 644 } 645 646 my $y; 647 648 # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be) 649 # = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10)) 650 651 { 652 my $x_str = $class -> _str($x); 653 my $b_str = $class -> _str($base); 654 my $xm = "." . $x_str; 655 my $bm = "." . $b_str; 656 my $xe = length($x_str); 657 my $be = length($b_str); 658 my $log10 = log(10); 659 my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10)); 660 $y = $class -> _new($guess); 661 } 662 663 my $trial = $class -> _pow($class -> _copy($base), $y); 664 my $acmp = $class -> _acmp($trial, $x); 665 666 # Did we get the exact result? 667 668 return $y, 1 if $acmp == 0; 669 670 # Too small? 671 672 while ($acmp < 0) { 673 $trial = $class -> _mul($trial, $base); 674 $y = $class -> _inc($y); 675 $acmp = $class -> _acmp($trial, $x); 676 } 677 678 # Too big? 679 680 while ($acmp > 0) { 681 $trial = $class -> _div($trial, $base); 682 $y = $class -> _dec($y); 683 $acmp = $class -> _acmp($trial, $x); 684 } 685 686 return $y, 1 if $acmp == 0; # result is exact 687 return $y, 0; # result is too small 688} 689 690sub _sqrt { 691 # square-root of $y in place 692 my ($class, $y) = @_; 693 694 return $y if $class -> _is_zero($y); 695 696 my $y_str = $class -> _str($y); 697 my $y_len = length($y_str); 698 699 # Compute the guess $x. 700 701 my $xm; 702 my $xe; 703 if ($y_len % 2 == 0) { 704 $xm = sqrt("." . $y_str); 705 $xe = $y_len / 2; 706 $xm = sprintf "%.0f", int($xm * 1e15); 707 $xe -= 15; 708 } else { 709 $xm = sqrt(".0" . $y_str); 710 $xe = ($y_len + 1) / 2; 711 $xm = sprintf "%.0f", int($xm * 1e16); 712 $xe -= 16; 713 } 714 715 my $x; 716 if ($xe < 0) { 717 $x = substr $xm, 0, length($xm) + $xe; 718 } else { 719 $x = $xm . ("0" x $xe); 720 } 721 722 $x = $class -> _new($x); 723 724 # Newton's method for computing square root of y 725 # 726 # x(i+1) = x(i) - f(x(i)) / f'(x(i)) 727 # = x(i) - (x(i)^2 - y) / (2 * x(i)) # use if x(i)^2 > y 728 # = y(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y 729 730 # Determine if x, our guess, is too small, correct, or too large. 731 732 my $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 733 my $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 734 735 # Only assign a value to this variable if we will be using it. 736 737 my $two; 738 $two = $class -> _two() if $acmp != 0; 739 740 # If x is too small, do one iteration of Newton's method. Since the 741 # function f(x) = x^2 - y is concave and monotonically increasing, the next 742 # guess for x will either be correct or too large. 743 744 if ($acmp < 0) { 745 746 # x(i+1) = x(i) + (y - x(i)^2) / (2 * x(i)) 747 748 my $numer = $class -> _sub($class -> _copy($y), $xsq); # y - x(i)^2 749 my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i) 750 my $delta = $class -> _div($numer, $denom); 751 752 unless ($class -> _is_zero($delta)) { 753 $x = $class -> _add($x, $delta); 754 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 755 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 756 } 757 } 758 759 # If our guess for x is too large, apply Newton's method repeatedly until 760 # we either have got the correct value, or the delta is zero. 761 762 while ($acmp > 0) { 763 764 # x(i+1) = x(i) - (x(i)^2 - y) / (2 * x(i)) 765 766 my $numer = $class -> _sub($xsq, $y); # x(i)^2 - y 767 my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i) 768 my $delta = $class -> _div($numer, $denom); 769 last if $class -> _is_zero($delta); 770 771 $x = $class -> _sub($x, $delta); 772 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 773 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 774 } 775 776 # When the delta is zero, our value for x might still be too large. We 777 # require that the outout is either exact or too small (i.e., rounded down 778 # to the nearest integer), so do a final check. 779 780 while ($acmp > 0) { 781 $x = $class -> _dec($x); 782 $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2 783 $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y 784 } 785 786 return $x; 787} 788 789sub _root { 790 my ($class, $y, $n) = @_; 791 792 return $y if $class -> _is_zero($y) || $class -> _is_one($y) || 793 $class -> _is_one($n); 794 795 # If y <= n, the result is always (truncated to) 1. 796 797 return $class -> _one() if $class -> _acmp($y, $n) <= 0; 798 799 # Compute the initial guess x of y^(1/n). When n is large, Newton's method 800 # converges slowly if the "guess" (initial value) is poor, so we need a 801 # good guess. It the guess is too small, the next guess will be too large, 802 # and from then on all guesses are too large. 803 804 my $DEBUG = 0; 805 806 # Split y into mantissa and exponent in base 10, so that 807 # 808 # y = xm * 10^xe, where 0 < xm < 1 and xe is an integer 809 810 my $y_str = $class -> _str($y); 811 my $ym = "." . $y_str; 812 my $ye = length($y_str); 813 814 # From this compute the approximate base 10 logarithm of y 815 # 816 # log_10(y) = log_10(ym) + log_10(ye^10) 817 # = log(ym)/log(10) + ye 818 819 my $log10y = log($ym) / log(10) + $ye; 820 821 # And from this compute the approximate base 10 logarithm of x, where 822 # x = y^(1/n) 823 # 824 # log_10(x) = log_10(y)/n 825 826 my $log10x = $log10y / $class -> _num($n); 827 828 # From this compute xm and xe, the mantissa and exponent (in base 10) of x, 829 # where 1 < xm <= 10 and xe is an integer. 830 831 my $xe = int $log10x; 832 my $xm = 10 ** ($log10x - $xe); 833 834 # Scale the mantissa and exponent to increase the integer part of ym, which 835 # gives us better accuracy. 836 837 if ($DEBUG) { 838 print "\n"; 839 print "y_str = $y_str\n"; 840 print "ym = $ym\n"; 841 print "ye = $ye\n"; 842 print "log10y = $log10y\n"; 843 print "log10x = $log10x\n"; 844 print "xm = $xm\n"; 845 print "xe = $xe\n"; 846 } 847 848 my $d = $xe < 15 ? $xe : 15; 849 $xm *= 10 ** $d; 850 $xe -= $d; 851 852 if ($DEBUG) { 853 print "\n"; 854 print "xm = $xm\n"; 855 print "xe = $xe\n"; 856 } 857 858 # If the mantissa is not an integer, round up to nearest integer, and then 859 # convert the number to a string. It is important to always round up due to 860 # how Newton's method behaves in this case. If the initial guess is too 861 # small, the next guess will be too large, after which every succeeding 862 # guess converges the correct value from above. Now, if the initial guess 863 # is too small and n is large, the next guess will be much too large and 864 # require a large number of iterations to get close to the solution. 865 # Because of this, we are likely to find the solution faster if we make 866 # sure the initial guess is not too small. 867 868 my $xm_int = int($xm); 869 my $x_str = sprintf '%.0f', $xm > $xm_int ? $xm_int + 1 : $xm_int; 870 $x_str .= "0" x $xe; 871 872 my $x = $class -> _new($x_str); 873 874 if ($DEBUG) { 875 print "xm = $xm\n"; 876 print "xe = $xe\n"; 877 print "\n"; 878 print "x_str = $x_str (initial guess)\n"; 879 print "\n"; 880 } 881 882 # Use Newton's method for computing n'th root of y. 883 # 884 # x(i+1) = x(i) - f(x(i)) / f'(x(i)) 885 # = x(i) - (x(i)^n - y) / (n * x(i)^(n-1)) # use if x(i)^n > y 886 # = x(i) + (y - x(i)^n) / (n * x(i)^(n-1)) # use if x(i)^n < y 887 888 # Determine if x, our guess, is too small, correct, or too large. Rather 889 # than computing x(i)^n and x(i)^(n-1) directly, compute x(i)^(n-1) and 890 # then the same value multiplied by x. 891 892 my $nm1 = $class -> _dec($class -> _copy($n)); # n-1 893 my $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 894 my $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 895 my $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 896 897 if ($DEBUG) { 898 print "\n"; 899 print "x = ", $class -> _str($x), "\n"; 900 print "x^n = ", $class -> _str($xpown), "\n"; 901 print "y = ", $class -> _str($y), "\n"; 902 print "acmp = $acmp\n"; 903 } 904 905 # If x is too small, do one iteration of Newton's method. Since the 906 # function f(x) = x^n - y is concave and monotonically increasing, the next 907 # guess for x will either be correct or too large. 908 909 if ($acmp < 0) { 910 911 # x(i+1) = x(i) + (y - x(i)^n) / (n * x(i)^(n-1)) 912 913 my $numer = $class -> _sub($class -> _copy($y), $xpown); # y - x(i)^n 914 my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1) 915 my $delta = $class -> _div($numer, $denom); 916 917 if ($DEBUG) { 918 print "\n"; 919 print "numer = ", $class -> _str($numer), "\n"; 920 print "denom = ", $class -> _str($denom), "\n"; 921 print "delta = ", $class -> _str($delta), "\n"; 922 } 923 924 unless ($class -> _is_zero($delta)) { 925 $x = $class -> _add($x, $delta); 926 $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 927 $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 928 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 929 930 if ($DEBUG) { 931 print "\n"; 932 print "x = ", $class -> _str($x), "\n"; 933 print "x^n = ", $class -> _str($xpown), "\n"; 934 print "y = ", $class -> _str($y), "\n"; 935 print "acmp = $acmp\n"; 936 } 937 } 938 } 939 940 # If our guess for x is too large, apply Newton's method repeatedly until 941 # we either have got the correct value, or the delta is zero. 942 943 while ($acmp > 0) { 944 945 # x(i+1) = x(i) - (x(i)^n - y) / (n * x(i)^(n-1)) 946 947 my $numer = $class -> _sub($class -> _copy($xpown), $y); # x(i)^n - y 948 my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1) 949 950 if ($DEBUG) { 951 print "numer = ", $class -> _str($numer), "\n"; 952 print "denom = ", $class -> _str($denom), "\n"; 953 } 954 955 my $delta = $class -> _div($numer, $denom); 956 957 if ($DEBUG) { 958 print "delta = ", $class -> _str($delta), "\n"; 959 } 960 961 last if $class -> _is_zero($delta); 962 963 $x = $class -> _sub($x, $delta); 964 $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1) 965 $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n 966 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 967 968 if ($DEBUG) { 969 print "\n"; 970 print "x = ", $class -> _str($x), "\n"; 971 print "x^n = ", $class -> _str($xpown), "\n"; 972 print "y = ", $class -> _str($y), "\n"; 973 print "acmp = $acmp\n"; 974 } 975 } 976 977 # When the delta is zero, our value for x might still be too large. We 978 # require that the outout is either exact or too small (i.e., rounded down 979 # to the nearest integer), so do a final check. 980 981 while ($acmp > 0) { 982 $x = $class -> _dec($x); 983 $xpown = $class -> _pow($class -> _copy($x), $n); # x(i)^n 984 $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y 985 } 986 987 return $x; 988} 989 990############################################################################## 991# binary stuff 992 993sub _and { 994 my ($class, $x, $y) = @_; 995 996 return $x if $class -> _acmp($x, $y) == 0; 997 998 my $m = $class -> _one(); 999 my $mask = $class -> _new("32768"); 1000 1001 my ($xr, $yr); # remainders after division 1002 1003 my $xc = $class -> _copy($x); 1004 my $yc = $class -> _copy($y); 1005 my $z = $class -> _zero(); 1006 1007 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 1008 ($xc, $xr) = $class -> _div($xc, $mask); 1009 ($yc, $yr) = $class -> _div($yc, $mask); 1010 my $bits = $class -> _new($class -> _num($xr) & $class -> _num($yr)); 1011 $z = $class -> _add($z, $class -> _mul($bits, $m)); 1012 $m = $class -> _mul($m, $mask); 1013 } 1014 1015 return $z; 1016} 1017 1018sub _xor { 1019 my ($class, $x, $y) = @_; 1020 1021 return $class -> _zero() if $class -> _acmp($x, $y) == 0; 1022 1023 my $m = $class -> _one(); 1024 my $mask = $class -> _new("32768"); 1025 1026 my ($xr, $yr); # remainders after division 1027 1028 my $xc = $class -> _copy($x); 1029 my $yc = $class -> _copy($y); 1030 my $z = $class -> _zero(); 1031 1032 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 1033 ($xc, $xr) = $class -> _div($xc, $mask); 1034 ($yc, $yr) = $class -> _div($yc, $mask); 1035 my $bits = $class -> _new($class -> _num($xr) ^ $class -> _num($yr)); 1036 $z = $class -> _add($z, $class -> _mul($bits, $m)); 1037 $m = $class -> _mul($m, $mask); 1038 } 1039 1040 # The loop above stops when the smallest of the two numbers is exhausted. 1041 # The remainder of the longer one will survive bit-by-bit, so we simple 1042 # multiply-add it in. 1043 1044 $z = $class -> _add($z, $class -> _mul($xc, $m)) 1045 unless $class -> _is_zero($xc); 1046 $z = $class -> _add($z, $class -> _mul($yc, $m)) 1047 unless $class -> _is_zero($yc); 1048 1049 return $z; 1050} 1051 1052sub _or { 1053 my ($class, $x, $y) = @_; 1054 1055 return $x if $class -> _acmp($x, $y) == 0; # shortcut (see _and) 1056 1057 my $m = $class -> _one(); 1058 my $mask = $class -> _new("32768"); 1059 1060 my ($xr, $yr); # remainders after division 1061 1062 my $xc = $class -> _copy($x); 1063 my $yc = $class -> _copy($y); 1064 my $z = $class -> _zero(); 1065 1066 until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) { 1067 ($xc, $xr) = $class -> _div($xc, $mask); 1068 ($yc, $yr) = $class -> _div($yc, $mask); 1069 my $bits = $class -> _new($class -> _num($xr) | $class -> _num($yr)); 1070 $z = $class -> _add($z, $class -> _mul($bits, $m)); 1071 $m = $class -> _mul($m, $mask); 1072 } 1073 1074 # The loop above stops when the smallest of the two numbers is exhausted. 1075 # The remainder of the longer one will survive bit-by-bit, so we simple 1076 # multiply-add it in. 1077 1078 $z = $class -> _add($z, $class -> _mul($xc, $m)) 1079 unless $class -> _is_zero($xc); 1080 $z = $class -> _add($z, $class -> _mul($yc, $m)) 1081 unless $class -> _is_zero($yc); 1082 1083 return $z; 1084} 1085 1086sub _sand { 1087 my ($class, $x, $sx, $y, $sy) = @_; 1088 1089 return ($class -> _zero(), '+') 1090 if $class -> _is_zero($x) || $class -> _is_zero($y); 1091 1092 my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+'; 1093 1094 my ($bx, $by); 1095 1096 if ($sx eq '-') { # if x is negative 1097 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1098 $bx = $class -> _copy($x); 1099 $bx = $class -> _dec($bx); 1100 $bx = $class -> _as_hex($bx); 1101 $bx =~ s/^-?0x//; 1102 $bx =~ tr<0123456789abcdef> 1103 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1104 } else { # if x is positive 1105 $bx = $class -> _as_hex($x); # get binary representation 1106 $bx =~ s/^-?0x//; 1107 $bx =~ tr<fedcba9876543210> 1108 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1109 } 1110 1111 if ($sy eq '-') { # if y is negative 1112 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1113 $by = $class -> _copy($y); 1114 $by = $class -> _dec($by); 1115 $by = $class -> _as_hex($by); 1116 $by =~ s/^-?0x//; 1117 $by =~ tr<0123456789abcdef> 1118 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1119 } else { 1120 $by = $class -> _as_hex($y); # get binary representation 1121 $by =~ s/^-?0x//; 1122 $by =~ tr<fedcba9876543210> 1123 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1124 } 1125 1126 # now we have bit-strings from X and Y, reverse them for padding 1127 $bx = reverse $bx; 1128 $by = reverse $by; 1129 1130 # padd the shorter string 1131 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1132 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1133 my $diff = CORE::length($bx) - CORE::length($by); 1134 if ($diff > 0) { 1135 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1136 $by .= $yy x $diff; 1137 } elsif ($diff < 0) { 1138 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1139 $bx .= $xx x abs($diff); 1140 } 1141 1142 # and the strings together 1143 my $r = $bx & $by; 1144 1145 # and reverse the result again 1146 $bx = reverse $r; 1147 1148 # One of $bx or $by was negative, so need to flip bits in the result. In both 1149 # cases (one or two of them negative, or both positive) we need to get the 1150 # characters back. 1151 if ($sign eq '-') { 1152 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1153 <0123456789abcdef>; 1154 } else { 1155 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1156 <fedcba9876543210>; 1157 } 1158 1159 # leading zeros will be stripped by _from_hex() 1160 $bx = '0x' . $bx; 1161 $bx = $class -> _from_hex($bx); 1162 1163 $bx = $class -> _inc($bx) if $sign eq '-'; 1164 1165 # avoid negative zero 1166 $sign = '+' if $class -> _is_zero($bx); 1167 1168 return $bx, $sign; 1169} 1170 1171sub _sxor { 1172 my ($class, $x, $sx, $y, $sy) = @_; 1173 1174 return ($class -> _zero(), '+') 1175 if $class -> _is_zero($x) && $class -> _is_zero($y); 1176 1177 my $sign = $sx ne $sy ? '-' : '+'; 1178 1179 my ($bx, $by); 1180 1181 if ($sx eq '-') { # if x is negative 1182 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1183 $bx = $class -> _copy($x); 1184 $bx = $class -> _dec($bx); 1185 $bx = $class -> _as_hex($bx); 1186 $bx =~ s/^-?0x//; 1187 $bx =~ tr<0123456789abcdef> 1188 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1189 } else { # if x is positive 1190 $bx = $class -> _as_hex($x); # get binary representation 1191 $bx =~ s/^-?0x//; 1192 $bx =~ tr<fedcba9876543210> 1193 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1194 } 1195 1196 if ($sy eq '-') { # if y is negative 1197 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1198 $by = $class -> _copy($y); 1199 $by = $class -> _dec($by); 1200 $by = $class -> _as_hex($by); 1201 $by =~ s/^-?0x//; 1202 $by =~ tr<0123456789abcdef> 1203 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1204 } else { 1205 $by = $class -> _as_hex($y); # get binary representation 1206 $by =~ s/^-?0x//; 1207 $by =~ tr<fedcba9876543210> 1208 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1209 } 1210 1211 # now we have bit-strings from X and Y, reverse them for padding 1212 $bx = reverse $bx; 1213 $by = reverse $by; 1214 1215 # padd the shorter string 1216 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1217 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1218 my $diff = CORE::length($bx) - CORE::length($by); 1219 if ($diff > 0) { 1220 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1221 $by .= $yy x $diff; 1222 } elsif ($diff < 0) { 1223 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1224 $bx .= $xx x abs($diff); 1225 } 1226 1227 # xor the strings together 1228 my $r = $bx ^ $by; 1229 1230 # and reverse the result again 1231 $bx = reverse $r; 1232 1233 # One of $bx or $by was negative, so need to flip bits in the result. In both 1234 # cases (one or two of them negative, or both positive) we need to get the 1235 # characters back. 1236 if ($sign eq '-') { 1237 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1238 <0123456789abcdef>; 1239 } else { 1240 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1241 <fedcba9876543210>; 1242 } 1243 1244 # leading zeros will be stripped by _from_hex() 1245 $bx = '0x' . $bx; 1246 $bx = $class -> _from_hex($bx); 1247 1248 $bx = $class -> _inc($bx) if $sign eq '-'; 1249 1250 # avoid negative zero 1251 $sign = '+' if $class -> _is_zero($bx); 1252 1253 return $bx, $sign; 1254} 1255 1256sub _sor { 1257 my ($class, $x, $sx, $y, $sy) = @_; 1258 1259 return ($class -> _zero(), '+') 1260 if $class -> _is_zero($x) && $class -> _is_zero($y); 1261 1262 my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+'; 1263 1264 my ($bx, $by); 1265 1266 if ($sx eq '-') { # if x is negative 1267 # two's complement: inc (dec unsigned value) and flip all "bits" in $bx 1268 $bx = $class -> _copy($x); 1269 $bx = $class -> _dec($bx); 1270 $bx = $class -> _as_hex($bx); 1271 $bx =~ s/^-?0x//; 1272 $bx =~ tr<0123456789abcdef> 1273 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1274 } else { # if x is positive 1275 $bx = $class -> _as_hex($x); # get binary representation 1276 $bx =~ s/^-?0x//; 1277 $bx =~ tr<fedcba9876543210> 1278 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1279 } 1280 1281 if ($sy eq '-') { # if y is negative 1282 # two's complement: inc (dec unsigned value) and flip all "bits" in $by 1283 $by = $class -> _copy($y); 1284 $by = $class -> _dec($by); 1285 $by = $class -> _as_hex($by); 1286 $by =~ s/^-?0x//; 1287 $by =~ tr<0123456789abcdef> 1288 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1289 } else { 1290 $by = $class -> _as_hex($y); # get binary representation 1291 $by =~ s/^-?0x//; 1292 $by =~ tr<fedcba9876543210> 1293 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; 1294 } 1295 1296 # now we have bit-strings from X and Y, reverse them for padding 1297 $bx = reverse $bx; 1298 $by = reverse $by; 1299 1300 # padd the shorter string 1301 my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; 1302 my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; 1303 my $diff = CORE::length($bx) - CORE::length($by); 1304 if ($diff > 0) { 1305 # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by 1306 $by .= $yy x $diff; 1307 } elsif ($diff < 0) { 1308 # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx 1309 $bx .= $xx x abs($diff); 1310 } 1311 1312 # or the strings together 1313 my $r = $bx | $by; 1314 1315 # and reverse the result again 1316 $bx = reverse $r; 1317 1318 # One of $bx or $by was negative, so need to flip bits in the result. In both 1319 # cases (one or two of them negative, or both positive) we need to get the 1320 # characters back. 1321 if ($sign eq '-') { 1322 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1323 <0123456789abcdef>; 1324 } else { 1325 $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> 1326 <fedcba9876543210>; 1327 } 1328 1329 # leading zeros will be stripped by _from_hex() 1330 $bx = '0x' . $bx; 1331 $bx = $class -> _from_hex($bx); 1332 1333 $bx = $class -> _inc($bx) if $sign eq '-'; 1334 1335 # avoid negative zero 1336 $sign = '+' if $class -> _is_zero($bx); 1337 1338 return $bx, $sign; 1339} 1340 1341sub _to_bin { 1342 # convert the number to a string of binary digits without prefix 1343 my ($class, $x) = @_; 1344 my $str = ''; 1345 my $tmp = $class -> _copy($x); 1346 my $chunk = $class -> _new("16777216"); # 2^24 = 24 binary digits 1347 my $rem; 1348 until ($class -> _acmp($tmp, $chunk) < 0) { 1349 ($tmp, $rem) = $class -> _div($tmp, $chunk); 1350 $str = sprintf("%024b", $class -> _num($rem)) . $str; 1351 } 1352 unless ($class -> _is_zero($tmp)) { 1353 $str = sprintf("%b", $class -> _num($tmp)) . $str; 1354 } 1355 return length($str) ? $str : '0'; 1356} 1357 1358sub _to_oct { 1359 # convert the number to a string of octal digits without prefix 1360 my ($class, $x) = @_; 1361 my $str = ''; 1362 my $tmp = $class -> _copy($x); 1363 my $chunk = $class -> _new("16777216"); # 2^24 = 8 octal digits 1364 my $rem; 1365 until ($class -> _acmp($tmp, $chunk) < 0) { 1366 ($tmp, $rem) = $class -> _div($tmp, $chunk); 1367 $str = sprintf("%08o", $class -> _num($rem)) . $str; 1368 } 1369 unless ($class -> _is_zero($tmp)) { 1370 $str = sprintf("%o", $class -> _num($tmp)) . $str; 1371 } 1372 return length($str) ? $str : '0'; 1373} 1374 1375sub _to_hex { 1376 # convert the number to a string of hexadecimal digits without prefix 1377 my ($class, $x) = @_; 1378 my $str = ''; 1379 my $tmp = $class -> _copy($x); 1380 my $chunk = $class -> _new("16777216"); # 2^24 = 6 hexadecimal digits 1381 my $rem; 1382 until ($class -> _acmp($tmp, $chunk) < 0) { 1383 ($tmp, $rem) = $class -> _div($tmp, $chunk); 1384 $str = sprintf("%06x", $class -> _num($rem)) . $str; 1385 } 1386 unless ($class -> _is_zero($tmp)) { 1387 $str = sprintf("%x", $class -> _num($tmp)) . $str; 1388 } 1389 return length($str) ? $str : '0'; 1390} 1391 1392sub _as_bin { 1393 # convert the number to a string of binary digits with prefix 1394 my ($class, $x) = @_; 1395 return '0b' . $class -> _to_bin($x); 1396} 1397 1398sub _as_oct { 1399 # convert the number to a string of octal digits with prefix 1400 my ($class, $x) = @_; 1401 return '0' . $class -> _to_oct($x); # yes, 0 becomes "00" 1402} 1403 1404sub _as_hex { 1405 # convert the number to a string of hexadecimal digits with prefix 1406 my ($class, $x) = @_; 1407 return '0x' . $class -> _to_hex($x); 1408} 1409 1410sub _to_bytes { 1411 # convert the number to a string of bytes 1412 my ($class, $x) = @_; 1413 my $str = ''; 1414 my $tmp = $class -> _copy($x); 1415 my $chunk = $class -> _new("65536"); 1416 my $rem; 1417 until ($class -> _is_zero($tmp)) { 1418 ($tmp, $rem) = $class -> _div($tmp, $chunk); 1419 $str = pack('n', $class -> _num($rem)) . $str; 1420 } 1421 $str =~ s/^\0+//; 1422 return length($str) ? $str : "\x00"; 1423} 1424 1425*_as_bytes = \&_to_bytes; 1426 1427sub _to_base { 1428 # convert the number to a string of digits in various bases 1429 my $class = shift; 1430 my $x = shift; 1431 my $base = shift; 1432 $base = $class -> _new($base) unless ref($base); 1433 1434 my $collseq; 1435 if (@_) { 1436 $collseq = shift(); 1437 } else { 1438 if ($class -> _acmp($base, $class -> _new("94")) <= 0) { 1439 $collseq = '0123456789' # 48 .. 57 1440 . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 1441 . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 1442 . '!"#$%&\'()*+,-./' # 33 .. 47 1443 . ':;<=>?@' # 58 .. 64 1444 . '[\\]^_`' # 91 .. 96 1445 . '{|}~'; # 123 .. 126 1446 } else { 1447 croak "When base > 94, a collation sequence must be given"; 1448 } 1449 } 1450 1451 my @collseq = split '', $collseq; 1452 1453 my $str = ''; 1454 my $tmp = $class -> _copy($x); 1455 my $rem; 1456 until ($class -> _is_zero($tmp)) { 1457 ($tmp, $rem) = $class -> _div($tmp, $base); 1458 my $num = $class -> _num($rem); 1459 croak "no character to represent '$num' in collation sequence", 1460 " (collation sequence is too short)" if $num > $#collseq; 1461 my $chr = $collseq[$num]; 1462 $str = $chr . $str; 1463 } 1464 return "0" unless length $str; 1465 return $str; 1466} 1467 1468sub _from_hex { 1469 # Convert a string of hexadecimal digits to a number. 1470 1471 my ($class, $hex) = @_; 1472 $hex =~ s/^0[xX]//; 1473 1474 # Find the largest number of hexadecimal digits that we can safely use with 1475 # 32 bit integers. There are 4 bits pr hexadecimal digit, and we use only 1476 # 31 bits to play safe. This gives us int(31 / 4) = 7. 1477 1478 my $len = length $hex; 1479 my $rem = 1 + ($len - 1) % 7; 1480 1481 # Do the first chunk. 1482 1483 my $ret = $class -> _new(int hex substr $hex, 0, $rem); 1484 return $ret if $rem == $len; 1485 1486 # Do the remaining chunks, if any. 1487 1488 my $shift = $class -> _new(1 << (4 * 7)); 1489 for (my $offset = $rem ; $offset < $len ; $offset += 7) { 1490 my $part = int hex substr $hex, $offset, 7; 1491 $ret = $class -> _mul($ret, $shift); 1492 $ret = $class -> _add($ret, $class -> _new($part)); 1493 } 1494 1495 return $ret; 1496} 1497 1498sub _from_oct { 1499 # Convert a string of octal digits to a number. 1500 1501 my ($class, $oct) = @_; 1502 1503 # Find the largest number of octal digits that we can safely use with 32 1504 # bit integers. There are 3 bits pr octal digit, and we use only 31 bits to 1505 # play safe. This gives us int(31 / 3) = 10. 1506 1507 my $len = length $oct; 1508 my $rem = 1 + ($len - 1) % 10; 1509 1510 # Do the first chunk. 1511 1512 my $ret = $class -> _new(int oct substr $oct, 0, $rem); 1513 return $ret if $rem == $len; 1514 1515 # Do the remaining chunks, if any. 1516 1517 my $shift = $class -> _new(1 << (3 * 10)); 1518 for (my $offset = $rem ; $offset < $len ; $offset += 10) { 1519 my $part = int oct substr $oct, $offset, 10; 1520 $ret = $class -> _mul($ret, $shift); 1521 $ret = $class -> _add($ret, $class -> _new($part)); 1522 } 1523 1524 return $ret; 1525} 1526 1527sub _from_bin { 1528 # Convert a string of binary digits to a number. 1529 1530 my ($class, $bin) = @_; 1531 $bin =~ s/^0[bB]//; 1532 1533 # The largest number of binary digits that we can safely use with 32 bit 1534 # integers is 31. We use only 31 bits to play safe. 1535 1536 my $len = length $bin; 1537 my $rem = 1 + ($len - 1) % 31; 1538 1539 # Do the first chunk. 1540 1541 my $ret = $class -> _new(int oct '0b' . substr $bin, 0, $rem); 1542 return $ret if $rem == $len; 1543 1544 # Do the remaining chunks, if any. 1545 1546 my $shift = $class -> _new(1 << 31); 1547 for (my $offset = $rem ; $offset < $len ; $offset += 31) { 1548 my $part = int oct '0b' . substr $bin, $offset, 31; 1549 $ret = $class -> _mul($ret, $shift); 1550 $ret = $class -> _add($ret, $class -> _new($part)); 1551 } 1552 1553 return $ret; 1554} 1555 1556sub _from_bytes { 1557 # convert string of bytes to a number 1558 my ($class, $str) = @_; 1559 my $x = $class -> _zero(); 1560 my $base = $class -> _new("256"); 1561 my $n = length($str); 1562 for (my $i = 0 ; $i < $n ; ++$i) { 1563 $x = $class -> _mul($x, $base); 1564 my $byteval = $class -> _new(unpack 'C', substr($str, $i, 1)); 1565 $x = $class -> _add($x, $byteval); 1566 } 1567 return $x; 1568} 1569 1570sub _from_base { 1571 # convert a string to a decimal number 1572 my $class = shift; 1573 my $str = shift; 1574 my $base = shift; 1575 $base = $class -> _new($base) unless ref($base); 1576 1577 my $n = length($str); 1578 my $x = $class -> _zero(); 1579 1580 my $collseq; 1581 if (@_) { 1582 $collseq = shift(); 1583 } else { 1584 if ($class -> _acmp($base, $class -> _new("36")) <= 0) { 1585 $str = uc $str; 1586 $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; 1587 } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) { 1588 $collseq = '0123456789' # 48 .. 57 1589 . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 1590 . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 1591 . '!"#$%&\'()*+,-./' # 33 .. 47 1592 . ':;<=>?@' # 58 .. 64 1593 . '[\\]^_`' # 91 .. 96 1594 . '{|}~'; # 123 .. 126 1595 } else { 1596 croak "When base > 94, a collation sequence must be given"; 1597 } 1598 $collseq = substr $collseq, 0, $class -> _num($base); 1599 } 1600 1601 # Create a mapping from each character in the collation sequence to the 1602 # corresponding integer. Check for duplicates in the collation sequence. 1603 1604 my @collseq = split '', $collseq; 1605 my %collseq; 1606 for my $num (0 .. $#collseq) { 1607 my $chr = $collseq[$num]; 1608 die "duplicate character '$chr' in collation sequence" 1609 if exists $collseq{$chr}; 1610 $collseq{$chr} = $num; 1611 } 1612 1613 for (my $i = 0 ; $i < $n ; ++$i) { 1614 my $chr = substr($str, $i, 1); 1615 die "input character '$chr' does not exist in collation sequence" 1616 unless exists $collseq{$chr}; 1617 $x = $class -> _mul($x, $base); 1618 my $num = $class -> _new($collseq{$chr}); 1619 $x = $class -> _add($x, $num); 1620 } 1621 1622 return $x; 1623} 1624 1625############################################################################## 1626# special modulus functions 1627 1628sub _modinv { 1629 # modular multiplicative inverse 1630 my ($class, $x, $y) = @_; 1631 1632 # modulo zero 1633 if ($class -> _is_zero($y)) { 1634 return (undef, undef); 1635 } 1636 1637 # modulo one 1638 if ($class -> _is_one($y)) { 1639 return ($class -> _zero(), '+'); 1640 } 1641 1642 my $u = $class -> _zero(); 1643 my $v = $class -> _one(); 1644 my $a = $class -> _copy($y); 1645 my $b = $class -> _copy($x); 1646 1647 # Euclid's Algorithm for bgcd(). 1648 1649 my $q; 1650 my $sign = 1; 1651 { 1652 ($a, $q, $b) = ($b, $class -> _div($a, $b)); 1653 last if $class -> _is_zero($b); 1654 1655 my $vq = $class -> _mul($class -> _copy($v), $q); 1656 my $t = $class -> _add($vq, $u); 1657 $u = $v; 1658 $v = $t; 1659 $sign = -$sign; 1660 redo; 1661 } 1662 1663 # if the gcd is not 1, there exists no modular multiplicative inverse 1664 return (undef, undef) unless $class -> _is_one($a); 1665 1666 ($v, $sign == 1 ? '+' : '-'); 1667} 1668 1669sub _modpow { 1670 # modulus of power ($x ** $y) % $z 1671 my ($class, $num, $exp, $mod) = @_; 1672 1673 # a^b (mod 1) = 0 for all a and b 1674 if ($class -> _is_one($mod)) { 1675 return $class -> _zero(); 1676 } 1677 1678 # 0^a (mod m) = 0 if m != 0, a != 0 1679 # 0^0 (mod m) = 1 if m != 0 1680 if ($class -> _is_zero($num)) { 1681 return $class -> _is_zero($exp) ? $class -> _one() 1682 : $class -> _zero(); 1683 } 1684 1685 # $num = $class -> _mod($num, $mod); # this does not make it faster 1686 1687 my $acc = $class -> _copy($num); 1688 my $t = $class -> _one(); 1689 1690 my $expbin = $class -> _as_bin($exp); 1691 $expbin =~ s/^0b//; 1692 my $len = length($expbin); 1693 1694 while (--$len >= 0) { 1695 if (substr($expbin, $len, 1) eq '1') { 1696 $t = $class -> _mul($t, $acc); 1697 $t = $class -> _mod($t, $mod); 1698 } 1699 $acc = $class -> _mul($acc, $acc); 1700 $acc = $class -> _mod($acc, $mod); 1701 } 1702 return $t; 1703} 1704 1705sub _gcd { 1706 # Greatest common divisor. 1707 1708 my ($class, $x, $y) = @_; 1709 1710 # gcd(0, 0) = 0 1711 # gcd(0, a) = a, if a != 0 1712 1713 if ($class -> _acmp($x, $y) == 0) { 1714 return $class -> _copy($x); 1715 } 1716 1717 if ($class -> _is_zero($x)) { 1718 if ($class -> _is_zero($y)) { 1719 return $class -> _zero(); 1720 } else { 1721 return $class -> _copy($y); 1722 } 1723 } else { 1724 if ($class -> _is_zero($y)) { 1725 return $class -> _copy($x); 1726 } else { 1727 1728 # Until $y is zero ... 1729 1730 $x = $class -> _copy($x); 1731 until ($class -> _is_zero($y)) { 1732 1733 # Compute remainder. 1734 1735 $x = $class -> _mod($x, $y); 1736 1737 # Swap $x and $y. 1738 1739 my $tmp = $x; 1740 $x = $class -> _copy($y); 1741 $y = $tmp; 1742 } 1743 1744 return $x; 1745 } 1746 } 1747} 1748 1749sub _lcm { 1750 # Least common multiple. 1751 1752 my ($class, $x, $y) = @_; 1753 1754 # lcm(0, x) = 0 for all x 1755 1756 return $class -> _zero() 1757 if ($class -> _is_zero($x) || 1758 $class -> _is_zero($y)); 1759 1760 my $gcd = $class -> _gcd($class -> _copy($x), $y); 1761 $x = $class -> _div($x, $gcd); 1762 $x = $class -> _mul($x, $y); 1763 return $x; 1764} 1765 1766sub _lucas { 1767 my ($class, $n) = @_; 1768 1769 $n = $class -> _num($n) if ref $n; 1770 1771 # In list context, use lucas(n) = lucas(n-1) + lucas(n-2) 1772 1773 if (wantarray) { 1774 my @y; 1775 1776 push @y, $class -> _two(); 1777 return @y if $n == 0; 1778 1779 push @y, $class -> _one(); 1780 return @y if $n == 1; 1781 1782 for (my $i = 2 ; $i <= $n ; ++ $i) { 1783 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]); 1784 } 1785 1786 return @y; 1787 } 1788 1789 require Scalar::Util; 1790 1791 # In scalar context use that lucas(n) = fib(n-1) + fib(n+1). 1792 # 1793 # Remember that _fib() behaves differently in scalar context and list 1794 # context, so we must add scalar() to get the desired behaviour. 1795 1796 return $class -> _two() if $n == 0; 1797 1798 return $class -> _add(scalar $class -> _fib($n - 1), 1799 scalar $class -> _fib($n + 1)); 1800} 1801 1802sub _fib { 1803 my ($class, $n) = @_; 1804 1805 $n = $class -> _num($n) if ref $n; 1806 1807 # In list context, use fib(n) = fib(n-1) + fib(n-2) 1808 1809 if (wantarray) { 1810 my @y; 1811 1812 push @y, $class -> _zero(); 1813 return @y if $n == 0; 1814 1815 push @y, $class -> _one(); 1816 return @y if $n == 1; 1817 1818 for (my $i = 2 ; $i <= $n ; ++ $i) { 1819 $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]); 1820 } 1821 1822 return @y; 1823 } 1824 1825 # In scalar context use a fast algorithm that is much faster than the 1826 # recursive algorith used in list context. 1827 1828 my $cache = {}; 1829 my $two = $class -> _two(); 1830 my $fib; 1831 1832 $fib = sub { 1833 my $n = shift; 1834 return $class -> _zero() if $n <= 0; 1835 return $class -> _one() if $n <= 2; 1836 return $cache -> {$n} if exists $cache -> {$n}; 1837 1838 my $k = int($n / 2); 1839 my $a = $fib -> ($k + 1); 1840 my $b = $fib -> ($k); 1841 my $y; 1842 1843 if ($n % 2 == 1) { 1844 # a*a + b*b 1845 $y = $class -> _add($class -> _mul($class -> _copy($a), $a), 1846 $class -> _mul($class -> _copy($b), $b)); 1847 } else { 1848 # (2*a - b)*b 1849 $y = $class -> _mul($class -> _sub($class -> _mul( 1850 $class -> _copy($two), $a), $b), $b); 1851 } 1852 1853 $cache -> {$n} = $y; 1854 return $y; 1855 }; 1856 1857 return $fib -> ($n); 1858} 1859 1860############################################################################## 1861############################################################################## 1862 18631; 1864 1865__END__ 1866 1867=pod 1868 1869=head1 NAME 1870 1871Math::BigInt::Lib - virtual parent class for Math::BigInt libraries 1872 1873=head1 SYNOPSIS 1874 1875 # In the backend library for Math::BigInt et al. 1876 1877 package Math::BigInt::MyBackend; 1878 1879 use Math::BigInt::lib; 1880 our @ISA = qw< Math::BigInt::lib >; 1881 1882 sub _new { ... } 1883 sub _str { ... } 1884 sub _add { ... } 1885 str _sub { ... } 1886 ... 1887 1888 # In your main program. 1889 1890 use Math::BigInt lib => 'MyBackend'; 1891 1892=head1 DESCRIPTION 1893 1894This module provides support for big integer calculations. It is not intended 1895to be used directly, but rather as a parent class for backend libraries used by 1896Math::BigInt, Math::BigFloat, Math::BigRat, and related modules. 1897 1898Other backend libraries include Math::BigInt::Calc, Math::BigInt::FastCalc, 1899Math::BigInt::GMP, and Math::BigInt::Pari. 1900 1901In order to allow for multiple big integer libraries, Math::BigInt was 1902rewritten to use a plug-in library for core math routines. Any module which 1903conforms to the API can be used by Math::BigInt by using this in your program: 1904 1905 use Math::BigInt lib => 'libname'; 1906 1907'libname' is either the long name, like 'Math::BigInt::Pari', or only the short 1908version, like 'Pari'. 1909 1910=head2 General Notes 1911 1912A library only needs to deal with unsigned big integers. Testing of input 1913parameter validity is done by the caller, so there is no need to worry about 1914underflow (e.g., in C<_sub()> and C<_dec()>) or about division by zero (e.g., 1915in C<_div()> and C<_mod()>)) or similar cases. 1916 1917Some libraries use methods that don't modify their argument, and some libraries 1918don't even use objects, but rather unblessed references. Because of this, 1919liberary methods are always called as class methods, not instance methods: 1920 1921 $x = Class -> method($x, $y); # like this 1922 $x = $x -> method($y); # not like this ... 1923 $x -> method($y); # ... or like this 1924 1925And with boolean methods 1926 1927 $bool = Class -> method($x, $y); # like this 1928 $bool = $x -> method($y); # not like this 1929 1930Return values are always objects, strings, Perl scalars, or true/false for 1931comparison routines. 1932 1933=head3 API version 1934 1935=over 4 1936 1937=item CLASS-E<gt>api_version() 1938 1939This method is no longer used and can be omitted. Methods that are not 1940implemented by a subclass will be inherited from this class. 1941 1942=back 1943 1944=head3 Constructors 1945 1946The following methods are mandatory: _new(), _str(), _add(), and _sub(). 1947However, computations will be very slow without _mul() and _div(). 1948 1949=over 4 1950 1951=item CLASS-E<gt>_new(STR) 1952 1953Convert a string representing an unsigned decimal number to an object 1954representing the same number. The input is normalized, i.e., it matches 1955C<^(0|[1-9]\d*)$>. 1956 1957=item CLASS-E<gt>_zero() 1958 1959Return an object representing the number zero. 1960 1961=item CLASS-E<gt>_one() 1962 1963Return an object representing the number one. 1964 1965=item CLASS-E<gt>_two() 1966 1967Return an object representing the number two. 1968 1969=item CLASS-E<gt>_ten() 1970 1971Return an object representing the number ten. 1972 1973=item CLASS-E<gt>_from_bin(STR) 1974 1975Return an object given a string representing a binary number. The input has a 1976'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>. 1977 1978=item CLASS-E<gt>_from_oct(STR) 1979 1980Return an object given a string representing an octal number. The input has a 1981'0' prefix and matches the regular expression C<^0[1-7]*$>. 1982 1983=item CLASS-E<gt>_from_hex(STR) 1984 1985Return an object given a string representing a hexadecimal number. The input 1986has a '0x' prefix and matches the regular expression 1987C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>. 1988 1989=item CLASS-E<gt>_from_bytes(STR) 1990 1991Returns an object given a byte string representing the number. The byte string 1992is in big endian byte order, so the two-byte input string "\x01\x00" should 1993give an output value representing the number 256. 1994 1995=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ) 1996 1997Returns an object given a string STR, a base BASE, and a collation sequence 1998COLLSEQ. Each character in STR represents a numerical value identical to the 1999character's position in COLLSEQ. All characters in STR must be present in 2000COLLSEQ. 2001 2002If BASE is less than or equal to 94, and a collation sequence is not specified, 2003the following default collation sequence is used. It contains of all the 94 2004printable ASCII characters except space/blank: 2005 2006 0123456789 # ASCII 48 to 57 2007 ABCDEFGHIJKLMNOPQRSTUVWXYZ # ASCII 65 to 90 2008 abcdefghijklmnopqrstuvwxyz # ASCII 97 to 122 2009 !"#$%&'()*+,-./ # ASCII 33 to 47 2010 :;<=>?@ # ASCII 58 to 64 2011 [\]^_` # ASCII 91 to 96 2012 {|}~ # ASCII 123 to 126 2013 2014If the default collation sequence is used, and the BASE is less than or equal 2015to 36, the letter case in STR is ignored. 2016 2017For instance, with base 3 and collation sequence "-/|", the character "-" 2018represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the 2019output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15. 2020 2021The following examples show standard binary, octal, decimal, and hexadecimal 2022conversion. All examples return 250. 2023 2024 $x = $class -> _from_base("11111010", 2) 2025 $x = $class -> _from_base("372", 8) 2026 $x = $class -> _from_base("250", 10) 2027 $x = $class -> _from_base("FA", 16) 2028 2029Some more examples, all returning 250: 2030 2031 $x = $class -> _from_base("100021", 3) 2032 $x = $class -> _from_base("3322", 4) 2033 $x = $class -> _from_base("2000", 5) 2034 $x = $class -> _from_base("caaa", 5, "abcde") 2035 $x = $class -> _from_base("42", 62) 2036 $x = $class -> _from_base("2!", 94) 2037 2038=back 2039 2040=head3 Mathematical functions 2041 2042=over 4 2043 2044=item CLASS-E<gt>_add(OBJ1, OBJ2) 2045 2046Returns the result of adding OBJ2 to OBJ1. 2047 2048=item CLASS-E<gt>_mul(OBJ1, OBJ2) 2049 2050Returns the result of multiplying OBJ2 and OBJ1. 2051 2052=item CLASS-E<gt>_div(OBJ1, OBJ2) 2053 2054In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and 2055truncating the result to an integer. In list context, return the quotient and 2056the remainder. 2057 2058=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG) 2059 2060=item CLASS-E<gt>_sub(OBJ1, OBJ2) 2061 2062Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted, 2063OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. 2064 2065=item CLASS-E<gt>_dec(OBJ) 2066 2067Returns the result after decrementing OBJ by one. 2068 2069=item CLASS-E<gt>_inc(OBJ) 2070 2071Returns the result after incrementing OBJ by one. 2072 2073=item CLASS-E<gt>_mod(OBJ1, OBJ2) 2074 2075Returns OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2. 2076 2077=item CLASS-E<gt>_sqrt(OBJ) 2078 2079Returns the square root of OBJ, truncated to an integer. 2080 2081=item CLASS-E<gt>_root(OBJ, N) 2082 2083Returns the Nth root of OBJ, truncated to an integer. 2084 2085=item CLASS-E<gt>_fac(OBJ) 2086 2087Returns the factorial of OBJ, i.e., the product of all positive integers up to 2088and including OBJ. 2089 2090=item CLASS-E<gt>_dfac(OBJ) 2091 2092Returns the double factorial of OBJ. If OBJ is an even integer, returns the 2093product of all positive, even integers up to and including OBJ, i.e., 20942*4*6*...*OBJ. If OBJ is an odd integer, returns the product of all positive, 2095odd integers, i.e., 1*3*5*...*OBJ. 2096 2097=item CLASS-E<gt>_pow(OBJ1, OBJ2) 2098 2099Returns OBJ1 raised to the power of OBJ2. By convention, 0**0 = 1. 2100 2101=item CLASS-E<gt>_modinv(OBJ1, OBJ2) 2102 2103Returns the modular multiplicative inverse, i.e., return OBJ3 so that 2104 2105 (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2 2106 2107The result is returned as two arguments. If the modular multiplicative inverse 2108does not exist, both arguments are undefined. Otherwise, the arguments are a 2109number (object) and its sign ("+" or "-"). 2110 2111The output value, with its sign, must either be a positive value in the range 21121,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input 2113arguments are objects representing the numbers 7 and 5, the method must either 2114return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1 2115% 5, or an object representing the number 2 and a "-" sign, since (-2*7) % 5 = 1 2116% 5. 2117 2118=item CLASS-E<gt>_modpow(OBJ1, OBJ2, OBJ3) 2119 2120Returns the modular exponentiation, i.e., (OBJ1 ** OBJ2) % OBJ3. 2121 2122=item CLASS-E<gt>_rsft(OBJ, N, B) 2123 2124Returns the result after shifting OBJ N digits to thee right in base B. This is 2125equivalent to performing integer division by B**N and discarding the remainder, 2126except that it might be much faster. 2127 2128For instance, if the object $obj represents the hexadecimal number 0xabcde, 2129then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The 2130"remainer", 0xde, is discarded and not returned. 2131 2132=item CLASS-E<gt>_lsft(OBJ, N, B) 2133 2134Returns the result after shifting OBJ N digits to the left in base B. This is 2135equivalent to multiplying by B**N, except that it might be much faster. 2136 2137=item CLASS-E<gt>_log_int(OBJ, B) 2138 2139Returns the logarithm of OBJ to base BASE truncted to an integer. This method 2140has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; 2141it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ, 2142and undef if it is unknown whether OBJ is the exact result. 2143 2144=item CLASS-E<gt>_gcd(OBJ1, OBJ2) 2145 2146Returns the greatest common divisor of OBJ1 and OBJ2. 2147 2148=item CLASS-E<gt>_lcm(OBJ1, OBJ2) 2149 2150Return the least common multiple of OBJ1 and OBJ2. 2151 2152=item CLASS-E<gt>_fib(OBJ) 2153 2154In scalar context, returns the nth Fibonacci number: _fib(0) returns 0, _fib(1) 2155returns 1, _fib(2) returns 1, _fib(3) returns 2 etc. In list context, returns 2156the Fibonacci numbers from F(0) to F(n): 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ... 2157 2158=item CLASS-E<gt>_lucas(OBJ) 2159 2160In scalar context, returns the nth Lucas number: _lucas(0) returns 2, _lucas(1) 2161returns 1, _lucas(2) returns 3, etc. In list context, returns the Lucas numbers 2162from L(0) to L(n): 2, 1, 3, 4, 7, 11, 18, 29,47, 76, ... 2163 2164=back 2165 2166=head3 Bitwise operators 2167 2168=over 4 2169 2170=item CLASS-E<gt>_and(OBJ1, OBJ2) 2171 2172Returns bitwise and. 2173 2174=item CLASS-E<gt>_or(OBJ1, OBJ2) 2175 2176Returns bitwise or. 2177 2178=item CLASS-E<gt>_xor(OBJ1, OBJ2) 2179 2180Returns bitwise exclusive or. 2181 2182=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2) 2183 2184Returns bitwise signed and. 2185 2186=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2) 2187 2188Returns bitwise signed or. 2189 2190=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2) 2191 2192Returns bitwise signed exclusive or. 2193 2194=back 2195 2196=head3 Boolean operators 2197 2198=over 4 2199 2200=item CLASS-E<gt>_is_zero(OBJ) 2201 2202Returns a true value if OBJ is zero, and false value otherwise. 2203 2204=item CLASS-E<gt>_is_one(OBJ) 2205 2206Returns a true value if OBJ is one, and false value otherwise. 2207 2208=item CLASS-E<gt>_is_two(OBJ) 2209 2210Returns a true value if OBJ is two, and false value otherwise. 2211 2212=item CLASS-E<gt>_is_ten(OBJ) 2213 2214Returns a true value if OBJ is ten, and false value otherwise. 2215 2216=item CLASS-E<gt>_is_even(OBJ) 2217 2218Return a true value if OBJ is an even integer, and a false value otherwise. 2219 2220=item CLASS-E<gt>_is_odd(OBJ) 2221 2222Return a true value if OBJ is an even integer, and a false value otherwise. 2223 2224=item CLASS-E<gt>_acmp(OBJ1, OBJ2) 2225 2226Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is numerically less than, 2227equal to, or larger than OBJ2, respectively. 2228 2229=back 2230 2231=head3 String conversion 2232 2233=over 4 2234 2235=item CLASS-E<gt>_str(OBJ) 2236 2237Returns a string representing OBJ in decimal notation. The returned string 2238should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>. 2239 2240=item CLASS-E<gt>_to_bin(OBJ) 2241 2242Returns the binary string representation of OBJ. 2243 2244=item CLASS-E<gt>_to_oct(OBJ) 2245 2246Returns the octal string representation of the number. 2247 2248=item CLASS-E<gt>_to_hex(OBJ) 2249 2250Returns the hexadecimal string representation of the number. 2251 2252=item CLASS-E<gt>_to_bytes(OBJ) 2253 2254Returns a byte string representation of OBJ. The byte string is in big endian 2255byte order, so if OBJ represents the number 256, the output should be the 2256two-byte string "\x01\x00". 2257 2258=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ) 2259 2260Returns a string representation of OBJ in base BASE with collation sequence 2261COLLSEQ. 2262 2263 $val = $class -> _new("210"); 2264 $str = $class -> _to_base($val, 10, "xyz") # $str is "zyx" 2265 2266 $val = $class -> _new("32"); 2267 $str = $class -> _to_base($val, 2, "-|") # $str is "|-----" 2268 2269See _from_base() for more information. 2270 2271=item CLASS-E<gt>_as_bin(OBJ) 2272 2273Like C<_to_bin()> but with a '0b' prefix. 2274 2275=item CLASS-E<gt>_as_oct(OBJ) 2276 2277Like C<_to_oct()> but with a '0' prefix. 2278 2279=item CLASS-E<gt>_as_hex(OBJ) 2280 2281Like C<_to_hex()> but with a '0x' prefix. 2282 2283=item CLASS-E<gt>_as_bytes(OBJ) 2284 2285This is an alias to C<_to_bytes()>. 2286 2287=back 2288 2289=head3 Numeric conversion 2290 2291=over 4 2292 2293=item CLASS-E<gt>_num(OBJ) 2294 2295Returns a Perl scalar number representing the number OBJ as close as 2296possible. Since Perl scalars have limited precision, the returned value might 2297not be exactly the same as OBJ. 2298 2299=back 2300 2301=head3 Miscellaneous 2302 2303=over 4 2304 2305=item CLASS-E<gt>_copy(OBJ) 2306 2307Returns a true copy OBJ. 2308 2309=item CLASS-E<gt>_len(OBJ) 2310 2311Returns the number of the decimal digits in OBJ. The output is a Perl scalar. 2312 2313=item CLASS-E<gt>_zeros(OBJ) 2314 2315Returns the number of trailing decimal zeros. The output is a Perl scalar. The 2316number zero has no trailing decimal zeros. 2317 2318=item CLASS-E<gt>_digit(OBJ, N) 2319 2320Returns the Nth digit in OBJ as a Perl scalar. N is a Perl scalar, where zero 2321refers to the rightmost (least significant) digit, and negative values count 2322from the left (most significant digit). If $obj represents the number 123, then 2323 2324 CLASS->_digit($obj, 0) # returns 3 2325 CLASS->_digit($obj, 1) # returns 2 2326 CLASS->_digit($obj, 2) # returns 1 2327 CLASS->_digit($obj, -1) # returns 1 2328 2329=item CLASS-E<gt>_digitsum(OBJ) 2330 2331Returns the sum of the base 10 digits. 2332 2333=item CLASS-E<gt>_check(OBJ) 2334 2335Returns true if the object is invalid and false otherwise. Preferably, the true 2336value is a string describing the problem with the object. This is a check 2337routine to test the internal state of the object for corruption. 2338 2339=item CLASS-E<gt>_set(OBJ) 2340 2341xxx 2342 2343=back 2344 2345=head2 API version 2 2346 2347The following methods are required for an API version of 2 or greater. 2348 2349=head3 Constructors 2350 2351=over 4 2352 2353=item CLASS-E<gt>_1ex(N) 2354 2355Return an object representing the number 10**N where N E<gt>= 0 is a Perl 2356scalar. 2357 2358=back 2359 2360=head3 Mathematical functions 2361 2362=over 4 2363 2364=item CLASS-E<gt>_nok(OBJ1, OBJ2) 2365 2366Return the binomial coefficient OBJ1 over OBJ1. 2367 2368=back 2369 2370=head3 Miscellaneous 2371 2372=over 4 2373 2374=item CLASS-E<gt>_alen(OBJ) 2375 2376Return the approximate number of decimal digits of the object. The output is a 2377Perl scalar. 2378 2379=back 2380 2381=head1 WRAP YOUR OWN 2382 2383If you want to port your own favourite C library for big numbers to the 2384Math::BigInt interface, you can take any of the already existing modules as a 2385rough guideline. You should really wrap up the latest Math::BigInt and 2386Math::BigFloat testsuites with your module, and replace in them any of the 2387following: 2388 2389 use Math::BigInt; 2390 2391by this: 2392 2393 use Math::BigInt lib => 'yourlib'; 2394 2395This way you ensure that your library really works 100% within Math::BigInt. 2396 2397=head1 BUGS 2398 2399Please report any bugs or feature requests to 2400C<bug-math-bigint at rt.cpan.org>, or through the web interface at 2401L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> 2402(requires login). 2403We will be notified, and then you'll automatically be notified of progress on 2404your bug as I make changes. 2405 2406=head1 SUPPORT 2407 2408You can find documentation for this module with the perldoc command. 2409 2410 perldoc Math::BigInt::Calc 2411 2412You can also look for information at: 2413 2414=over 4 2415 2416=item * RT: CPAN's request tracker 2417 2418L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt> 2419 2420=item * AnnoCPAN: Annotated CPAN documentation 2421 2422L<http://annocpan.org/dist/Math-BigInt> 2423 2424=item * CPAN Ratings 2425 2426L<https://cpanratings.perl.org/dist/Math-BigInt> 2427 2428=item * MetaCPAN 2429 2430L<https://metacpan.org/release/Math-BigInt> 2431 2432=item * CPAN Testers Matrix 2433 2434L<http://matrix.cpantesters.org/?dist=Math-BigInt> 2435 2436=item * The Bignum mailing list 2437 2438=over 4 2439 2440=item * Post to mailing list 2441 2442C<bignum at lists.scsys.co.uk> 2443 2444=item * View mailing list 2445 2446L<http://lists.scsys.co.uk/pipermail/bignum/> 2447 2448=item * Subscribe/Unsubscribe 2449 2450L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum> 2451 2452=back 2453 2454=back 2455 2456=head1 LICENSE 2457 2458This program is free software; you may redistribute it and/or modify it under 2459the same terms as Perl itself. 2460 2461=head1 AUTHOR 2462 2463Peter John Acklam, E<lt>pjacklam@online.noE<gt> 2464 2465Code and documentation based on the Math::BigInt::Calc module by Tels 2466E<lt>nospam-abuse@bloodgate.comE<gt> 2467 2468=head1 SEE ALSO 2469 2470L<Math::BigInt>, L<Math::BigInt::Calc>, L<Math::BigInt::GMP>, 2471L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>. 2472 2473=cut 2474