fork download
copy 
  1. ; rosettacode.org/wiki/Sieve_of_Eratosthenes#Scheme
  2. ; rosettacode.org/wiki/Sieve_of_Eratosthenes#Using_SICP-style_streams
  3.  
  4.  ;;;; Stream Implementation
  5.  (define (head s) (car s))   
  6.  (define (tail s) ((cdr s))) 
  7.  
  8.  ;;;; Stream Utility Functions
  9.  (define (from-By x s)
  10.    (cons x (lambda () (from-By (+ x s) s))))
  11.  (define (take n s) 
  12.    (cond 
  13.      ((> n 1) (cons (head s) (take (- n 1) (tail s))))
  14.      ((= n 1) (list (head s)))      ;; don't force it too soon!!
  15.      (else '())))     ;; so (take 4 (s-map / (from-By 4 -1))) works
  16.  (define (drop n s)
  17.    (cond 
  18.      ((> n 0) (drop (- n 1) (tail s)))
  19.      (else s)))
  20.  (define (s-map f s)
  21.    (cons (f (head s)) (lambda () (s-map f (tail s)))))
  22.  (define (s-diff s1 s2)
  23.    (let ((h1 (head s1)) (h2 (head s2)))
  24.     (cond
  25.      ((< h1 h2) (cons h1 (lambda () (s-diff  (tail s1)       s2 ))))
  26.      ((< h2 h1)                     (s-diff        s1  (tail s2))  )
  27.      (else                          (s-diff  (tail s1) (tail s2))  ))))
  28.  (define (s-union s1 s2)
  29.    (let ((h1 (head s1)) (h2 (head s2)))
  30.     (cond
  31.      ((< h1 h2) (cons h1 (lambda () (s-union (tail s1)       s2 ))))
  32.      ((< h2 h1) (cons h2 (lambda () (s-union       s1  (tail s2)))))
  33.      (else      (cons h1 (lambda () (s-union (tail s1) (tail s2))))))))
  34.  
  35.  
  36.  ;;;; all primes' multiples are removed, merged through a tree of unions
  37.  ;;;;  runs in ~ n^1.2 run time in producing n = 2k... 4k primes in Guile(ideone)
  38.  (define (primes-stream)
  39.    (letrec ( (mults (lambda (p) (from-By (* p p) (* 2 p))))
  40.              (no-mults-From (lambda (from)
  41.                   (s-diff (from-By from 2) 
  42.                      (s-tree-join (s-map mults odd-primes)))))
  43.              (odd-primes                        ;; inner feedback loop
  44.                  (cons 3 (lambda () (no-mults-From 5)))) ) 
  45.      (cons 2 (lambda () (no-mults-From 3)))))   ;; result stream
  46.  
  47.  ;;;; join an ordered stream of streams (here, of primes' multiples)
  48.  ;;;; into one ordered stream, via an infinite right-deepening tree
  49.  (define (s-tree-join sts)
  50.    (cons (head (head sts))
  51.          (lambda () 
  52.            (s-union (tail (head sts))
  53.                     (s-tree-join (pairs (tail sts)))))))
  54.  
  55.  (define (pairs sts)                        ;; {a.(b.t)} -> (a+b).{t}
  56.      (cons (cons (head (head sts)) 
  57.                  (lambda () 
  58.                      (s-union (tail (head sts)) 
  59.                               (head (tail sts)))))
  60.            (lambda () 
  61.              (pairs (tail (tail sts))))))
  62.  
  63. (display (take 2 (drop (- 4000 1) (primes-stream))))
Success #stdin #stdout 5.32s 9880KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(37813 37831)
https://ideone.com/Uuil5M
http://r...content-available-to-author-only...e.org/wiki/Sieve_of_Eratosthenes#Tree-folding explicit lambdas
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!