Stream merge: Difference between revisions

=={{header|Racket}}==

<lang racket>;; This module produces a sequence that merges streams in order (by <)

#lang racket/base

(require racket/stream)

(define-values (tl-first tl-rest tl-empty?)

(values stream-first stream-rest stream-empty?))

(define-struct merged-stream (< ss v ss′)

#:mutable ; sadly, so we don't have to redo potentially expensive <

#:methods gen:stream

[(define (stream-empty? S)

;; andmap defined to be true when ss is null

(andmap tl-empty? (merged-stream-ss S)))

(define (cache-next-head S)

(unless (box? (merged-stream-v S))

(define < (merged-stream-< S))

(define ss (merged-stream-ss S))

(define-values (best-f best-i)

(for/fold ((F #f) (I 0)) ((s (in-list ss)) (i (in-naturals)))

(if (tl-empty? s) (values F I)

(let ((f (tl-first s)))

(if (or (not F) (< f (unbox F))) (values (box f) i) (values F I))))))

(set-merged-stream-v! S best-f)

(define ss′ (for/list ((s ss) (i (in-naturals)) #:unless (tl-empty? s))

(if (= i best-i) (tl-rest s) s)))

(set-merged-stream-ss′! S ss′))

S)

(define (stream-first S)

(cache-next-head S)

(unbox (merged-stream-v S)))

(define (stream-rest S)

(cache-next-head S)

(struct-copy merged-stream S [ss (merged-stream-ss′ S)] [v #f]))])

(define ((merge-sequences <) . sqs)

(let ((strms (map sequence->stream sqs)))

(merged-stream < strms #f #f)))

;; ---------------------------------------------------------------------------------------------------

(module+ main

(require racket/string)

;; there are file streams and all sorts of other streams -- we can even read lines from strings

(for ((l ((merge-sequences string<?)

(in-lines (open-input-string "aardvark

dog

fox"))

(in-list (string-split "cat donkey elephant"))

(in-port read (open-input-string #<<<

"boy"

"emu"

"monkey"

<

)))))

(displayln l)))

;; ---------------------------------------------------------------------------------------------------

(module+ test

(require rackunit)

(define merge-sequences/< (merge-sequences <))

(check-equal?

(for/list ((i (in-stream (merge-sequences/< (in-list '(1 3 5)))))) i)

'(1 3 5))

;; in-stream (and in-list) is optional (but may increase performance)

(check-equal? (for/list ((i (merge-sequences/<))) i) null)

(check-equal? (for/list ((i (merge-sequences/< '(1 3 5) '(2 4 6)))) i) '(1 2 3 4 5 6))

(check-equal? (for/list ((i (merge-sequences/< '(1 3 5) '(2 4 6 7 8 9 10)))) i)

'(1 2 3 4 5 6 7 8 9 10))

(check-equal? (for/list ((i (merge-sequences/< '(2 4 6 7 8 9 10) '(1 3 5)))) i)

'(1 2 3 4 5 6 7 8 9 10)))</lang>

{{out}}

<pre>aardvark

boy

cat

dog

donkey

elephant

emu

fox

monkey</pre>