Sieve of Sundaram

1 files changed, 68 insertions, 0 deletions

diff --git a/sieve/sundaram.scm b/sieve/sundaram.scm
new file mode 100644
index 0000000..457efb8
--- /dev/null
+++ b/sieve/sundaram.scm
@@ -0,0 +1,68 @@
+
+
+
+(use-modules (srfi srfi-41))
+
+
+
+(define base (stream-from 1))
+
+
+
+(define (curry f)
+    (lambda (x)
+        (lambda (y)
+            (f x y))))
+
+
+
+(define-stream (stream-ordered-diff xstrm ystrm)
+    (stream-match xstrm (() '()) ((x . xs)
+        (stream-match ystrm (() xstrm) ((y . ys)
+            (if (eq? x y)
+                (stream-ordered-diff xs ys)
+                (stream-cons x (stream-ordered-diff xs ystrm))))))))
+
+
+
+(define-stream (stream-merge xstrm ystrm)
+    (stream-match xstrm (() ystrm) ((x . xs)
+        (stream-match ystrm (() xstrm) ((y . ys)
+            (cond ((< x y) (stream-cons x (stream-merge xs ystrm)))
+                  ((> x y) (stream-cons y (stream-merge xstrm ys)))
+                  ((eq? x y) (stream-cons x (stream-merge xs ys)))))))))
+
+
+
+(define (f i j)
+    (+ i j (* 2 i j)))
+
+
+
+(define-stream (i-stream i)
+    (stream-map
+        ((curry f) i)
+        (stream-from i)))
+
+
+
+(define ij-stream
+    (stream-let loop ((n 1) (strm (i-stream 1)))
+        (let* ((cutoff ((curry >) (stream-car (i-stream n))))
+               (next (+ n 1))
+               (available (stream-take-while cutoff strm))
+               (remainder (stream-drop-while cutoff strm)))
+            (stream-append available (loop next (stream-merge remainder (i-stream next)))))))
+
+
+
+(define-stream (sieve input)
+    (stream-map
+        (lambda (x) (+ 1 (* 2 x)))
+        (stream-ordered-diff input ij-stream)))
+
+
+
+(define sundaram (stream-cons 2 (sieve base)))
+
+