From 78462d5083fa97e485e834de75b527f7510ccf48 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Wed, 12 Jul 2023 20:12:09 +0200
Subject: [PATCH] Type build-tbn-state-graph.

---
 scribblings/tbn.scrbl | 15 +++++++++++++++
 tbn.rkt               | 16 ++++++++++++++++
 2 files changed, 31 insertions(+)

diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl
index 2bb3c74..f58cecc 100644
--- a/scribblings/tbn.scrbl
+++ b/scribblings/tbn.scrbl
@@ -438,6 +438,21 @@ Constructs a @racket[Network] out of the given @racket[tbn].
   (update tbn s '(a b)))
 ]}
 
+@defproc[(build-tbn-state-graph [tbn TBN]) Graph]{
+
+Builds the state graph of a @racket[TBN].
+
+This function constructs a @racket[(Network (U Zero One))] from
+@racket[tbn], then builds the state graph of its synchronous dynamics,
+and pretty-prints the node labels.
+
+@ex[
+(require (only-in "utils.rkt" dotit))
+(dotit (build-tbn-state-graph
+        (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
+              'b (tbf/state (hash 'a -1 'b 1) 1))))
+]}
+
 @section{Miscellaneous utilities}
 
 @defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])
diff --git a/tbn.rkt b/tbn.rkt
index a18ae8a..c82c550 100644
--- a/tbn.rkt
+++ b/tbn.rkt
@@ -38,6 +38,7 @@
 
    TBN sbn? tbn->network
    parse-org-tbn read-org-tbn read-org-sbn
+   build-tbn-state-graph
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -498,6 +499,21 @@
                     #hash((a . 1) (b . 0)))
       (check-equal? (network-domains tbn)
                     #hash((a . (0 1)) (b . (0 1))))))
+
+  (: build-tbn-state-graph (-> TBN Graph))
+  (define (build-tbn-state-graph tbn)
+    (pretty-print-state-graph
+     ((inst build-full-state-graph (U Zero One))
+      ((inst make-syn-dynamics (U Zero One))
+       (tbn->network tbn)))))
+
+  (module+ test
+    (test-case "build-tbn-state-graph"
+      (check-equal? (graphviz
+                     (build-tbn-state-graph
+                      (hash 'a (tbf/state (hash 'a -1 'b 1) 0)
+                            'b (tbf/state (hash 'a -1 'b 1) 1))))
+                    "digraph G {\n\tnode0 [label=\"a:0 b:0\"];\n\tnode1 [label=\"a:1 b:1\"];\n\tnode2 [label=\"a:0 b:1\"];\n\tnode3 [label=\"a:1 b:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0 [];\n\t\tnode2 -> node3 [];\n\t\tnode3 -> node0 [];\n\t}\n}\n")))
   )
 
 (module+ test