codepad

Language:

; sieve of euler

(define (primes n) ; sieve of eratosthenes
  (let* ((max-index (quotient (- n 3) 2))
         (v (make-vector (+ 1 max-index) #t)))
    (let loop ((i 0) (ps '(2)))
      (let ((p (+ i i 3)) (startj (+ (* 2 i i) (* 6 i) 3)))
        (cond ((>= (* p p) n)
               (let loop ((j i) (ps ps))
                  (cond ((> j max-index) (reverse ps))
                        ((vector-ref v j) (loop (+ j 1) (cons (+ j j 3) ps)))
                        (else (loop (+ j 1) ps)))))
              ((vector-ref v i)
                (let loop ((j startj))
                  (if (<= j max-index)
                      (begin (vector-set! v j #f) (loop (+ j p)))))
                      (loop (+ 1 i) (cons p ps)))
              (else (loop (+ 1 i) ps)))))))

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define (minus xs ys)
  (let loop ((xs xs) (ys ys) (zs '()))
    (cond ((null? ys) (reverse (append (reverse xs) zs)))
          ((equal? (car xs) (car ys))
            (loop (cdr xs) (cdr ys) zs))
          (else (loop (cdr xs) ys (cons (car xs) zs))))))

(define (sub-list n p xs)
  (let loop ((xs xs) (zs '()))
    (let ((px (* p (car xs))))
      (if (< n px) (reverse zs)
        (loop (cdr xs) (cons px zs))))))

(define (times p) (lambda (x) (* p x)))

(define (euler n)
    (let loop ((xs (range 3 n 2)) (ps '(2)))
      (let ((p (car xs)))
        (if (< n (* p p))
            (append (reverse ps) xs)
            (loop (minus (cdr xs) (sub-list n p xs))
                  (cons p ps))))))

(display (euler 100)) (newline)
(time (display (length (primes 500000))))
(time (display (length (euler 500000))))

Private [?]

Run code