/[emacs]/emacs/lisp/calc/calc-comb.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-comb.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:02:18 2001 UTC
# Line 1  Line 1 
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.
# Line 34  Line 34 
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)
# Line 91  Line 83 
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")
# Line 126  Line 114 
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)
# Line 146  Line 133 
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")
# Line 165  Line 150 
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")
# Line 180  Line 163 
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)
# Line 224  Line 201 
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
# Line 256  Line 231 
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.
# Line 318  Line 292 
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
# Line 334  Line 307 
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)
# Line 364  Line 336 
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))
# Line 397  Line 367 
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))
# Line 434  Line 403 
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))
# Line 443  Line 411 
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)
# Line 452  Line 419 
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))
# Line 487  Line 451 
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,
# Line 544  Line 505 
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
# Line 558  Line 518 
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)
# Line 586  Line 545 
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.
# Line 602  Line 560 
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 ()
# Line 629  Line 585 
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.
# Line 668  Line 623 
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)
# Line 724  Line 678 
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)
# Line 733  Line 686 
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)
# Line 746  Line 698 
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]
# Line 845  Line 795 
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)
# Line 854  Line 803 
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).
# Line 897  Line 845 
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)
# Line 921  Line 868 
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)
# Line 944  Line 890 
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)
# Line 966  Line 911 
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)
# Line 986  Line 930 
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))
# Line 1000  Line 943 
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
# Line 1052  Line 994 
994       4987 4993 4999 5003])       4987 4993 4999 5003])
995    
996    
997    ;;; calc-comb.el ends here
   

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26