Sieve of Eratosthenes Scheme

一个人想着一个人 提交于 2019-11-29 11:45:16
Josh Infiesto

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.

(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.

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 { {p2, p2+2p, p2+4p, p2+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.

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

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!