summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace/sicp/one/twentyeight.scm
blob: bad63a0f828d6bdb99ed5772caf9d572fa5ba794 (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
;;;; 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?))

(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))