1 665c255d 2023-08-04 jrmu ;; (define (expmod base exp m)
2 665c255d 2023-08-04 jrmu ;; (cond ((= exp 0) 1)
3 665c255d 2023-08-04 jrmu ;; ((even? exp)
4 665c255d 2023-08-04 jrmu ;; (remainder (square (expmod base (/ exp 2) m)) m))
5 665c255d 2023-08-04 jrmu ;; (else (remainder (* base (expmod base (- exp 1) m)) m))))
7 665c255d 2023-08-04 jrmu ;; (define (fermat-test n)
8 665c255d 2023-08-04 jrmu ;; (define (try-it a)
9 665c255d 2023-08-04 jrmu ;; (= (expmod a n n) a))
10 665c255d 2023-08-04 jrmu ;; (try-it (+ 1 (random (- n 1)))))
12 665c255d 2023-08-04 jrmu ;; (define (fast-prime? n times)
13 665c255d 2023-08-04 jrmu ;; (cond ((= times 0) true)
14 665c255d 2023-08-04 jrmu ;; ((fermat-test n) (fast-prime? n (- times 1)))
15 665c255d 2023-08-04 jrmu ;; (else false)))
17 665c255d 2023-08-04 jrmu ;; ;; (define (test-case actual expected)
18 665c255d 2023-08-04 jrmu ;; ;; (load-option 'format)
19 665c255d 2023-08-04 jrmu ;; ;; (newline)
20 665c255d 2023-08-04 jrmu ;; ;; (format #t "Actual: ~A Expected: ~A" actual expected))
22 665c255d 2023-08-04 jrmu ;; (define (prime? n)
23 665c255d 2023-08-04 jrmu ;; (let ((times-to-test 10))
24 665c255d 2023-08-04 jrmu ;; (fast-prime? n times-to-test)))
26 665c255d 2023-08-04 jrmu ;; (define (timed-prime-test n)
27 665c255d 2023-08-04 jrmu ;; (newline)
28 665c255d 2023-08-04 jrmu ;; (display n)
29 665c255d 2023-08-04 jrmu ;; (start-prime-test n (runtime)))
30 665c255d 2023-08-04 jrmu ;; (define (start-prime-test n start-time)
31 665c255d 2023-08-04 jrmu ;; (if (prime? n)
32 665c255d 2023-08-04 jrmu ;; (report-prime (- (runtime) start-time))))
33 665c255d 2023-08-04 jrmu ;; (define (report-prime elapsed-time)
34 665c255d 2023-08-04 jrmu ;; (display " *** ")
35 665c255d 2023-08-04 jrmu ;; (display elapsed-time))
37 665c255d 2023-08-04 jrmu ;; (define (search-for-primes lower upper)
38 665c255d 2023-08-04 jrmu ;; (cond ((even? lower) (search-for-primes (+ lower 1) upper))
39 665c255d 2023-08-04 jrmu ;; ((< lower upper) (begin (timed-prime-test lower)
40 665c255d 2023-08-04 jrmu ;; (search-for-primes (+ lower 2) upper)))
41 665c255d 2023-08-04 jrmu ;; (else (newline)
42 665c255d 2023-08-04 jrmu ;; (display " *** Finished *** "))))
44 665c255d 2023-08-04 jrmu ;; (search-for-primes 100000000000001 100000000000099)
45 665c255d 2023-08-04 jrmu ;; (search-for-primes 1000000000000001 1000000000000099)
46 665c255d 2023-08-04 jrmu ;; (search-for-primes 10000000000000001 10000000000000099)
47 665c255d 2023-08-04 jrmu ;; (search-for-primes 100000000000000001 100000000000000099)
48 665c255d 2023-08-04 jrmu ;; (search-for-primes 1000000000000000001 1000000000000000099)
49 665c255d 2023-08-04 jrmu ;; (search-for-primes 10000000000000000001 10000000000000000099)
52 665c255d 2023-08-04 jrmu ;; (define (fermat-test n)
53 665c255d 2023-08-04 jrmu ;; (define (try-it a)
54 665c255d 2023-08-04 jrmu ;; (= (expmod a n n) a))
55 665c255d 2023-08-04 jrmu ;; (try-it (+ 1 (random (- n 1)))))
57 665c255d 2023-08-04 jrmu ;; (define (fast-prime? n times)
58 665c255d 2023-08-04 jrmu ;; (cond ((= times 0) true)
59 665c255d 2023-08-04 jrmu ;; ((fermat-test n) (fast-prime? n (- times 1)))
60 665c255d 2023-08-04 jrmu ;; (else false)))
62 665c255d 2023-08-04 jrmu ;; (define (test-case actual expected)
63 665c255d 2023-08-04 jrmu ;; (load-option 'format)
64 665c255d 2023-08-04 jrmu ;; (newline)
65 665c255d 2023-08-04 jrmu ;; (format #t "Actual: ~A Expected: ~A" actual expected))
67 665c255d 2023-08-04 jrmu ;; (define (prime? n)
68 665c255d 2023-08-04 jrmu ;; (let ((times-to-test 10))
69 665c255d 2023-08-04 jrmu ;; (fast-prime? n times-to-test)))
71 665c255d 2023-08-04 jrmu ;; (define (timed-prime-test n)
72 665c255d 2023-08-04 jrmu ;; (newline)
73 665c255d 2023-08-04 jrmu ;; (display n)
74 665c255d 2023-08-04 jrmu ;; (start-prime-test n (runtime)))
75 665c255d 2023-08-04 jrmu ;; (define (start-prime-test n start-time)
76 665c255d 2023-08-04 jrmu ;; (if (prime? n)
77 665c255d 2023-08-04 jrmu ;; (report-prime (- (runtime) start-time))))
78 665c255d 2023-08-04 jrmu ;; (define (report-prime elapsed-time)
79 665c255d 2023-08-04 jrmu ;; (display " *** ")
80 665c255d 2023-08-04 jrmu ;; (display elapsed-time))
82 665c255d 2023-08-04 jrmu ;; (define (search-for-primes lower upper)
83 665c255d 2023-08-04 jrmu ;; (cond ((even? lower) (search-for-primes (+ lower 1) upper))
84 665c255d 2023-08-04 jrmu ;; ((< lower upper) (begin (timed-prime-test lower)
85 665c255d 2023-08-04 jrmu ;; (search-for-primes (+ lower 2) upper)))
86 665c255d 2023-08-04 jrmu ;; (else (newline)
87 665c255d 2023-08-04 jrmu ;; (display " *** Finished *** "))))
93 665c255d 2023-08-04 jrmu ;; Exercise 1.27. Demonstrate that the Carmichael numbers listed in footnote 47 really do fool the Fermat test. That is, write a procedure that takes an integer n and tests whether an is congruent to a modulo n for every a<n, and try your procedure on the given Carmichael numbers.
95 665c255d 2023-08-04 jrmu ;; Numbers that fool the Fermat test are called Carmichael numbers, and little is known about them other than that they are extremely rare. There are 255 Carmichael numbers below 100,000,000. The smallest few are 561, 1105, 1729, 2465, 2821, and 6601. In testing primality of very large numbers chosen at random, the chance of stumbling upon a value that fools the Fermat test is less than the chance that cosmic radiation will cause the computer to make an error in carrying out a ``correct'' algorithm. Considering an algorithm to be inadequate for the first reason but not for the second illustrates the difference between mathematics and engineering.
97 665c255d 2023-08-04 jrmu ;; calculate base^exp modulo m
98 665c255d 2023-08-04 jrmu (define (expmod base exp m)
99 665c255d 2023-08-04 jrmu (cond ((= exp 0) 1)
100 665c255d 2023-08-04 jrmu ((even? exp)
101 665c255d 2023-08-04 jrmu (remainder (square (expmod base (/ exp 2) m)) m))
102 665c255d 2023-08-04 jrmu (else (remainder (* base (expmod base (- exp 1) m)) m))))
104 665c255d 2023-08-04 jrmu ;; tests if integer n passes fermat's little theorem
105 665c255d 2023-08-04 jrmu (define (fermat-prime? n)
106 665c255d 2023-08-04 jrmu (define (fermat-test a)
107 665c255d 2023-08-04 jrmu (cond ((= a n) #t)
108 665c255d 2023-08-04 jrmu ((not (= (expmod a n n) a)) #f)
109 665c255d 2023-08-04 jrmu (else (fermat-test (+ a 1)))))
110 665c255d 2023-08-04 jrmu (fermat-test 1))
112 665c255d 2023-08-04 jrmu (define (list-primes upper)
113 665c255d 2023-08-04 jrmu (define (test i)
114 665c255d 2023-08-04 jrmu (cond ((= i upper) (display "Finished"))
115 665c255d 2023-08-04 jrmu ((fermat-prime? i) (begin (display i)
116 665c255d 2023-08-04 jrmu (newline))))
117 665c255d 2023-08-04 jrmu (test (+ i 1)))
120 665c255d 2023-08-04 jrmu (define (test-case actual expected)
121 665c255d 2023-08-04 jrmu (load-option 'format)
123 665c255d 2023-08-04 jrmu (format #t "Actual: ~A Expected: ~A" actual expected))
125 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 2) #t)
126 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 3) #t)
127 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 4) #f)
128 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 5) #t)
129 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 6) #f)
130 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 7) #t)
131 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 8) #f)
132 665c255d 2023-08-04 jrmu ;; (test-case (fermat-prime? 9) #f)
135 665c255d 2023-08-04 jrmu ;; (list-primes 10000)
137 665c255d 2023-08-04 jrmu ;; Carmichael Numbers
138 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 561) #f)
139 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 1105) #f)
140 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 1729) #f)
141 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 2465) #f)
142 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 2821) #f)
143 665c255d 2023-08-04 jrmu (test-case (fermat-prime? 6601) #f)
