Source code in the racket programming language

#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)

#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)