[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Sep 13:
; smallest consecutive four-factor composites

(define (unique eql? xs)
  (cond ((null? xs) '())
        ((null? (cdr xs)) xs)
        ((eql? (car xs) (cadr xs))
          (unique eql? (cdr xs)))
        (else (cons (car xs) (unique eql? (cdr xs))))))

(define (factors n)
  (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
    (let loop ((n n) (f 2) (w 0) (fs (list)))
      (cond ((< n (* f f))
              (reverse (if (< 1 n) (cons n fs) fs)))
            ((zero? (modulo n f))
              (loop (/ n f) f w (cons f fs)))
            (else (loop n (+ f (vector-ref wheel w))
                        (if (< w 10) (+ w 1) 0) fs))))))

(define (count n) (length (unique = (factors n))))

(define (fff1)
  (let loop ((n 5) (c1 1) (c2 1) (c3 1))
    (let ((c (count n)))
      (if (= 4 c c1 c2 c3) (- n 3)
        (loop (+ n 1) c c1 c2)))))

(time (display (fff1)) (newline))

(define (fff2 n)
  (let ((sieve (make-vector n 0)))
    (do ((p 2 (+ p 1))) ((<= n p))
      (when (zero? (vector-ref sieve p))
        (do ((i p (+ i p))) ((<= n i))
          (vector-set! sieve i
            (+ (vector-ref sieve i) 1)))))
    (let loop ((i 4))
      (if (= i n)
          "failed"
          (if (and (= (vector-ref sieve (- i 3)) 4)
                   (= (vector-ref sieve (- i 2)) 4)
                   (= (vector-ref sieve (- i 1)) 4)
                   (= (vector-ref sieve i) 4))
              (- i 3)
              (loop (+ i 1)))))))

(time (display (fff2 135000)) (newline))


Output:
1
Timeout


Create a new paste based on this one


Comments: