diff options
Diffstat (limited to 'sieve')
| -rw-r--r-- | sieve/euler.scm | 23 | ||||
| -rw-r--r-- | sieve/extra-functional.scm | 47 | ||||
| -rw-r--r-- | sieve/my-streams.scm | 26 | ||||
| -rw-r--r-- | sieve/sundaram.scm | 36 |
4 files changed, 87 insertions, 45 deletions
diff --git a/sieve/euler.scm b/sieve/euler.scm index ac23a94..dfc12de 100644 --- a/sieve/euler.scm +++ b/sieve/euler.scm @@ -1,27 +1,16 @@ -(use-modules (srfi srfi-41)) +(add-to-load-path (dirname (current-filename))) +(import + (srfi srfi-41) + (extra-functional) + (my-streams)) -(define base (stream-from 2)) - - - -(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) - (cond ((< x y) (stream-cons x (stream-ordered-diff xs ystrm))) - ((> x y) (stream-ordered-diff xstrm ys)) - (else (stream-ordered-diff xs ys)))))))) +(define base (stream-from 2)) diff --git a/sieve/extra-functional.scm b/sieve/extra-functional.scm new file mode 100644 index 0000000..ab480c0 --- /dev/null +++ b/sieve/extra-functional.scm @@ -0,0 +1,47 @@ + +(library (extra-functional) + (export curry uncurry flip part compose) + (import (rnrs base)) + + + +(define (curry f) + (lambda (x) + (lambda (y . r) + (apply f (cons x (cons y r)))))) + + + +(define (uncurry f) + (lambda (x y . r) + (apply (f x) (cons y r)))) + + + +(define (flip f) + (lambda (x y . r) + (apply f (cons y (cons x r))))) + + + +(define-syntax part + (syntax-rules () ((_ f x) + ((curry f) x)))) + + + +(define-syntax dot + (syntax-rules () + ((_ x f) (f x)) + ((_ x f g ...) (f (dot x g ...))))) + + + +; (compose f g h) => (lambda (x) (f (g (h x)))) +(define-syntax compose + (syntax-rules () + ((_ f ...) (lambda (x) (dot x f ...))))) + + + +) diff --git a/sieve/my-streams.scm b/sieve/my-streams.scm new file mode 100644 index 0000000..6c08762 --- /dev/null +++ b/sieve/my-streams.scm @@ -0,0 +1,26 @@ + +(library (my-streams) + (export stream-ordered-diff stream-merge) + (import (rnrs base) (srfi srfi-41)) + + + +(define-stream (stream-ordered-diff xstrm ystrm) + (stream-match xstrm (() '()) ((x . xs) + (stream-match ystrm (() xstrm) ((y . ys) + (cond ((< x y) (stream-cons x (stream-ordered-diff xs ystrm))) + ((> x y) (stream-ordered-diff xstrm ys)) + (else (stream-ordered-diff xs ys)))))))) + + + +(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))) + (else (stream-cons x (stream-merge xs ys))))))))) + + + +) diff --git a/sieve/sundaram.scm b/sieve/sundaram.scm index 384bc3d..8e5bf53 100644 --- a/sieve/sundaram.scm +++ b/sieve/sundaram.scm @@ -1,36 +1,16 @@ -(use-modules (srfi srfi-41)) +(add-to-load-path (dirname (current-filename))) +(import + (srfi srfi-41) + (extra-functional) + (my-streams)) -(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) - (cond ((< x y) (stream-cons x (stream-ordered-diff xs ystrm))) - ((> x y) (stream-ordered-diff xstrm ys)) - (else (stream-ordered-diff xs ys)))))))) - - - -(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))) - (else (stream-cons x (stream-merge xs ys))))))))) +(define base (stream-from 1)) @@ -41,7 +21,7 @@ (define-stream (i-stream i) (stream-map - ((curry f) i) + (part f i) (stream-from i))) @@ -58,7 +38,7 @@ (define-stream (sieve input) (stream-map - (lambda (x) (+ 1 (* 2 x))) + (compose (part + 1) (part * 2)) (stream-ordered-diff input ij-stream))) |