sicp

sicp sandbox.
git clone git://git.ricketyspace.net/sicp.git
Log | Files | Refs

twentyeight.scm (2249B)


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