aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/calc/calc-comb.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calc/calc-comb.el')
-rw-r--r--lisp/calc/calc-comb.el68
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)