diff options
| -rw-r--r-- | sieve/euler.scm | 16 | ||||
| -rw-r--r-- | sieve/sundaram.scm | 16 | ||||
| -rw-r--r-- | sort/gnome.hs (renamed from sort/gnomesort.hs) | 3 | ||||
| -rw-r--r-- | sort/merge.hs (renamed from sort/mergesort.hs) | 3 | ||||
| -rw-r--r-- | sort/pancake.hs (renamed from sort/pancakesort.hs) | 3 | ||||
| -rw-r--r-- | sort/quick.hs (renamed from sort/quicksort.hs) | 3 | ||||
| -rw-r--r-- | sort/strand.hs (renamed from sort/strandsort.hs) | 3 |
7 files changed, 33 insertions, 14 deletions
diff --git a/sieve/euler.scm b/sieve/euler.scm index b3ba946..ac23a94 100644 --- a/sieve/euler.scm +++ b/sieve/euler.scm @@ -16,17 +16,21 @@ -(define-stream (sub-merge x y) - (if (eq? (stream-car x) (stream-car y)) - (sub-merge (stream-cdr x) (stream-cdr y)) - (stream-cons (stream-car x) (sub-merge (stream-cdr 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 (sieve input) (stream-cons (stream-car input) - (sieve (sub-merge (stream-cdr input) - (stream-map ((curry *) (stream-car input)) input))))) + (sieve (stream-ordered-diff + (stream-cdr input) + (stream-map ((curry *) (stream-car input)) input))))) diff --git a/sieve/sundaram.scm b/sieve/sundaram.scm index 457efb8..384bc3d 100644 --- a/sieve/sundaram.scm +++ b/sieve/sundaram.scm @@ -19,9 +19,9 @@ (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)))))))) + (cond ((< x y) (stream-cons x (stream-ordered-diff xs ystrm))) + ((> x y) (stream-ordered-diff xstrm ys)) + (else (stream-ordered-diff xs ys)))))))) @@ -30,7 +30,7 @@ (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))))))))) + (else (stream-cons x (stream-merge xs ys))))))))) @@ -48,11 +48,11 @@ (define ij-stream (stream-let loop ((n 1) (strm (i-stream 1))) - (let* ((cutoff ((curry >) (stream-car (i-stream n)))) - (next (+ n 1)) + (let* ((next (+ n 1)) + (cutoff ((curry >) (stream-car (i-stream next)))) (available (stream-take-while cutoff strm)) - (remainder (stream-drop-while cutoff strm))) - (stream-append available (loop next (stream-merge remainder (i-stream next))))))) + (remaining (stream-drop-while cutoff strm))) + (stream-append available (loop next (stream-merge remaining (i-stream next))))))) diff --git a/sort/gnomesort.hs b/sort/gnome.hs index 2a9b9ce..e43b05a 100644 --- a/sort/gnomesort.hs +++ b/sort/gnome.hs @@ -1,3 +1,6 @@ +module Gnome ( + gnomeSort + ) where diff --git a/sort/mergesort.hs b/sort/merge.hs index 5c140b3..71dd999 100644 --- a/sort/mergesort.hs +++ b/sort/merge.hs @@ -1,3 +1,6 @@ +module Merge ( + mergeSort + ) where diff --git a/sort/pancakesort.hs b/sort/pancake.hs index 30993ba..2bfdb4a 100644 --- a/sort/pancakesort.hs +++ b/sort/pancake.hs @@ -1,3 +1,6 @@ +module Pancake ( + pancakeSort + ) where diff --git a/sort/quicksort.hs b/sort/quick.hs index 78330f3..44efd81 100644 --- a/sort/quicksort.hs +++ b/sort/quick.hs @@ -1,3 +1,6 @@ +module Quick ( + quickSort + ) where diff --git a/sort/strandsort.hs b/sort/strand.hs index 8226b79..856f75a 100644 --- a/sort/strandsort.hs +++ b/sort/strand.hs @@ -1,3 +1,6 @@ +module Strand ( + strandSort + ) where |