Sieve of Eratosthenes Scheme

Question

I've been searching the web for an implementation of the Sieve of Eratosthenes in scheme and although I came up with a lot of content, none of them seemed to have made it like I need it to be done.

The problem is most algorithms either use a static end or use iteration. This paired with my lack of knowledge of the language led me to ask all of you for help.

I need an implementation of the Sieve that takes in one argument (number to Sieve until), uses only recursion and has a list of "cons" of a number with a #t (true) or #f (false).

So essentially the algorithm would go as such:

1. Make list from 2 - inputed number with each number starting as true
2. Recursively go through and mark each number that is divisible by 2 false
3. Then go on to the next "true" number in the list until only primes are left marked true
4. Output the list

Example output:

> (erat-sieve 20)

((2 . #t) (3 . #t) (4 . #f) (5 . #t) (6 . #f) (7 . #t) (8 . #f) (9 . #f) (10 . #f) (11 . #t) (12 . #f) (13 . #t) (14 . #f) (15 . #f) (16 . #f) (17 . #t) (18 . #f) (19 . #t) (20 . #f))

If you could also have comments thoroughly explaining the code, that would be extremely appreciated.

Thank you!

REVISED::: So I've learned a bit of scheme to further explain my question...

This makes the list.

(define (makeList n)
 (if (> n 2)
  (append (makeList (- n 1)) (list (cons n (and))))
  (list (cons 2 (and)))))

This returns a list with each multiple of the divisor marked false.

(define (mark-off-multiples numbers divisor)
 (if (null? numbers)
  '()
  (append 
     (list (cons (car (car numbers)) 
                 (not (zero? (modulo (car (car numbers)) divisor))))) 
     (mark-off-multiples (cdr numbers) divisor))))

Now this is the function I'm having trouble with, it seems like it should work, I've gone through it manually three times, but I can't figure out why its not returning what I need.

(define (call-mark-off-multiples-for-each-true-number numbers)
 (if (null? numbers)
  '()
  (if (cdr (car numbers))
    (append (list (car numbers))
            (call-mark-off-multiples-for-each-true-number 
               (mark-off-multiples (cdr numbers) (car (car numbers)))))
    (append (list (car numbers))
            (call-mark-off-multiples-for-each-true-number 
               (cdr numbers))))))

What I'm trying to make it do is, as the function name suggests, call mark-off-multiples for each number that is still marked true down the list. So you pass in ((3.#t)(4.#t)(5.#t)) and then it calls mark-off-multiples for 2 and returns (3.#t)(4.#f)(5.#t) and you append (2.#t) to it. Then it calls itself again passing in (3.#t)(4.#f)(5.#t) and calls mark-off-multiples with the cdr of the list returning (4.#f)(5.#t) and keeps going down the list...

The output I then get returned is a list with all trues.

This, hopefully with help you better understand my predicament.

Answer 1

Here is a solution that works.

(define (divides? m n)
  (if (eq? (modulo n m) 0)
      #t
      #f))

(define (mark-true n)
  (cons n #t))

(define (mark-divisors n ns)
  (cond ((null? ns) '())
        ((and (unmarked? (car ns)) 
              (divides? n (car ns))) 
           (cons (cons (car ns) #f) (mark-divisors n (cdr ns))))
        (else (cons (car ns) (mark-divisors n (cdr ns))))))

(define (unmarked? n)
  (not (pair? n)))

(define (eratosthenes x)
  (cond ((null? x) '())
        ((unmarked? (car x)) 
           (cons (mark-true (car x)) 
                 (eratosthenes (mark-divisors (car x) (cdr x)))))
        (else (cons (car x) (eratosthenes (cdr x))))))

(eratosthenes (list 2 3 4 5 6))

I've used a number of helper functions, but you could add them to the eratosthenes function if you wanted. I think it makes this whole business more readable.

mark-true conses a value onto a #t. mark-divisors takes a number n and a list of numbers and conses all of the numbers that n divides onto a #f. Pretty much everything else is self explanatory. Eratosthenes works as it should, if the first digit is "unmarked" it marks it as "true" or "prime" and then "crosses out" all of its multiples from the remainder of the list and then repeats for each subsequent "unmarked" digit in the list. My eratosthenes function does essentially what you were trying to do with yours. I'm not sure what the problem with yours is, but as a rule, it's helpful to make helpers to make your stuff more readable.

I did this in DrRacket with Neil Van Dyke's SICP package. I don't know what Scheme you're using. Let me know if you have problems getting this to work.

Answer 2

OK, so the point of SoE is not to test any divisibility, but just count, by p numbers at a time:

(define (make-list n)              ; list of unmarked numbers 2 ... n
  (let loop ((i n) 
             (a '()))
    (if (= i 1)
      a            ; (cons '(2 . #t) (cons (3 . #t) ... (list '(n . #t))...))
      (loop (- i 1) (cons (cons i #t) a)))))

(define (skip2t xs)                ; skip to first unmarked number
  (if (cdar xs) xs (skip2t (cdr xs))))

(define (mark-each! k n i xs)      ; destructive update of list xs - 
  (set-cdr! (car xs) #f)           ;  mark each k-th elem,
  (if (<= (+ i k) n)               ;  head is i, last is n 
    (mark-each! k n (+ i k)
                    (list-tail xs k))))

(define (erat-sieve n)
  (let ((r  (sqrt n))              ; unmarked multiples start at prime's square
        (xs (make-list n)))
    (let loop ((a xs))
      (let ((p (caar a)))          ; next prime
        (cond ((<= p r)
               (mark-each! p n (* p p) (list-tail a (- (* p p) p)))
               (loop (skip2t (cdr a)))))))
    xs))

So that (erat-sieve 20) ==> ((2 . #t) (3 . #t) (4) (5 . #t) (6) (7 . #t) (8) (9) (10) (11 . #t) (12) (13 . #t) (14) (15) (16) (17 . #t) (18) (19 . #t) (20))

---

An unbounded sieve, following the formula

      P = {3,5,7,9, ...} \ U { {p², p²+2p, p²+4p, p²+6p, ...} | p in P }

can be defined using SICP styled streams (as can be seen here):

 ;;;; Stream Implementation
 (define (head s) (car s))
 (define (tail s) ((cdr s))) 
 (define-syntax s-cons
   (syntax-rules () ((s-cons h t) (cons h (lambda () t))))) 

 ;;;; Stream Utility Functions
 (define (from-By x s)
   (s-cons x (from-By (+ x s) s)))
 (define (take n s) 
   (cond ((= n 0) '())
         ((= n 1) (list (car s)))
         (else (cons (head s) (take (- n 1) (tail s))))))
 (define (drop n s)
   (cond ((> n 0) (drop (- n 1) (tail s)))
         (else s)))
 (define (s-map f s)
   (s-cons (f (head s)) (s-map f (tail s))))
 (define (s-diff s1 s2)
   (let ((h1 (head s1)) (h2 (head s2)))
    (cond
     ((< h1 h2) (s-cons h1 (s-diff  (tail s1)       s2 )))
     ((< h2 h1)            (s-diff        s1  (tail s2)))
     (else                 (s-diff  (tail s1) (tail s2))))))
 (define (s-union s1 s2)
   (let ((h1 (head s1)) (h2 (head s2)))
    (cond
     ((< h1 h2) (s-cons h1 (s-union (tail s1)       s2 )))
     ((< h2 h1) (s-cons h2 (s-union       s1  (tail s2))))
     (else      (s-cons h1 (s-union (tail s1) (tail s2)))))))

 ;;;; odd multiples of an odd prime
 (define (mults p) (from-By (* p p) (* 2 p)))

 ;;;; The Sieve itself, bounded, ~ O(n^1.4) in n primes produced
 ;;;;   (unbounded version runs at ~ O(n^2.2), and growing worse)
 ;;;;   **only valid up to m**, includes composites above it        !!NB!!
 (define (primes-To m)
   (define (sieve s) 
    (let ((p (head s))) 
     (cond ((> (* p p) m) s) 
      (else (s-cons p 
              (sieve (s-diff (tail s) (mults p))))))))
   (s-cons 2 (sieve (from-By 3 2))))

 ;;;; all the primes' multiples, tree-merged, removed; 
 ;;;;    ~O(n^1.17..1.15) time in producing 100K .. 1M primes
 ;;;;    ~O(1) space (O(pi(sqrt(m))) probably)
 (define (primes-TM)
   (define (no-mults-From from)
       (s-diff (from-By from 2) (s-tree-join (s-map mults odd-primes))))
   (define odd-primes 
       (s-cons 3 (no-mults-From 5)))
   (s-cons 2 (no-mults-From 3)))

 ;;;; join an ordered stream of streams (here, of primes' multiples)
 ;;;; into one ordered stream, via an infinite right-deepening tree
 (define (s-tree-join sts)                               ;; sts -> s
   (define (join-With of-Tail sts)                       ;; sts -> s
     (s-cons (head (head sts))
              (s-union (tail (head sts)) (of-Tail (tail sts)))))
   (define (pairs sts)                                   ;; sts -> sts
     (s-cons (join-With head sts) (pairs (tail (tail sts)))))
   (join-With (lambda (t) (s-tree-join (pairs t))) sts))

 ;;;; Print 10 last primes from the first thousand primes
 (begin 
   (newline)
   (display (take 10 (drop 990 (primes-To 7919)))) (newline)
   (display (take 10 (drop 990 (primes-TM)))) (newline))

Tested in MIT Scheme.

Answer 3

(define (prime-sieve-to n)
  (let* ((sz (quotient n 2)) (sv (make-vector sz 1)) (lm (integer-sqrt n)))
    (for ((i (in-range 1 lm))) 
      (cond ((vector-ref sv i)
        (let ((v (+ 1 (* 2 i))))
          (for ((i (in-range (+ i (* v (/ (- v 1) 2))) sz v)))
            (vector-set! sv i 0))))))
    (cons 2
          (for/list ((i (in-range 1 sz)) 
                     #:when (and (> (vector-ref sv i) 0) (> i 0)))
                    (+ 1 (* 2 i))))))

This is another one in racket dialect of scheme that works but for up to 100,000,000. Above that, I would not vouch for its efficiency.

Answer 4

code and explanations can be found in SICP 3.5.2Infinite Streams http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-24.html#%_sec_3.5.2