codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; lucas-carmichael number (define-syntax fold-of (syntax-rules (range in is) ((_ "z" f b e) (set! b (f b e))) ((_ "z" f b e (v range fst pst stp) c ...) (let* ((x fst) (p pst) (s stp) (le? (if (positive? s) <= >=))) (do ((v x (+ v s))) ((le? p v) b) (fold-of "z" f b e c ...)))) ((_ "z" f b e (v range fst pst) c ...) (let* ((x fst) (p pst) (s (if (< x p) 1 -1))) (fold-of "z" f b e (v range x p s) c ...))) ((_ "z" f b e (v range pst) c ...) (fold-of "z" f b e (v range 0 pst) c ...)) ((_ "z" f b e (x in xs) c ...) (do ((t xs (cdr t))) ((null? t) b) (let ((x (car t))) (fold-of "z" f b e c ...)))) ((_ "z" f b e (x is y) c ...) (let ((x y)) (fold-of "z" f b e c ...))) ((_ "z" f b e p? c ...) (if p? (fold-of "z" f b e c ...))) ((_ f i e c ...) (let ((b i)) (fold-of "z" f b e c ...))))) (define-syntax list-of (syntax-rules () ((_ arg ...) (reverse (fold-of (lambda (d a) (cons a d)) '() arg ...))))) (define (all? pred? xs) (cond ((null? xs) #t) ((pred? (car xs)) (all? pred? (cdr xs))) (else #f))) (define (factors n) ; 2,3,5-wheel (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)) (next 0)) (let loop ((n n) (f 2) (fs (list))) (if (= n 1) (reverse fs) (if (< n (* f f)) (reverse (cons n fs)) (if (zero? (modulo n f)) (loop (/ n f) f (cons f fs)) (let ((f (+ f (vector-ref wheel next)))) (set! next (if (= next 10) 3 (+ next 1))) (loop n f fs)))))))) (define (no-dups? xs) (or (null? xs) (and (not (member (car xs) (cdr xs))) (no-dups? (cdr xs))))) (define (divides? d n) (zero? (modulo n d))) (define (lucas-carmichael n) (list-of (cons x fs) (x range 3 n 2) (fs is (factors x)) (< 1 (length fs)) (no-dups? fs) (all? (lambda (f) (divides? (+ f 1) (+ x 1))) fs))) (for-each (lambda (xs) (display (car xs)) (display #\tab) (display (cdr xs)) (newline)) (lucas-carmichael 100000))
Private
[
?
]
Run code
Submit