net/ricketyspace/sicp/one/twentyseven.scm


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

;;;; License: CC0-1.0

(define-module (net ricketyspace sicp one twentyseven)
  #:use-module (srfi srfi-1)
  #:export (carmichael-numbers-fool-fermat-test? prime?))

(define carmichael-numbers '(561 1105 1729 2465 2821 6601))

(define (square x) (* x x))

(define (expmod base exp m)
  (cond ((= exp 0) 1)
        ((even? exp)
         (remainder (square (expmod base (/ exp 2) m))
                    m))
        (else
         (remainder (* base (expmod base (- exp 1) m))
                    m))))

(define (fermat-test n)
  (define (pass? a)
    (= (expmod a n n) a))
  (fold (lambda (a p) (and (pass? a) p)) #t (iota (1- n) 1)))

(define (prime? n)
  (if (fermat-test n) #t #f))

(define (carmichael-numbers-fool-fermat-test?)
  "Returns #t if all `carmichael-numbers` pass (fool) the fermat test."
  (define (fooled-test? n) (prime? n))
  (fold (lambda (n p) (and (fooled-test? n) p)) #t carmichael-numbers))