Схема сита Эратосфена - PullRequest
Новая
       30

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

3 голосов
/ 29 марта 2012

Я искал в сети реализацию «Решета Эратосфена» в схеме, и, хотя я придумал много контента, ни один из них, похоже, не сделал этого так, как мне нужно.

Проблема состоит в том, что большинство алгоритмов либо используют статический конец, либо используют итерацию. Это в сочетании с моим незнанием языка заставило меня попросить всех вас о помощи.

Мне нужна реализация Sieve, которая принимает один аргумент (число для Sieve до), использует только рекурсию и имеет список «минусов» числа с #t (true) или #f (false ).

Таким образом, по сути, алгоритм будет выглядеть так:

  1. Составить список из 2-х чисел, каждый из которых начинается с true
  2. Рекурсивно пройти и пометить каждое число, которое делится на 2 ложных
  3. Затем переходите к следующему «истинному» числу в списке, пока не останутся только простые числа, помеченные как истинные
  4. Вывести список

Пример вывода:

> (Эрат-сито 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))

Если бы у вас также были комментарии, подробно объясняющие код, это было бы очень признательно.

Спасибо!

REVISED ::: Итак, я выучил немного схемы для дальнейшего объяснения моего вопроса ...

Это составляет список. 

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

Возвращает список с каждым кратным делителя, помеченного как 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))))

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

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

То, что я пытаюсь сделать, это, как следует из названия функции, вызывать кратные метки вызова для каждого номера, который все еще помечен как true в списке. Таким образом, вы передаете ((3.#t)(4.#t)(5.#t)), а затем он вызывает mark-off-multiples для 2 и возвращает (3.#t)(4.#f)(5.#t), и вы добавляете (2.#t) к нему. Затем он снова вызывает себя, передавая (3.#t)(4.#f)(5.#t), и вызывает кратные разметки с cdr списка, возвращающего (4.#f)(5.#t), и продолжает идти по списку ...

Вывод, который я затем получаю, представляет собой список со всеми истинными значениями.

Это, надеюсь, поможет вам лучше понять мое затруднительное положение.

Ответы [ 4 ]

2 голосов
/ 30 марта 2012

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

(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. Практически все остальное говорит само за себя. Eratosthenes работает как следует, если первая цифра «немаркирована», она помечает ее как «true» или «штрих», а затем «вычеркивает» все ее множители из остальной части списка и затем повторяет для каждого последующего «немаркированного» цифра в списке. Моя функция эратосфена делает то, что вы пытались сделать с вашей. Я не уверен, в чем проблема с вашей, но, как правило, полезно сделать помощников, чтобы сделать ваши вещи более читабельными.

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

1 голос
/ 19 мая 2013 
(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))))))

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

1 голос
/ 24 августа 2012

ОК, так что смысл 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))

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

P = {3,5,7,9, ...} \ U {{ p 2 , p 2 + 2p , p 2 + 4p , p 2 + 6p , ...} | p in 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.

0 голосов
/ 29 марта 2012

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

...