scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

utils: Add cartesian-product/stream.

This commit is contained in:
Sergiu Ivanov 2020-03-20 16:07:34 +01:00
parent 9502a9e981
commit 34fbc516e2
2 changed files with 37 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
utils-tests.rkt
View File

@ -148,3 +148,18 @@
0.48375400938578744
0.7538961707172924
0.01828428516237329))))
(test-case "Additional stream utilities"
(check-equal? (stream->list (cartesian-product/stream (in-range 3) (in-range 4 6) '(a b)))
'((0 4 a)
(0 4 b)
(0 5 a)
(0 5 b)
(1 4 a)
(1 4 b)
(1 5 a)
(1 5 b)
(2 4 a)
(2 4 b)
(2 5 a)
(2 5 b))))

23
utils.rkt
View File

@ -37,7 +37,8 @@
[in-random (case-> (-> (stream/c (and/c real? inexact? (>/c 0) (</c 1))))
(-> (integer-in 1 4294967087) (stream/c exact-nonnegative-integer?))
(-> exact-integer? (integer-in 1 4294967087)
(stream/c exact-nonnegative-integer?)))])
(stream/c exact-nonnegative-integer?)))]
[cartesian-product/stream (->* () #:rest (listof stream?) stream?)])
;; Contracts
(contract-out [variable-mapping? contract?]
[string-variable-mapping? contract?]
@ -355,3 +356,23 @@
[() (for/stream ([i (in-naturals)]) (random))]
[(k) (for/stream ([i (in-naturals)]) (random k))]
[(min max) (for/stream ([i (in-naturals)]) (random min max))]))
;;; ===========================
;;; Additional stream utilities
;;; ===========================
;;; Returns the Cartesian product of the given streams. The result is
;;; a stream whose elements are the elements of the Cartesian product.
;;;
;;; The implementation is inspired from the implementation of
;;; cartesian-product in racket/list.
(define (cartesian-product/stream . ss)
;; Cartesian product of two streams, produces an improper pair.
(define (cp-2 ss1 ss2)
(for*/stream ([s1 (in-stream ss1)] [s2 (in-stream ss2)]) (cons s1 s2)))
;; Fold-right over the list of streams. The value for the fold is a
;; 1-value stream containing the empty list, which makes all the
;; lists proper.
(foldr cp-2 (sequence->stream (in-value (list))) ss))