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