blob: f0d4ef86313aa4cdd0d349114b0c85e3183de5da (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;;;; Under Creative Commons Attribution-ShareAlike 4.0
;;;; International. See
;;;; <https://creativecommons.org/licenses/by-sa/4.0/>.
(define-module (net ricketyspace sicp one twentyeight)
#:use-module (srfi srfi-1)
#:export (miller-rabin-test prime? run-tests))
(define (sqmod x m)
"Return x^2 if `x^2 mod m` is not equal to `1 mod m`
and x != m - 1 and x != 1; 0 otherwise."
(let ((square (* x x)))
(cond ((and (= (remainder square m) 1) ; 1 mod m = 1
(not (= x (1- m)))
(not (= x 1)))
0)
(else square))))
(define (expmod base exp m)
(cond ((= exp 0) 1)
((even? exp)
(remainder (sqmod (expmod base (/ exp 2) m) m)
m))
(else
(remainder (* base (expmod base (- exp 1) m))
m))))
(define (miller-rabin-test n)
(define (pass? a)
(= (expmod a (1- n) n) 1))
(fold (lambda (a p) (and (pass? a) p)) #t (iota (1- n) 1)))
(define (prime? n)
(if (miller-rabin-test n) #t #f))
;;; Tests
(define (carmichael-numbers-pass?)
"Return #t if the sample carmichael numbers are detected as non-prime."
(let ((numbers '(561 1105 1729 2465 2821 6601)))
(cons "carmichael-numbers-pass?"
(fold (lambda (n p) (and (not (prime? n)) p)) #t numbers))))
(define (prime-numbers-pass?)
"Return #t if the sample prime numbers are detected as prime"
(let ((numbers '(311 641 829 599 809 127 419 13 431 883)))
(cons "prime-numbers-pass?"
(fold (lambda (n p) (and (prime? n) p)) #t numbers))))
(define (even-numbers-pass?)
"Return #t if the sample even numbers are detected as non-prime"
(let ((numbers '(302 640 828 594 804 128 414 12 436 888)))
(cons "prime-numbers-pass?"
(fold (lambda (n p) (and (not (prime? n)) p)) #t numbers))))
(define (run-tests)
(map (lambda (test) (test)) (list carmichael-numbers-pass?
prime-numbers-pass?
even-numbers-pass?)))
;;; Guile REPL
;;;
;;; scheme@(guile-user)> ,use (net ricketyspace sicp one twentyeight)
;;; scheme@(guile-user)> (run-tests)
;;; $18 = (("carmichael-numbers-pass?" . #t) ("prime-numbers-pass?" . #t) ("prime-numbers-pass?" . #t))
|
