27 lines
688 B
Scheme
27 lines
688 B
Scheme
#lang sicp
|
|
(define (square x) (* x x))
|
|
(define (expmod-aux base exp n acc)
|
|
(cond ((= 0 exp) acc)
|
|
((even? exp) (expmod-aux (remainder (square base) n) (/ exp 2) n acc))
|
|
(else (expmod-aux base (- exp 1) n (remainder (* acc base) n)))))
|
|
(define (expmod base exp n)
|
|
(expmod-aux base exp n 1))
|
|
(define (carmichael-test-aux n a)
|
|
(cond ((>= a n) #t)
|
|
((= (expmod a n n) a) (carmichael-test-aux n (+ a 1)))
|
|
(else #f)))
|
|
(define (carmichael-test n)
|
|
(carmichael-test-aux n 0))
|
|
;> (carmichael-test 561)
|
|
;#t
|
|
;> (carmichael-test 1105)
|
|
;#t
|
|
;> (carmichael-test 1729)
|
|
;#t
|
|
;> (carmichael-test 2465)
|
|
;#t
|
|
;> (carmichael-test 2821)
|
|
;#t
|
|
;> (carmichael-test 6601)
|
|
;#t
|
|
;>
|