From 43093fc92209563110cb24d7968a9af9ad96632c Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Sat, 26 Aug 2017 16:53:07 +0000 Subject: net: Add (net ricketyspace sicp one twentyeight). * net/ricketyspace/sicp/one/twentyeight.scm: New file. --- net/ricketyspace/sicp/one/twentyeight.scm | 34 +++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 net/ricketyspace/sicp/one/twentyeight.scm (limited to 'net/ricketyspace') diff --git a/net/ricketyspace/sicp/one/twentyeight.scm b/net/ricketyspace/sicp/one/twentyeight.scm new file mode 100644 index 0000000..bad63a0 --- /dev/null +++ b/net/ricketyspace/sicp/one/twentyeight.scm @@ -0,0 +1,34 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; . + +(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)) -- cgit v1.2.3