Data commit

Task/Hamming-numbers/Racket/hamming-numbers-1.rkt

@@ -0,0 +1,23 @@
+#lang racket
+(require racket/stream)
+(define first stream-first)
+(define rest  stream-rest)
+
+(define (merge s1 s2)
+  (define x1 (first s1))
+  (define x2 (first s2))
+  (cond [(= x1 x2) (merge s1 (rest s2))]
+        [(< x1 x2) (stream-cons x1 (merge (rest s1) s2))]
+        [else      (stream-cons x2 (merge s1 (rest s2)))]))
+
+(define (mult k) (λ(x) (* x k)))
+
+(define hamming
+  (stream-cons
+   1 (merge (stream-map (mult 2) hamming)
+            (merge (stream-map (mult 3) hamming)
+                   (stream-map (mult 5) hamming)))))
+
+(for/list ([i 20] [x hamming]) x)
+(stream-ref hamming 1690)
+(stream-ref hamming 999999)

Task/Hamming-numbers/Racket/hamming-numbers-2.rkt

@@ -0,0 +1,28 @@
+#lang racket
+(require racket/stream)
+(define first stream-first)
+(define rest  stream-rest)
+
+(define (hamming)
+  (define (merge s1 s2)
+    (let ([x1 (first s1)]
+          [x2 (first s2)])
+      (if (< x1 x2) ; don't have to handle duplicate case
+          (stream-cons x1 (merge (rest s1) s2))
+          (stream-cons x2 (merge s1 (rest s2))))))
+  (define (smult m s) ; faster than using map (* m)
+    (define (smlt ss)
+      (stream-cons (* m (first ss)) (smlt (rest ss))))
+    (smlt s))
+  (define (u n s)
+    (if (stream-empty? s) ; checking here more efficient than in merge
+        (letrec ([r          (smult n (stream-cons 1 r)) ])
+          r)
+        (letrec ([r (merge s (smult n (stream-cons 1 r)))])
+          r)))
+  ;; (stream-cons 1 (u 2 (u 3 (u 5 empty-stream))))
+  (stream-cons 1 (foldr u empty-stream '(2 3 5))))
+
+(for/list ([i 20] [x (hamming)]) x) (newline)
+(stream-ref (hamming) 1690) (newline)
+(stream-ref (hamming) 999999) (newline)