recursion - hasta - Esquema del tamiz de Eratosthenes

metodo de eratóstenes

Question

He estado buscando en la web una implementación de Sieve of Eratosthenes en el esquema y, aunque obtuve mucho contenido, ninguno de ellos parecía haber hecho que fuera necesario.

El problema es que la mayoría de los algoritmos usan un extremo estático o usan iteración. Esto, combinado con mi falta de conocimiento del idioma, me llevó a pedirle ayuda a todos.

Necesito una implementación de Sieve que tome un argumento (número para Tamizar hasta), use solo recursión y tenga una lista de "contras" de un número con #t (verdadero) o #f (falso).

Entonces, esencialmente, el algoritmo iría como tal:

1. Haz una lista de 2 números con cada número comenzando como verdadero
2. Recorre recursivamente y marca cada número que es divisible entre 2 falsos
3. Luego vaya al siguiente número "verdadero" en la lista hasta que solo se marquen los números primos marcados como verdaderos
4. Salida la lista

Ejemplo de salida:

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

Si también pudieras tener comentarios explicando el código a fondo, eso sería muy apreciado.

¡Gracias!

REVISADO ::: Así que aprendí un poco de esquema para explicar mejor mi pregunta ...

Esto hace la lista.

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

Esto devuelve una lista con cada múltiplo del divisor marcado como falso.

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

Ahora esta es la función con la que estoy teniendo problemas, parece que debería funcionar, la he examinado manualmente tres veces, pero no puedo entender por qué no devuelve lo que necesito.

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

Lo que trato de hacer es, como lo sugiere el nombre de la función, llamar a mark-off-multiple para cada número que todavía esté marcado como verdadero en la lista. Entonces pasas ((3.#t)(4.#t)(5.#t)) y luego llama a mark-off-multiples para 2 y regresa (3.#t)(4.#f)(5.#t) y anexa (2.#t) a él. Luego se llama de nuevo pasando (3.#t)(4.#f)(5.#t) y llama a marca-off-múltiplos con el cdr de la lista que regresa (4.#f)(5.#t) y sigue yendo por la lista ...

La salida que luego me devuelve es una lista con todas las curiosidades.

Esto, espero que con ayuda, entiendas mejor mi problema.

Answer 1

el código y las explicaciones se pueden encontrar en SICP 3.5.2 Infinite Streams http://mitpress.mit.edu/sicp/full-text/book/book-ZH-24.html#%_sec_3.5.2

Answer 2

Aquí hay una solución que funciona.

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

He usado varias funciones auxiliares, pero podrías agregarlas a la función eratosthenes si quisieras. Creo que hace todo este negocio más legible.

mark-true tiene un valor en un #t . mark-divisors toma un número n una lista de números y considera todos los números que n divide en un #f . Casi todo lo demás se explica por sí mismo. Eratóstenes funciona como debería, si el primer dígito es "no marcado" lo marca como "verdadero" o "primo" y luego "tacha" todos sus múltiplos del resto de la lista y luego repite para cada "sin marcar" posterior dígito en la lista. Mi función eratosthenes hace esencialmente lo que estabas tratando de hacer con los tuyos. No estoy seguro de cuál es el problema con el tuyo, pero, por lo general, es útil hacer ayuda para que tus cosas sean más legibles.

Hice esto en DrRacket con el paquete SICP de Neil Van Dyke. No sé qué Esquema estás usando. Avíseme si tiene problemas para hacer que esto funcione.

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

Este es otro en dialecto de raqueta de esquema que funciona pero hasta por 100,000,000. Por encima de eso, no respondería por su eficiencia.

Answer 4

OK, entonces el objetivo de SoE no es probar divisibilidad alguna, sino simplemente contar, por números p a la vez:

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

De modo que (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))

Un tamiz sin límites , siguiendo la fórmula

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

se puede definir utilizando secuencias de estilo SICP (como se puede ver aquí ):

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

Probado en el Esquema MIT.