From 3d58660e9ccf100f9007cd3fbea0a13501090955 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Tue, 27 Sep 2022 00:14:25 +0200
Subject: [PATCH] Type tabulate-state*.

---
 networks.rkt               | 21 +++++++++++++++++++++
 scribblings/networks.scrbl | 20 ++++++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/networks.rkt b/networks.rkt
index ab24574..db65417 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -38,6 +38,8 @@
    build-full-state-graph/annotated
    pretty-print-state pretty-print-state/01 pretty-print-state-graph-with
    pretty-print-state-graph ppsg pretty-print-state-graph/01 ppsg01
+
+   tabulate-state*
    )
 
   (define-type (State a) (VariableMapping a))
@@ -735,6 +737,25 @@
                       "digraph G {\n\tnode0 [label=\"x:#f y:#t z:#f\"];\n\tnode1 [label=\"x:#f y:#t z:#t\"];\n\tnode2 [label=\"x:#t y:#f z:#t\"];\n\tnode3 [label=\"x:#t y:#t z:#t\"];\n\tnode4 [label=\"x:#t y:#t z:#f\"];\n\tnode5 [label=\"x:#t y:#f z:#f\"];\n\tnode6 [label=\"x:#f y:#f z:#f\"];\n\tnode7 [label=\"x:#f y:#f z:#t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node6 [];\n\t\tnode1 -> node7 [];\n\t\tnode2 -> node4 [];\n\t\tnode3 -> node1 [];\n\t\tnode4 -> node0 [];\n\t\tnode5 -> node4 [];\n\t\tnode6 -> node5 [];\n\t\tnode7 -> node5 [];\n\t}\n}\n")
         (check-equal? (graphviz (ppsg01 sg))
                       "digraph G {\n\tnode0 [label=\"x:1 y:0 z:0\"];\n\tnode1 [label=\"x:0 y:1 z:1\"];\n\tnode2 [label=\"x:0 y:0 z:1\"];\n\tnode3 [label=\"x:1 y:1 z:1\"];\n\tnode4 [label=\"x:1 y:0 z:1\"];\n\tnode5 [label=\"x:0 y:1 z:0\"];\n\tnode6 [label=\"x:0 y:0 z:0\"];\n\tnode7 [label=\"x:1 y:1 z:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node7 [];\n\t\tnode1 -> node2 [];\n\t\tnode2 -> node0 [];\n\t\tnode3 -> node1 [];\n\t\tnode4 -> node7 [];\n\t\tnode5 -> node6 [];\n\t\tnode6 -> node0 [];\n\t\tnode7 -> node5 [];\n\t}\n}\n"))))
+
+  (: tabulate-state* (All (a) (-> (Listof (-> (State a) a)) (DomainMapping a)
+                                  (Listof (Listof a)))))
+  (define (tabulate-state* funcs domains)
+    (for/list : (Listof (Listof a)) ([s (in-list (build-all-states domains))])
+      (append (hash-map s (λ ([x : Variable] [y : a]) y) #t)
+              (for/list : (Listof a) ([f (in-list funcs)]) (f s)))))
+
+  (module+ test
+    (test-case "tabulate-state*"
+      (define (f1 [st : (State Integer)])
+        (auto-hash-ref/: st (+ :a :b)))
+      (define (f2 [st : (State Integer)])
+        (auto-hash-ref/: st (- :a :b)))
+      (check-equal? (tabulate-state* (list f1 f2) (hash 'a '(1 2) 'b '(2 3)))
+                    '((1 2 3 -1)
+                      (1 3 4 -2)
+                      (2 2 4  0)
+                      (2 3 5 -1)))))
   )
 
 (require 'typed)
diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl
index 1927629..0c0fd04 100644
--- a/scribblings/networks.scrbl
+++ b/scribblings/networks.scrbl
@@ -714,6 +714,26 @@ converts it to a network.
 ]}
 
 @section{Tabulating functions and networks}
+@defproc[(tabulate-state* [funcs (Listof (-> (State a) a))]
+			  [domains (DomainMapping a)])
+			  (Listof (Listof a))]{
+
+Like @racket[tabulate*], but the functions operate on states.
+
+This function will produce a joint truth table of the given functions—a list of
+lists, in which the first columns list all possible combinations of the values
+of the input values, and the last columns give the corresponding values of the
+functions.  @racket[domains] defines the domains of each of the component of
+the states.
+
+@ex[
+(require (only-in "utils.rkt" auto-hash-ref/:))
+(let ([f1 (λ ([st : (State Integer)])
+            (auto-hash-ref/: st (+ :a :b)))]
+      [f2 (λ ([st : (State Integer)])
+            (auto-hash-ref/: st (- :a :b)))])
+  (tabulate-state* (list f1 f2) (hash 'a '(1 2) 'b '(2 3))))
+]}
 
 @section{Constructing functions and networks}