From 10f0e0ab0cfbdc59183d1021f9702a82ae74f938 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Fri, 4 Mar 2022 18:08:00 +0100
Subject: [PATCH] Type cartesian-product/stream.

---
 scribblings/utils.scrbl | 17 ++++++++++
 utils.rkt               | 72 ++++++++++++++++++-----------------------
 2 files changed, 48 insertions(+), 41 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 858b173..ae6c0f3 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -447,6 +447,23 @@ element of @racket[s1] will be enumerated.
 (stream->list (stream-take (cartesian-product-2/stream '(a b) (in-naturals)) 10))
 ]}
 
+@defproc[(cartesian-product/stream [ss (Listof (Sequenceof a))])
+				   (Sequenceof (Listof a))]{
+
+Generates a stream containing all the elements of the Cartesian product between
+the streams of @racket[ss].
+
+This function relies on @racket[cartesian-product-2/stream] to build the
+Cartesian product, so it has the same properties with respect to the order in
+which the streams are enumerated.
+
+Union types can be used to build the Cartesian product of streams containing
+values of different types.
+
+@examples[#:eval utils-evaluator
+(stream->list (cartesian-product/stream (list (in-range 3) (in-range 4 6) '(a b))))
+]}
+
 @section{Functions and procedures}
 
 @section{Randomness}
diff --git a/utils.rkt b/utils.rkt
index c4994ee..f007dbf 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -24,7 +24,8 @@
    list-sets->list-strings pretty-print-set pretty-print-set-sets
    update-vertices/unweighted update-graph dotit collect-by-key
    collect-by-key/sets ht-values/list->set hash->list/ordered
-   multi-split-at lists-transpose in-random cartesian-product-2/stream)
+   multi-split-at lists-transpose in-random cartesian-product-2/stream
+   cartesian-product/stream)
 
   (define-type Variable Symbol)
   (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@@ -500,6 +501,31 @@
       (check-equal?
        (stream->list (stream-take (cartesian-product-2/stream '(a b) (in-naturals)) 10))
        '((a . 0) (a . 1) (a . 2) (a . 3) (a . 4) (a . 5) (a . 6) (a . 7) (a . 8) (a . 9)))))
+
+  (: cartesian-product/stream (All (a) (-> (Listof (Sequenceof a)) (Sequenceof (Listof a)))))
+  (define (cartesian-product/stream ss)
+    (for/foldr ([prod (stream (list))])
+      ([s (in-list ss)])
+      (cartesian-product-2/stream s prod)))
+
+  (module+ test
+    (test-case "cartesian-product/stream"
+      (check-equal? (stream->list (cartesian-product/stream '())) '(()))
+      (check-equal? (stream->list (cartesian-product/stream '((a b c))))
+                    '((a) (b) (c)))
+      (check-equal? (stream->list (cartesian-product/stream (list (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)))))
   )
 
 (require 'typed)
@@ -510,14 +536,14 @@
          list-sets->list-strings pretty-print-set pretty-print-set-sets
          update-vertices/unweighted update-graph dotit collect-by-key
          collect-by-key/sets ht-values/list->set hash->list/ordered
-         multi-split-at lists-transpose in-random cartesian-product-2/stream)
+         multi-split-at lists-transpose in-random cartesian-product-2/stream
+         cartesian-product/stream)
 
 ;;; Untyped section.
 
 (provide
  ;; Functions
- (contract-out [cartesian-product/stream (->* () #:rest (listof stream?) stream?)]
-               [boolean-power (-> number? (listof (listof boolean?)))]
+ (contract-out [boolean-power (-> number? (listof (listof boolean?)))]
                [boolean-power/stream (-> number? (stream/c (listof boolean?)))]
                [any->01 (-> any/c (or/c 0 1))]
                [01->boolean (-> (or/c 0 1) boolean?)])
@@ -541,42 +567,6 @@
         (cons/c key-contract val-contract)))
 
 
-;;; ===========================
-;;; 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))
-
-(module+ test
-  (test-case "cartesian-product/stream"
-    (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)))))
-
-
 ;;; ==================
 ;;; Boolean operations
 ;;; ==================
@@ -590,7 +580,7 @@
 
 ;;; Like boolean-power, but returns a stream whose elements the
 ;;; elements of the Cartesian power.
-(define (boolean-power/stream n) (apply cartesian-product/stream (make-list n '(#f #t))))
+(define (boolean-power/stream n) (cartesian-product/stream (make-list n '(#f #t))))
 
 (module+ test
   (test-case "boolean-power/stream"