From 7dbbe1156c9489151dca6760b1021db426caf84e Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 21 Oct 2015 19:53:09 +1100 Subject: Sieve of Sundaram --- sieve/sundaram.scm | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 sieve/sundaram.scm (limited to 'sieve') 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))) + + -- cgit