Welcome to the CHICKEN Scheme pasting service

no title added by anonymous on Tue Jun 14 06:29:22 2011

(define (atkin.init lim)
  (let ((vec (make-vector (+ lim 1) #f)))
    (let rec ((x 0))
      (if (> x (min lim 5)) vec
        (begin 
          (if (or (= x 2) (= x 3)) (vector-set! vec x #t))
          (rec (+ x 1)))))))

(define (atkin lim)
  (let ((vec (atkin.init lim)) (m (ceiling (sqrt lim))))
    (let recx ((x 1))
      (if (= x m) #t
        (begin 
          (let recy ((y 1))
            (if (= y m) #t
              (begin
                (let* ((n (+ (* 4 (expt x 2)) (expt y 2))) (rem (remainder n 12)))
                  (if (and (<= n lim) (or (= rem 1) (= rem 5))) (vector-set! vec n (not (vector-ref vec n)))))
                (let* ((n (+ (* 3 (expt x 2)) (expt y 2))) (rem (remainder n 12)))
                  (if (and (<= n lim) (= rem 7)) (vector-set! vec n (not (vector-ref vec n)))))
                (let* ((n (- (* 3 (expt x 2)) (expt y 2))) (rem (remainder n 12)))
                  (if (and (> x y) (<= n lim) (= rem 11)) (vector-set! vec n (not (vector-ref vec n)))))
                (recy (+ y 1)))))
          (recx (+ x 1)))))
    (let rec ((x 5))
      (if (= x m) (cons vec lim)
        (begin
          (if (vector-ref vec x)
            (let recs ((k 1))
              (if (> (* k (expt x 2)) lim) #t
                (begin
                  (vector-set! vec (* k (expt x 2)) #f)
                  (recs (+ k 1))))))
          (rec (+ x 1)))))))

(define (isprime? pl x)
  (if (<= x (cdr pl)) (vector-ref (car pl) x)))

(define (atkin.print pl)
  (let rec ((x 0))
    (if (> x (cdr pl)) #t
      (begin
        (if (isprime? pl x) (begin (display x)(newline)))
        (rec (+ x 1))))))

;;(atkin.print (atkin 100))
(define euler10
 (let ((pl (atkin 2000000)))
    (let rec ((x 0) (a 0))
      (if (= x 2000000) a
        (rec (+ x 1) (if (isprime? pl x) (+ a x) a))))))

(display euler10)(newline)

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Which egg provides `take-right'?
Visually impaired? Let me spell it for you (wav file) download WAV