Схема сита Эратосфена

Вот решение, которое работает.

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

Я использовал несколько вспомогательных функций, но вы можете добавить их к функции eratosthenes, если хотите. Я думаю, это сделает весь этот бизнес более читабельным.

mark-true сохраняет значение в #t. mark-divisors берет число n и список чисел и объединяет все числа, которые n делят на #f. Практически все остальное говорит само за себя. Эратосфен работает так, как должен, если первая цифра «немаркирована», он отмечает ее как «истинную» или «простую», а затем «вычеркивает» все ее кратные из оставшейся части списка и затем повторяет для каждой последующей «немаркированной» цифра в списке. Моя функция эратосфена делает по сути то же, что вы пытались сделать со своей. Я не уверен, в чем проблема у вас, но, как правило, полезно сделать помощников, чтобы ваши материалы были более читабельными.

Я сделал это в DrRacket с пакетом SICP Нила Ван Дайка. Я не знаю, какую схему вы используете. Сообщите мне, если у вас возникнут проблемы с тем, чтобы это работало.

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

Это еще одна схема на рэкетном диалекте, которая работает, но до 100000000. Кроме того, за его эффективность я не ручаюсь.

Итак, цель SoE - не проверять делимость, а просто считать по p числам за раз:

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

Так что (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))

неограниченное сито по формуле

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

могут быть определены с использованием потоков в стиле SICP (как можно увидеть здесь) :

 ;;;; 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))

Протестировано на схеме MIT.

код и объяснения можно найти в SICP 3.5.2 Infinite Streams http://mitpress.mit.edu/sicp/full-text/book/book-ZH-24.html#%_sec_3.5.2