summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sieve/euler.scm16
-rw-r--r--sieve/sundaram.scm16
-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