1 |
;; Calculator for GNU Emacs, part II [calc-comb.el] |
;; Calculator for GNU Emacs, part II [calc-comb.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
34 |
(defun calc-gcd (arg) |
(defun calc-gcd (arg) |
35 |
(interactive "P") |
(interactive "P") |
36 |
(calc-slow-wrapper |
(calc-slow-wrapper |
37 |
(calc-binary-op "gcd" 'calcFunc-gcd arg)) |
(calc-binary-op "gcd" 'calcFunc-gcd arg))) |
|
) |
|
38 |
|
|
39 |
(defun calc-lcm (arg) |
(defun calc-lcm (arg) |
40 |
(interactive "P") |
(interactive "P") |
41 |
(calc-slow-wrapper |
(calc-slow-wrapper |
42 |
(calc-binary-op "lcm" 'calcFunc-lcm arg)) |
(calc-binary-op "lcm" 'calcFunc-lcm arg))) |
|
) |
|
43 |
|
|
44 |
(defun calc-extended-gcd () |
(defun calc-extended-gcd () |
45 |
(interactive) |
(interactive) |
46 |
(calc-slow-wrapper |
(calc-slow-wrapper |
47 |
(calc-enter-result 2 "egcd" (cons 'calcFunc-egcd (calc-top-list-n 2)))) |
(calc-enter-result 2 "egcd" (cons 'calcFunc-egcd (calc-top-list-n 2))))) |
|
) |
|
48 |
|
|
49 |
(defun calc-factorial (arg) |
(defun calc-factorial (arg) |
50 |
(interactive "P") |
(interactive "P") |
51 |
(calc-slow-wrapper |
(calc-slow-wrapper |
52 |
(calc-unary-op "fact" 'calcFunc-fact arg)) |
(calc-unary-op "fact" 'calcFunc-fact arg))) |
|
) |
|
53 |
|
|
54 |
(defun calc-gamma (arg) |
(defun calc-gamma (arg) |
55 |
(interactive "P") |
(interactive "P") |
56 |
(calc-slow-wrapper |
(calc-slow-wrapper |
57 |
(calc-unary-op "gmma" 'calcFunc-gamma arg)) |
(calc-unary-op "gmma" 'calcFunc-gamma arg))) |
|
) |
|
58 |
|
|
59 |
(defun calc-double-factorial (arg) |
(defun calc-double-factorial (arg) |
60 |
(interactive "P") |
(interactive "P") |
61 |
(calc-slow-wrapper |
(calc-slow-wrapper |
62 |
(calc-unary-op "dfac" 'calcFunc-dfact arg)) |
(calc-unary-op "dfac" 'calcFunc-dfact arg))) |
|
) |
|
63 |
|
|
64 |
(defun calc-choose (arg) |
(defun calc-choose (arg) |
65 |
(interactive "P") |
(interactive "P") |
66 |
(calc-slow-wrapper |
(calc-slow-wrapper |
67 |
(if (calc-is-hyperbolic) |
(if (calc-is-hyperbolic) |
68 |
(calc-binary-op "perm" 'calcFunc-perm arg) |
(calc-binary-op "perm" 'calcFunc-perm arg) |
69 |
(calc-binary-op "chos" 'calcFunc-choose arg))) |
(calc-binary-op "chos" 'calcFunc-choose arg)))) |
|
) |
|
70 |
|
|
71 |
(defun calc-perm (arg) |
(defun calc-perm (arg) |
72 |
(interactive "P") |
(interactive "P") |
73 |
(calc-hyperbolic-func) |
(calc-hyperbolic-func) |
74 |
(calc-choose arg) |
(calc-choose arg)) |
|
) |
|
75 |
|
|
76 |
(defvar calc-last-random-limit '(float 1 0)) |
(defvar calc-last-random-limit '(float 1 0)) |
77 |
(defun calc-random (n) |
(defun calc-random (n) |
83 |
(prefix-numeric-value n)))) |
(prefix-numeric-value n)))) |
84 |
(calc-enter-result 1 "rand" (list 'calcFunc-random |
(calc-enter-result 1 "rand" (list 'calcFunc-random |
85 |
(calc-get-random-limit |
(calc-get-random-limit |
86 |
(calc-top-n 1)))))) |
(calc-top-n 1))))))) |
|
) |
|
87 |
|
|
88 |
(defun calc-get-random-limit (val) |
(defun calc-get-random-limit (val) |
89 |
(if (eq val 0) |
(if (eq val 0) |
90 |
calc-last-random-limit |
calc-last-random-limit |
91 |
(setq calc-last-random-limit val)) |
(setq calc-last-random-limit val))) |
|
) |
|
92 |
|
|
93 |
(defun calc-rrandom () |
(defun calc-rrandom () |
94 |
(interactive) |
(interactive) |
95 |
(calc-slow-wrapper |
(calc-slow-wrapper |
96 |
(setq calc-last-random-limit '(float 1 0)) |
(setq calc-last-random-limit '(float 1 0)) |
97 |
(calc-enter-result 0 "rand" (list 'calcFunc-random '(float 1 0)))) |
(calc-enter-result 0 "rand" (list 'calcFunc-random '(float 1 0))))) |
|
) |
|
98 |
|
|
99 |
(defun calc-random-again (arg) |
(defun calc-random-again (arg) |
100 |
(interactive "p") |
(interactive "p") |
101 |
(calc-slow-wrapper |
(calc-slow-wrapper |
102 |
(while (>= (setq arg (1- arg)) 0) |
(while (>= (setq arg (1- arg)) 0) |
103 |
(calc-enter-result 0 "rand" (list 'calcFunc-random |
(calc-enter-result 0 "rand" (list 'calcFunc-random |
104 |
calc-last-random-limit)))) |
calc-last-random-limit))))) |
|
) |
|
105 |
|
|
106 |
(defun calc-shuffle (n) |
(defun calc-shuffle (n) |
107 |
(interactive "P") |
(interactive "P") |
114 |
(calc-enter-result 2 "shuf" (list 'calcFunc-shuffle |
(calc-enter-result 2 "shuf" (list 'calcFunc-shuffle |
115 |
(calc-top-n 1) |
(calc-top-n 1) |
116 |
(calc-get-random-limit |
(calc-get-random-limit |
117 |
(calc-top-n 2)))))) |
(calc-top-n 2))))))) |
|
) |
|
118 |
|
|
119 |
(defun calc-report-prime-test (res) |
(defun calc-report-prime-test (res) |
120 |
(cond ((eq (car res) t) |
(cond ((eq (car res) t) |
133 |
"prim" "Probably prime (%d iters; %s%% chance of error)" |
"prim" "Probably prime (%d iters; %s%% chance of error)" |
134 |
(nth 1 res) |
(nth 1 res) |
135 |
(let ((calc-float-format '(fix 2))) |
(let ((calc-float-format '(fix 2))) |
136 |
(math-format-number (nth 2 res)))))) |
(math-format-number (nth 2 res))))))) |
|
) |
|
137 |
|
|
138 |
(defun calc-prime-test (iters) |
(defun calc-prime-test (iters) |
139 |
(interactive "p") |
(interactive "p") |
140 |
(calc-slow-wrapper |
(calc-slow-wrapper |
141 |
(let* ((n (calc-top-n 1)) |
(let* ((n (calc-top-n 1)) |
142 |
(res (math-prime-test n iters))) |
(res (math-prime-test n iters))) |
143 |
(calc-report-prime-test res))) |
(calc-report-prime-test res)))) |
|
) |
|
144 |
|
|
145 |
(defun calc-next-prime (iters) |
(defun calc-next-prime (iters) |
146 |
(interactive "p") |
(interactive "p") |
150 |
(calc-enter-result 1 "prvp" (list 'calcFunc-prevprime |
(calc-enter-result 1 "prvp" (list 'calcFunc-prevprime |
151 |
(calc-top-n 1) (math-abs iters))) |
(calc-top-n 1) (math-abs iters))) |
152 |
(calc-enter-result 1 "nxtp" (list 'calcFunc-nextprime |
(calc-enter-result 1 "nxtp" (list 'calcFunc-nextprime |
153 |
(calc-top-n 1) (math-abs iters)))))) |
(calc-top-n 1) (math-abs iters))))))) |
|
) |
|
154 |
|
|
155 |
(defun calc-prev-prime (iters) |
(defun calc-prev-prime (iters) |
156 |
(interactive "p") |
(interactive "p") |
157 |
(calc-invert-func) |
(calc-invert-func) |
158 |
(calc-next-prime iters) |
(calc-next-prime iters)) |
|
) |
|
159 |
|
|
160 |
(defun calc-prime-factors (iters) |
(defun calc-prime-factors (iters) |
161 |
(interactive "p") |
(interactive "p") |
163 |
(let ((res (calcFunc-prfac (calc-top-n 1)))) |
(let ((res (calcFunc-prfac (calc-top-n 1)))) |
164 |
(if (not math-prime-factors-finished) |
(if (not math-prime-factors-finished) |
165 |
(calc-record-message "pfac" "Warning: May not be fully factored")) |
(calc-record-message "pfac" "Warning: May not be fully factored")) |
166 |
(calc-enter-result 1 "pfac" res))) |
(calc-enter-result 1 "pfac" res)))) |
|
) |
|
167 |
|
|
168 |
(defun calc-totient (arg) |
(defun calc-totient (arg) |
169 |
(interactive "P") |
(interactive "P") |
170 |
(calc-slow-wrapper |
(calc-slow-wrapper |
171 |
(calc-unary-op "phi" 'calcFunc-totient arg)) |
(calc-unary-op "phi" 'calcFunc-totient arg))) |
|
) |
|
172 |
|
|
173 |
(defun calc-moebius (arg) |
(defun calc-moebius (arg) |
174 |
(interactive "P") |
(interactive "P") |
175 |
(calc-slow-wrapper |
(calc-slow-wrapper |
176 |
(calc-unary-op "mu" 'calcFunc-moebius arg)) |
(calc-unary-op "mu" 'calcFunc-moebius arg))) |
|
) |
|
|
|
|
|
|
|
|
|
|
177 |
|
|
178 |
|
|
179 |
(defun calcFunc-gcd (a b) |
(defun calcFunc-gcd (a b) |
201 |
(list 'calcFunc-gcd a b)) |
(list 'calcFunc-gcd a b)) |
202 |
(t |
(t |
203 |
(calc-record-why 'integerp b) |
(calc-record-why 'integerp b) |
204 |
(list 'calcFunc-gcd a b))) |
(list 'calcFunc-gcd a b)))) |
|
) |
|
205 |
|
|
206 |
(defun calcFunc-lcm (a b) |
(defun calcFunc-lcm (a b) |
207 |
(let ((g (calcFunc-gcd a b))) |
(let ((g (calcFunc-gcd a b))) |
208 |
(if (Math-numberp g) |
(if (Math-numberp g) |
209 |
(math-div (math-mul a b) g) |
(math-div (math-mul a b) g) |
210 |
(list 'calcFunc-lcm a b))) |
(list 'calcFunc-lcm a b)))) |
|
) |
|
211 |
|
|
212 |
(defun calcFunc-egcd (a b) ; Knuth section 4.5.2 |
(defun calcFunc-egcd (a b) ; Knuth section 4.5.2 |
213 |
(cond |
(cond |
231 |
t2 (math-sub u2 (math-mul v2 (car q))) |
t2 (math-sub u2 (math-mul v2 (car q))) |
232 |
u1 v1 u2 v2 u3 v3 |
u1 v1 u2 v2 u3 v3 |
233 |
v1 t1 v2 t2 v3 (cdr q))) |
v1 t1 v2 t2 v3 (cdr q))) |
234 |
(list 'vec u3 u1 u2)))) |
(list 'vec u3 u1 u2))))) |
|
) |
|
235 |
|
|
236 |
|
|
237 |
;;; Factorial and related functions. |
;;; Factorial and related functions. |
292 |
(math-gammap1-raw (math-float n))))))) |
(math-gammap1-raw (math-float n))))))) |
293 |
((equal n '(var inf var-inf)) n) |
((equal n '(var inf var-inf)) n) |
294 |
(t (calc-record-why 'numberp n) |
(t (calc-record-why 'numberp n) |
295 |
(list 'calcFunc-fact n)))) |
(list 'calcFunc-fact n))))) |
|
) |
|
296 |
|
|
297 |
(math-defcache math-gamma-1q nil |
(math-defcache math-gamma-1q nil |
298 |
(math-with-extra-prec 3 |
(math-with-extra-prec 3 |
307 |
(math-working (format "factorial(%d)" (1- n)) f)) |
(math-working (format "factorial(%d)" (1- n)) f)) |
308 |
(if (> count 0) |
(if (> count 0) |
309 |
(math-factorial-iter (1- count) (1+ n) (math-mul n f)) |
(math-factorial-iter (1- count) (1+ n) (math-mul n f)) |
310 |
f) |
f)) |
|
) |
|
311 |
|
|
312 |
(defun calcFunc-dfact (n) ; [I I] [F F] [Public] |
(defun calcFunc-dfact (n) ; [I I] [F F] [Public] |
313 |
(cond ((Math-integer-negp n) |
(cond ((Math-integer-negp n) |
336 |
(list 'calcFunc-dfact max)))) |
(list 'calcFunc-dfact max)))) |
337 |
((equal n '(var inf var-inf)) n) |
((equal n '(var inf var-inf)) n) |
338 |
(t (calc-record-why 'natnump n) |
(t (calc-record-why 'natnump n) |
339 |
(list 'calcFunc-dfact n))) |
(list 'calcFunc-dfact n)))) |
|
) |
|
340 |
|
|
341 |
(defun math-double-factorial-iter (max n f step) |
(defun math-double-factorial-iter (max n f step) |
342 |
(if (< (% n 12) step) |
(if (< (% n 12) step) |
343 |
(math-working (format "dfact(%d)" (- n step)) f)) |
(math-working (format "dfact(%d)" (- n step)) f)) |
344 |
(if (<= n max) |
(if (<= n max) |
345 |
(math-double-factorial-iter max (+ n step) (math-mul n f) step) |
(math-double-factorial-iter max (+ n step) (math-mul n f) step) |
346 |
f) |
f)) |
|
) |
|
347 |
|
|
348 |
(defun calcFunc-perm (n m) ; [I I I] [F F F] [Public] |
(defun calcFunc-perm (n m) ; [I I I] [F F F] [Public] |
349 |
(cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) |
(cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) |
367 |
(or (integerp tm) (math-reject-arg tm 'fixnump)) |
(or (integerp tm) (math-reject-arg tm 'fixnump)) |
368 |
(or (and (<= tm tn) (>= tm 0)) (math-reject-arg tm 'range)) |
(or (and (<= tm tn) (>= tm 0)) (math-reject-arg tm 'range)) |
369 |
(math-with-extra-prec 1 |
(math-with-extra-prec 1 |
370 |
(math-factorial-iter tm (1+ (- tn tm)) '(float 1 0)))))) |
(math-factorial-iter tm (1+ (- tn tm)) '(float 1 0))))))) |
|
) |
|
371 |
|
|
372 |
(defun calcFunc-choose (n m) ; [I I I] [F F F] [Public] |
(defun calcFunc-choose (n m) ; [I I I] [F F F] [Public] |
373 |
(cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) |
(cond ((and (integerp n) (integerp m) (<= m n) (>= m 0)) |
403 |
(calcFunc-fact (math-float |
(calcFunc-fact (math-float |
404 |
(math-sub n m))))) |
(math-sub n m))))) |
405 |
(math-with-extra-prec 1 |
(math-with-extra-prec 1 |
406 |
(math-choose-float-iter tm n 1 1)))))) |
(math-choose-float-iter tm n 1 1))))))) |
|
) |
|
407 |
|
|
408 |
(defun math-choose-iter (m n i c) |
(defun math-choose-iter (m n i c) |
409 |
(if (and (= (% i 5) 1) (> i 5)) |
(if (and (= (% i 5) 1) (> i 5)) |
411 |
(if (<= i m) |
(if (<= i m) |
412 |
(math-choose-iter m (1- n) (1+ i) |
(math-choose-iter m (1- n) (1+ i) |
413 |
(math-quotient (math-mul c n) i)) |
(math-quotient (math-mul c n) i)) |
414 |
c) |
c)) |
|
) |
|
415 |
|
|
416 |
(defun math-choose-float-iter (count n i c) |
(defun math-choose-float-iter (count n i c) |
417 |
(if (= (% i 5) 1) |
(if (= (% i 5) 1) |
419 |
(if (> count 0) |
(if (> count 0) |
420 |
(math-choose-float-iter (1- count) (math-sub n 1) (1+ i) |
(math-choose-float-iter (1- count) (math-sub n 1) (1+ i) |
421 |
(math-div (math-mul c n) i)) |
(math-div (math-mul c n) i)) |
422 |
c) |
c)) |
|
) |
|
423 |
|
|
424 |
|
|
425 |
;;; Stirling numbers. |
;;; Stirling numbers. |
426 |
|
|
427 |
(defun calcFunc-stir1 (n m) |
(defun calcFunc-stir1 (n m) |
428 |
(math-stirling-number n m 1) |
(math-stirling-number n m 1)) |
|
) |
|
429 |
|
|
430 |
(defun calcFunc-stir2 (n m) |
(defun calcFunc-stir2 (n m) |
431 |
(math-stirling-number n m 0) |
(math-stirling-number n m 0)) |
|
) |
|
432 |
|
|
433 |
(defun math-stirling-number (n m k) |
(defun math-stirling-number (n m k) |
434 |
(or (math-num-natnump n) (math-reject-arg n 'natnump)) |
(or (math-num-natnump n) (math-reject-arg n 'natnump)) |
451 |
(aset row i 1)))) |
(aset row i 1)))) |
452 |
(if (= k 1) |
(if (= k 1) |
453 |
(math-stirling-1 n m) |
(math-stirling-1 n m) |
454 |
(math-stirling-2 n m)))) |
(math-stirling-2 n m))))) |
|
) |
|
455 |
(setq math-stirling-cache (vector [[1]] [[1]])) |
(setq math-stirling-cache (vector [[1]] [[1]])) |
456 |
|
|
457 |
(defun math-stirling-1 (n m) |
(defun math-stirling-1 (n m) |
458 |
(or (aref (aref cache n) m) |
(or (aref (aref cache n) m) |
459 |
(aset (aref cache n) m |
(aset (aref cache n) m |
460 |
(math-add (math-stirling-1 (1- n) (1- m)) |
(math-add (math-stirling-1 (1- n) (1- m)) |
461 |
(math-mul (- 1 n) (math-stirling-1 (1- n) m))))) |
(math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) |
|
) |
|
462 |
|
|
463 |
(defun math-stirling-2 (n m) |
(defun math-stirling-2 (n m) |
464 |
(or (aref (aref cache n) m) |
(or (aref (aref cache n) m) |
465 |
(aset (aref cache n) m |
(aset (aref cache n) m |
466 |
(math-add (math-stirling-2 (1- n) (1- m)) |
(math-add (math-stirling-2 (1- n) (1- m)) |
467 |
(math-mul m (math-stirling-2 (1- n) m))))) |
(math-mul m (math-stirling-2 (1- n) m)))))) |
|
) |
|
468 |
|
|
469 |
|
|
470 |
;;; Produce a random 10-bit integer, with (random) if no seed provided, |
;;; Produce a random 10-bit integer, with (random) if no seed provided, |
505 |
(if (> (lsh (math-abs (random)) math-random-shift) 4095) |
(if (> (lsh (math-abs (random)) math-random-shift) 4095) |
506 |
(setq math-random-shift (1- math-random-shift))))) |
(setq math-random-shift (1- math-random-shift))))) |
507 |
(setq math-last-RandSeed var-RandSeed |
(setq math-last-RandSeed var-RandSeed |
508 |
math-gaussian-cache nil) |
math-gaussian-cache nil)) |
|
) |
|
509 |
|
|
510 |
(defun math-random-base () |
(defun math-random-base () |
511 |
(if var-RandSeed |
(if var-RandSeed |
518 |
(logand (- (car math-random-ptr1) |
(logand (- (car math-random-ptr1) |
519 |
(car math-random-ptr2)) 524287)) |
(car math-random-ptr2)) 524287)) |
520 |
-6) 1023)) |
-6) 1023)) |
521 |
(logand (lsh (random) math-random-shift) 1023)) |
(logand (lsh (random) math-random-shift) 1023))) |
|
) |
|
522 |
(setq math-random-table nil) |
(setq math-random-table nil) |
523 |
(setq math-last-RandSeed nil) |
(setq math-last-RandSeed nil) |
524 |
(setq math-random-ptr1 nil) |
(setq math-random-ptr1 nil) |
545 |
math-random-last (aref math-random-cache i)) |
math-random-last (aref math-random-cache i)) |
546 |
(aset math-random-cache i (math-random-base)) |
(aset math-random-cache i (math-random-base)) |
547 |
(>= math-random-last 1000))) |
(>= math-random-last 1000))) |
548 |
math-random-last) |
math-random-last)) |
|
) |
|
549 |
(setq math-random-cache nil) |
(setq math-random-cache nil) |
550 |
|
|
551 |
;;; Produce an N-digit random integer. |
;;; Produce an N-digit random integer. |
560 |
(setq digs (cons (math-random-digit) digs) |
(setq digs (cons (math-random-digit) digs) |
561 |
i (1- i))) |
i (1- i))) |
562 |
(math-normalize (math-scale-right (cons 'bigpos digs) |
(math-normalize (math-scale-right (cons 'bigpos digs) |
563 |
slop))))) |
slop)))))) |
|
) |
|
564 |
|
|
565 |
;;; Produce a uniformly-distributed random float 0 <= N < 1. |
;;; Produce a uniformly-distributed random float 0 <= N < 1. |
566 |
(defun math-random-float () |
(defun math-random-float () |
567 |
(math-make-float (math-random-digits calc-internal-prec) |
(math-make-float (math-random-digits calc-internal-prec) |
568 |
(- calc-internal-prec)) |
(- calc-internal-prec))) |
|
) |
|
569 |
|
|
570 |
;;; Produce a Gaussian-distributed random float with mean=0, sigma=1. |
;;; Produce a Gaussian-distributed random float with mean=0, sigma=1. |
571 |
(defun math-gaussian-float () |
(defun math-gaussian-float () |
585 |
(let ((fac (math-sqrt (math-mul (math-div (calcFunc-ln r) r) -2)))) |
(let ((fac (math-sqrt (math-mul (math-div (calcFunc-ln r) r) -2)))) |
586 |
(setq math-gaussian-cache (cons calc-internal-prec |
(setq math-gaussian-cache (cons calc-internal-prec |
587 |
(math-mul v1 fac))) |
(math-mul v1 fac))) |
588 |
(math-mul v2 fac))))) |
(math-mul v2 fac)))))) |
|
) |
|
589 |
(setq math-gaussian-cache nil) |
(setq math-gaussian-cache nil) |
590 |
|
|
591 |
;;; Produce a random integer or real 0 <= N < MAX. |
;;; Produce a random integer or real 0 <= N < MAX. |
623 |
(math-reject-arg max "*Empty list"))) |
(math-reject-arg max "*Empty list"))) |
624 |
((and (eq (car max) 'sdev) (math-constp max) (Math-realp (nth 1 max))) |
((and (eq (car max) 'sdev) (math-constp max) (Math-realp (nth 1 max))) |
625 |
(math-add (math-mul (math-gaussian-float) (nth 2 max)) (nth 1 max))) |
(math-add (math-mul (math-gaussian-float) (nth 2 max)) (nth 1 max))) |
626 |
(t (math-reject-arg max 'realp))) |
(t (math-reject-arg max 'realp)))) |
|
) |
|
627 |
|
|
628 |
;;; Choose N objects at random from the set MAX without duplicates. |
;;; Choose N objects at random from the set MAX without duplicates. |
629 |
(defun calcFunc-shuffle (n &optional max) |
(defun calcFunc-shuffle (n &optional max) |
678 |
(if (math-posp max) |
(if (math-posp max) |
679 |
(calcFunc-shuffle n (list 'intv 2 0 max)) |
(calcFunc-shuffle n (list 'intv 2 0 max)) |
680 |
(calcFunc-shuffle n (list 'intv 1 max 0)))) |
(calcFunc-shuffle n (list 'intv 1 max 0)))) |
681 |
(t (math-reject-arg max 'realp))) |
(t (math-reject-arg max 'realp)))) |
|
) |
|
682 |
|
|
683 |
(defun math-simple-shuffle (n max) |
(defun math-simple-shuffle (n max) |
684 |
(let ((vec nil) |
(let ((vec nil) |
686 |
(while (>= (setq n (1- n)) 0) |
(while (>= (setq n (1- n)) 0) |
687 |
(while (math-member (setq val (calcFunc-random max)) vec)) |
(while (math-member (setq val (calcFunc-random max)) vec)) |
688 |
(setq vec (cons val vec))) |
(setq vec (cons val vec))) |
689 |
(cons 'vec vec)) |
(cons 'vec vec))) |
|
) |
|
690 |
|
|
691 |
(defun math-shuffle-list (n size vec) |
(defun math-shuffle-list (n size vec) |
692 |
(let ((j size) |
(let ((j size) |
698 |
temp (nth k p)) |
temp (nth k p)) |
699 |
(setcar (nthcdr k p) (car p)) |
(setcar (nthcdr k p) (car p)) |
700 |
(setcar p temp)) |
(setcar p temp)) |
701 |
(cons 'vec (nthcdr (- size n -1) vec))) |
(cons 'vec (nthcdr (- size n -1) vec)))) |
|
) |
|
702 |
|
|
703 |
(defun math-member (x list) |
(defun math-member (x list) |
704 |
(while (and list (not (equal x (car list)))) |
(while (and list (not (equal x (car list)))) |
705 |
(setq list (cdr list))) |
(setq list (cdr list))) |
706 |
list |
list) |
|
) |
|
707 |
|
|
708 |
|
|
709 |
;;; Check if the integer N is prime. [X I] |
;;; Check if the integer N is prime. [X I] |
795 |
iters (if (eq (car res) 'maybe) |
iters (if (eq (car res) 'maybe) |
796 |
(1- iters) |
(1- iters) |
797 |
0))) |
0))) |
798 |
res) |
res)) |
|
) |
|
799 |
(defvar math-prime-test-cache '(-1)) |
(defvar math-prime-test-cache '(-1)) |
800 |
|
|
801 |
(defun calcFunc-prime (n &optional iters) |
(defun calcFunc-prime (n &optional iters) |
803 |
(or (not iters) (math-num-integerp iters) (math-reject-arg iters 'integerp)) |
(or (not iters) (math-num-integerp iters) (math-reject-arg iters 'integerp)) |
804 |
(if (car (math-prime-test (math-trunc n) (math-trunc (or iters 1)))) |
(if (car (math-prime-test (math-trunc n) (math-trunc (or iters 1)))) |
805 |
1 |
1 |
806 |
0) |
0)) |
|
) |
|
807 |
|
|
808 |
;;; Theory: summing base-10^6 digits modulo 111111 is "casting out 999999s". |
;;; Theory: summing base-10^6 digits modulo 111111 is "casting out 999999s". |
809 |
;;; Initial probability that N is prime is 1/ln(N) = log10(e)/log10(N). |
;;; Initial probability that N is prime is 1/ln(N) = log10(e)/log10(N). |
845 |
(list 'vec n) |
(list 'vec n) |
846 |
(cons 'vec (cons -1 (cdr (calcFunc-prfac (math-neg n)))))) |
(cons 'vec (cons -1 (cdr (calcFunc-prfac (math-neg n)))))) |
847 |
(calc-record-why 'integerp n) |
(calc-record-why 'integerp n) |
848 |
(list 'calcFunc-prfac n))) |
(list 'calcFunc-prfac n)))) |
|
) |
|
849 |
|
|
850 |
(defun calcFunc-totient (n) |
(defun calcFunc-totient (n) |
851 |
(if (Math-messy-integerp n) |
(if (Math-messy-integerp n) |
868 |
(calc-record-why "*Number too big to factor" n) |
(calc-record-why "*Number too big to factor" n) |
869 |
(list 'calcFunc-totient n)))) |
(list 'calcFunc-totient n)))) |
870 |
(calc-record-why 'natnump n) |
(calc-record-why 'natnump n) |
871 |
(list 'calcFunc-totient n)) |
(list 'calcFunc-totient n))) |
|
) |
|
872 |
|
|
873 |
(defun calcFunc-moebius (n) |
(defun calcFunc-moebius (n) |
874 |
(if (Math-messy-integerp n) |
(if (Math-messy-integerp n) |
890 |
(calc-record-why "Number too big to factor" n) |
(calc-record-why "Number too big to factor" n) |
891 |
(list 'calcFunc-moebius n)))) |
(list 'calcFunc-moebius n)))) |
892 |
(calc-record-why 'posintp n) |
(calc-record-why 'posintp n) |
893 |
(list 'calcFunc-moebius n)) |
(list 'calcFunc-moebius n))) |
|
) |
|
894 |
|
|
895 |
|
|
896 |
(defun calcFunc-nextprime (n &optional iters) |
(defun calcFunc-nextprime (n &optional iters) |
911 |
n)) |
n)) |
912 |
(if (Math-realp n) |
(if (Math-realp n) |
913 |
(calcFunc-nextprime (math-trunc n) iters) |
(calcFunc-nextprime (math-trunc n) iters) |
914 |
(math-reject-arg n 'integerp))) |
(math-reject-arg n 'integerp)))) |
|
) |
|
915 |
(setq calc-verbose-nextprime nil) |
(setq calc-verbose-nextprime nil) |
916 |
|
|
917 |
(defun calcFunc-prevprime (n &optional iters) |
(defun calcFunc-prevprime (n &optional iters) |
930 |
n) |
n) |
931 |
(if (Math-realp n) |
(if (Math-realp n) |
932 |
(calcFunc-prevprime (math-ceiling n) iters) |
(calcFunc-prevprime (math-ceiling n) iters) |
933 |
(math-reject-arg n 'integerp))) |
(math-reject-arg n 'integerp)))) |
|
) |
|
934 |
|
|
935 |
(defun math-next-small-prime (n) |
(defun math-next-small-prime (n) |
936 |
(if (and (integerp n) (> n 2)) |
(if (and (integerp n) (> n 2)) |
943 |
(setq lo mid) |
(setq lo mid) |
944 |
(setq hi mid))) |
(setq hi mid))) |
945 |
(aref math-primes-table hi)) |
(aref math-primes-table hi)) |
946 |
2) |
2)) |
|
) |
|
947 |
|
|
948 |
(defconst math-primes-table |
(defconst math-primes-table |
949 |
[2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 |
[2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 |
994 |
4987 4993 4999 5003]) |
4987 4993 4999 5003]) |
995 |
|
|
996 |
|
|
997 |
|
;;; calc-comb.el ends here |
|
|
|