[ create a new paste ] login | about

Link: http://codepad.org/AXSKaB7M    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jan 2:
; 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))


Output:
399	(3 7 19)
935	(5 11 17)
2015	(5 13 31)
2915	(5 11 53)
4991	(7 23 31)
5719	(7 19 43)
7055	(5 17 83)
8855	(5 7 11 23)
12719	(7 23 79)
18095	(5 7 11 47)
20705	(5 41 101)
20999	(11 23 83)
22847	(11 31 67)
29315	(5 11 13 41)
31535	(5 7 17 53)
46079	(11 59 71)
51359	(7 11 23 29)
60059	(19 29 109)
63503	(11 23 251)
67199	(11 41 149)
73535	(5 7 11 191)
76751	(23 47 71)
80189	(17 53 89)
81719	(11 17 19 23)
88559	(19 59 79)
90287	(17 47 113)


Create a new paste based on this one


Comments: