[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/aLeXjzdr    [ raw code | output | fork ]

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


Output:
1
2
3
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
41538cpu time: 30 real time: 158 gc time: 0
41538cpu time: 610 real time: 5746 gc time: 140


Create a new paste based on this one


Comments: