100 lines
2.7 KiB
Scheme
100 lines
2.7 KiB
Scheme
;;
|
|
;; primes.scm
|
|
;;
|
|
;; Simple handling of 4-digit primes.
|
|
;;
|
|
;; ISC License
|
|
;;
|
|
;; Copyright 2023 Brmlab, z.s.
|
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
|
;;
|
|
;; Permission to use, copy, modify, and/or distribute this software
|
|
;; for any purpose with or without fee is hereby granted, provided
|
|
;; that the above copyright notice and this permission notice appear
|
|
;; in all copies.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
|
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
;;
|
|
|
|
(declare (unit primes))
|
|
|
|
(module
|
|
primes
|
|
(
|
|
primes-tests!
|
|
is-4digit-prime?
|
|
gen-all-4digit-primes
|
|
)
|
|
|
|
(import scheme
|
|
(chicken base)
|
|
testing
|
|
utils)
|
|
|
|
;; Checks whether given number is prime by checking the remainder of
|
|
;; the division by all primes less than square root of the number in
|
|
;; question.
|
|
(define (check-prime primes n)
|
|
(let ((prime-at-most
|
|
(inexact->exact
|
|
(floor
|
|
(sqrt n)))))
|
|
(let loop ((ps primes))
|
|
(if (null? ps)
|
|
#t
|
|
(let ((cp (car ps)))
|
|
(if (<= cp prime-at-most)
|
|
(if (eq? (remainder n cp) 0)
|
|
#f
|
|
(loop (cdr ps)))
|
|
#t))))))
|
|
|
|
;; Generates list of primes less than given argument.
|
|
(define (gen-primes less-than . init)
|
|
(let loop ((primes (if (null? init)
|
|
'(2)
|
|
(car init)))
|
|
(number 3))
|
|
(if (< number less-than)
|
|
(loop (if (check-prime primes number)
|
|
(append primes (list number))
|
|
primes)
|
|
(+ number 2))
|
|
primes)))
|
|
|
|
;; Used for checking any primes < 10000
|
|
(define primes<100 (gen-primes 100))
|
|
|
|
;; Check whether given number is four-digit number and whether it is
|
|
;; also prime.
|
|
(define (is-4digit-prime? n)
|
|
(and (>= n 1000)
|
|
(<= n 9999)
|
|
(check-prime primes<100 n)))
|
|
|
|
;; Generates all valid member ids
|
|
(define (gen-all-4digit-primes)
|
|
(filter is-4digit-prime?
|
|
(gen-primes 10000 primes<100)))
|
|
|
|
;; Module self-tests.
|
|
(define (primes-tests!)
|
|
(run-tests
|
|
primes
|
|
(test-true check-prime (check-prime primes<100 67))
|
|
(test-true is-4digit-prime? (is-4digit-prime? 2803))
|
|
(test-false is-4digit-prime? (is-4digit-prime? 666))
|
|
(test-false is-4digit-prime? (is-4digit-prime? 997))
|
|
(test-false is-4digit-prime? (is-4digit-prime? 6666))
|
|
(test-false is-4digit-prime? (is-4digit-prime? 66666))
|
|
(test-false is-4digit-prime? (is-4digit-prime? 10007))
|
|
))
|
|
|
|
)
|