diff options
Diffstat (limited to 'lisp/calc/calc-comb.el')
| -rw-r--r-- | lisp/calc/calc-comb.el | 68 |
1 files changed, 45 insertions, 23 deletions
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index c7ecbecc80b..8b0dffe3f15 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el | |||
| @@ -82,6 +82,11 @@ | |||
| 82 | 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 | 82 | 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 |
| 83 | 4987 4993 4999 5003]) | 83 | 4987 4993 4999 5003]) |
| 84 | 84 | ||
| 85 | ;; The variable math-prime-factors-finished is set by calcFunc-prfac to | ||
| 86 | ;; indicate whether factoring is complete, and used by calcFunc-factors, | ||
| 87 | ;; calcFunc-totient and calcFunc-moebius. | ||
| 88 | (defvar math-prime-factors-finished) | ||
| 89 | |||
| 85 | ;;; Combinatorics | 90 | ;;; Combinatorics |
| 86 | 91 | ||
| 87 | (defun calc-gcd (arg) | 92 | (defun calc-gcd (arg) |
| @@ -195,6 +200,8 @@ | |||
| 195 | (res (math-prime-test n iters))) | 200 | (res (math-prime-test n iters))) |
| 196 | (calc-report-prime-test res)))) | 201 | (calc-report-prime-test res)))) |
| 197 | 202 | ||
| 203 | (defvar calc-verbose-nextprime nil) | ||
| 204 | |||
| 198 | (defun calc-next-prime (iters) | 205 | (defun calc-next-prime (iters) |
| 199 | (interactive "p") | 206 | (interactive "p") |
| 200 | (calc-slow-wrapper | 207 | (calc-slow-wrapper |
| @@ -386,7 +393,7 @@ | |||
| 386 | (if (math-evenp temp) | 393 | (if (math-evenp temp) |
| 387 | even | 394 | even |
| 388 | (math-div (calcFunc-fact n) even)))) | 395 | (math-div (calcFunc-fact n) even)))) |
| 389 | (list 'calcFunc-dfact max)))) | 396 | (list 'calcFunc-dfact n)))) |
| 390 | ((equal n '(var inf var-inf)) n) | 397 | ((equal n '(var inf var-inf)) n) |
| 391 | (t (calc-record-why 'natnump n) | 398 | (t (calc-record-why 'natnump n) |
| 392 | (list 'calcFunc-dfact n)))) | 399 | (list 'calcFunc-dfact n)))) |
| @@ -484,6 +491,12 @@ | |||
| 484 | (math-stirling-number n m 0)) | 491 | (math-stirling-number n m 0)) |
| 485 | 492 | ||
| 486 | (defvar math-stirling-cache (vector [[1]] [[1]])) | 493 | (defvar math-stirling-cache (vector [[1]] [[1]])) |
| 494 | |||
| 495 | ;; The variable math-stirling-local-cache is local to | ||
| 496 | ;; math-stirling-number, but is used by math-stirling-1 | ||
| 497 | ;; and math-stirling-2, which are called by math-stirling-number. | ||
| 498 | (defvar math-stirling-local-cache) | ||
| 499 | |||
| 487 | (defun math-stirling-number (n m k) | 500 | (defun math-stirling-number (n m k) |
| 488 | (or (math-num-natnump n) (math-reject-arg n 'natnump)) | 501 | (or (math-num-natnump n) (math-reject-arg n 'natnump)) |
| 489 | (or (math-num-natnump m) (math-reject-arg m 'natnump)) | 502 | (or (math-num-natnump m) (math-reject-arg m 'natnump)) |
| @@ -493,14 +506,16 @@ | |||
| 493 | (or (integerp m) (math-reject-arg m 'fixnump)) | 506 | (or (integerp m) (math-reject-arg m 'fixnump)) |
| 494 | (if (< n m) | 507 | (if (< n m) |
| 495 | 0 | 508 | 0 |
| 496 | (let ((cache (aref math-stirling-cache k))) | 509 | (let ((math-stirling-local-cache (aref math-stirling-cache k))) |
| 497 | (while (<= (length cache) n) | 510 | (while (<= (length math-stirling-local-cache) n) |
| 498 | (let ((i (1- (length cache))) | 511 | (let ((i (1- (length math-stirling-local-cache))) |
| 499 | row) | 512 | row) |
| 500 | (setq cache (vconcat cache (make-vector (length cache) nil))) | 513 | (setq math-stirling-local-cache |
| 501 | (aset math-stirling-cache k cache) | 514 | (vconcat math-stirling-local-cache |
| 502 | (while (< (setq i (1+ i)) (length cache)) | 515 | (make-vector (length math-stirling-local-cache) nil))) |
| 503 | (aset cache i (setq row (make-vector (1+ i) nil))) | 516 | (aset math-stirling-cache k math-stirling-local-cache) |
| 517 | (while (< (setq i (1+ i)) (length math-stirling-local-cache)) | ||
| 518 | (aset math-stirling-local-cache i (setq row (make-vector (1+ i) nil))) | ||
| 504 | (aset row 0 0) | 519 | (aset row 0 0) |
| 505 | (aset row i 1)))) | 520 | (aset row i 1)))) |
| 506 | (if (= k 1) | 521 | (if (= k 1) |
| @@ -508,14 +523,14 @@ | |||
| 508 | (math-stirling-2 n m))))) | 523 | (math-stirling-2 n m))))) |
| 509 | 524 | ||
| 510 | (defun math-stirling-1 (n m) | 525 | (defun math-stirling-1 (n m) |
| 511 | (or (aref (aref cache n) m) | 526 | (or (aref (aref math-stirling-local-cache n) m) |
| 512 | (aset (aref cache n) m | 527 | (aset (aref math-stirling-local-cache n) m |
| 513 | (math-add (math-stirling-1 (1- n) (1- m)) | 528 | (math-add (math-stirling-1 (1- n) (1- m)) |
| 514 | (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) | 529 | (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) |
| 515 | 530 | ||
| 516 | (defun math-stirling-2 (n m) | 531 | (defun math-stirling-2 (n m) |
| 517 | (or (aref (aref cache n) m) | 532 | (or (aref (aref math-stirling-local-cache n) m) |
| 518 | (aset (aref cache n) m | 533 | (aset (aref math-stirling-local-cache n) m |
| 519 | (math-add (math-stirling-2 (1- n) (1- m)) | 534 | (math-add (math-stirling-2 (1- n) (1- m)) |
| 520 | (math-mul m (math-stirling-2 (1- n) m)))))) | 535 | (math-mul m (math-stirling-2 (1- n) m)))))) |
| 521 | 536 | ||
| @@ -527,8 +542,13 @@ | |||
| 527 | 542 | ||
| 528 | ;;; Produce a random 10-bit integer, with (random) if no seed provided, | 543 | ;;; Produce a random 10-bit integer, with (random) if no seed provided, |
| 529 | ;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. | 544 | ;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. |
| 545 | |||
| 546 | (defvar var-RandSeed nil) | ||
| 547 | (defvar math-random-cache nil) | ||
| 548 | (defvar math-gaussian-cache nil) | ||
| 549 | |||
| 530 | (defun math-init-random-base () | 550 | (defun math-init-random-base () |
| 531 | (if (and (boundp 'var-RandSeed) var-RandSeed) | 551 | (if var-RandSeed |
| 532 | (if (eq (car-safe var-RandSeed) 'vec) | 552 | (if (eq (car-safe var-RandSeed) 'vec) |
| 533 | nil | 553 | nil |
| 534 | (if (Math-integerp var-RandSeed) | 554 | (if (Math-integerp var-RandSeed) |
| @@ -555,13 +575,13 @@ | |||
| 555 | (random t) | 575 | (random t) |
| 556 | (setq var-RandSeed nil | 576 | (setq var-RandSeed nil |
| 557 | math-random-cache nil | 577 | math-random-cache nil |
| 558 | i 0 | ||
| 559 | math-random-shift -4) ; assume RAND_MAX >= 16383 | 578 | math-random-shift -4) ; assume RAND_MAX >= 16383 |
| 560 | ;; This exercises the random number generator and also helps | 579 | ;; This exercises the random number generator and also helps |
| 561 | ;; deduce a better value for RAND_MAX. | 580 | ;; deduce a better value for RAND_MAX. |
| 562 | (while (< (setq i (1+ i)) 30) | 581 | (let ((i 0)) |
| 563 | (if (> (lsh (math-abs (random)) math-random-shift) 4095) | 582 | (while (< (setq i (1+ i)) 30) |
| 564 | (setq math-random-shift (1- math-random-shift))))) | 583 | (if (> (lsh (math-abs (random)) math-random-shift) 4095) |
| 584 | (setq math-random-shift (1- math-random-shift)))))) | ||
| 565 | (setq math-last-RandSeed var-RandSeed | 585 | (setq math-last-RandSeed var-RandSeed |
| 566 | math-gaussian-cache nil)) | 586 | math-gaussian-cache nil)) |
| 567 | 587 | ||
| @@ -583,8 +603,8 @@ | |||
| 583 | ;;; Avoid various pitfalls that may lurk in the built-in (random) function! | 603 | ;;; Avoid various pitfalls that may lurk in the built-in (random) function! |
| 584 | ;;; Shuffling algorithm from Numerical Recipes, section 7.1. | 604 | ;;; Shuffling algorithm from Numerical Recipes, section 7.1. |
| 585 | (defun math-random-digit () | 605 | (defun math-random-digit () |
| 586 | (let (i) | 606 | (let (i math-random-last) |
| 587 | (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) | 607 | (or (eq var-RandSeed math-last-RandSeed) |
| 588 | (math-init-random-base)) | 608 | (math-init-random-base)) |
| 589 | (or math-random-cache | 609 | (or math-random-cache |
| 590 | (progn | 610 | (progn |
| @@ -599,7 +619,6 @@ | |||
| 599 | (aset math-random-cache i (math-random-base)) | 619 | (aset math-random-cache i (math-random-base)) |
| 600 | (>= math-random-last 1000))) | 620 | (>= math-random-last 1000))) |
| 601 | math-random-last)) | 621 | math-random-last)) |
| 602 | (setq math-random-cache nil) | ||
| 603 | 622 | ||
| 604 | ;;; Produce an N-digit random integer. | 623 | ;;; Produce an N-digit random integer. |
| 605 | (defun math-random-digits (n) | 624 | (defun math-random-digits (n) |
| @@ -639,7 +658,6 @@ | |||
| 639 | (setq math-gaussian-cache (cons calc-internal-prec | 658 | (setq math-gaussian-cache (cons calc-internal-prec |
| 640 | (math-mul v1 fac))) | 659 | (math-mul v1 fac))) |
| 641 | (math-mul v2 fac)))))) | 660 | (math-mul v2 fac)))))) |
| 642 | (setq math-gaussian-cache nil) | ||
| 643 | 661 | ||
| 644 | ;;; Produce a random integer or real 0 <= N < MAX. | 662 | ;;; Produce a random integer or real 0 <= N < MAX. |
| 645 | (defun calcFunc-random (max) | 663 | (defun calcFunc-random (max) |
| @@ -765,6 +783,12 @@ | |||
| 765 | ;;; (nil unknown) if non-prime with no known factors, | 783 | ;;; (nil unknown) if non-prime with no known factors, |
| 766 | ;;; (t) if prime, | 784 | ;;; (t) if prime, |
| 767 | ;;; (maybe N P) if probably prime (after N iters with probability P%) | 785 | ;;; (maybe N P) if probably prime (after N iters with probability P%) |
| 786 | (defvar math-prime-test-cache '(-1)) | ||
| 787 | |||
| 788 | (defvar math-prime-test-cache-k) | ||
| 789 | (defvar math-prime-test-cache-q) | ||
| 790 | (defvar math-prime-test-cache-nm1) | ||
| 791 | |||
| 768 | (defun math-prime-test (n iters) | 792 | (defun math-prime-test (n iters) |
| 769 | (if (and (Math-vectorp n) (cdr n)) | 793 | (if (and (Math-vectorp n) (cdr n)) |
| 770 | (setq n (nth (1- (length n)) n))) | 794 | (setq n (nth (1- (length n)) n))) |
| @@ -849,7 +873,6 @@ | |||
| 849 | (1- iters) | 873 | (1- iters) |
| 850 | 0))) | 874 | 0))) |
| 851 | res)) | 875 | res)) |
| 852 | (defvar math-prime-test-cache '(-1)) | ||
| 853 | 876 | ||
| 854 | (defun calcFunc-prime (n &optional iters) | 877 | (defun calcFunc-prime (n &optional iters) |
| 855 | (or (math-num-integerp n) (math-reject-arg n 'integerp)) | 878 | (or (math-num-integerp n) (math-reject-arg n 'integerp)) |
| @@ -965,7 +988,6 @@ | |||
| 965 | (if (Math-realp n) | 988 | (if (Math-realp n) |
| 966 | (calcFunc-nextprime (math-trunc n) iters) | 989 | (calcFunc-nextprime (math-trunc n) iters) |
| 967 | (math-reject-arg n 'integerp)))) | 990 | (math-reject-arg n 'integerp)))) |
| 968 | (setq calc-verbose-nextprime nil) | ||
| 969 | 991 | ||
| 970 | (defun calcFunc-prevprime (n &optional iters) | 992 | (defun calcFunc-prevprime (n &optional iters) |
| 971 | (if (Math-integerp n) | 993 | (if (Math-integerp n) |