From 927877b02fcabf02a8989a2309f50d15f6c45d3d Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Mon, 7 Aug 2023 16:17:53 +0200
Subject: [PATCH] Start the section Reading and printing TBNs and SBNs.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

… and move some functions around without modifying them.
---
 scribblings/tbn.scrbl | 104 ++++++++++++++-------------
 tbn.rkt               | 164 +++++++++++++++++++++---------------------
 2 files changed, 135 insertions(+), 133 deletions(-)

diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl
index 51a2c09..c2ce140 100644
--- a/scribblings/tbn.scrbl
+++ b/scribblings/tbn.scrbl
@@ -366,6 +366,59 @@ 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))))
+]}
+
+@defproc[(normalized-tbn? [tbn TBN]) Boolean]{
+
+Checks whether @racket[tbn] is normalized: whether all of the
+functions have the same inputs, and whether these inputs are exactly
+the variables of @racket[tbn].
+
+@ex[
+(normalized-tbn?
+ (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
+       'y (tbf/state (hash 'x -1 'y 0) -1)))
+(normalized-tbn?
+ (hash 'x (tbf/state (hash 'x 0 ) -1)
+       'y (tbf/state (hash 'y 0) -1)))
+]}
+
+@defproc[(normalize-tbn (tbn TBF)) TBN]{
+
+Normalizes @racket[tbn]: for every @racket[TBF/State], removes the
+inputs that are not in the variables of @racket[tbn], and adds missing
+inputs with 0 weight.
+
+@ex[
+(normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
+                     'y (tbf/state (hash 'y 3) 1)))
+]}
+
+@defproc[(compact-tbn [tbn TBN]) TBN]{
+
+Compacts the @racket[tbn] by removing all inputs which are 0 or which
+are not variables of the network.
+
+@ex[
+(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
+                   'b (tbf/state (hash 'a -1 'b 1) -1)))
+]}
+
+@section{Reading and printing TBNs and SBNs}
+
 @defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
 			[#:headers headers Boolean #t]
 			[#:func-names func-names Boolean #t])
@@ -446,57 +499,6 @@ set to 0.
 (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
 ]}
 
-@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))))
-]}
-
-@defproc[(normalized-tbn? [tbn TBN]) Boolean]{
-
-Checks whether @racket[tbn] is normalized: whether all of the
-functions have the same inputs, and whether these inputs are exactly
-the variables of @racket[tbn].
-
-@ex[
-(normalized-tbn?
- (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
-       'y (tbf/state (hash 'x -1 'y 0) -1)))
-(normalized-tbn?
- (hash 'x (tbf/state (hash 'x 0 ) -1)
-       'y (tbf/state (hash 'y 0) -1)))
-]}
-
-@defproc[(normalize-tbn (tbn TBF)) TBN]{
-
-Normalizes @racket[tbn]: for every @racket[TBF/State], removes the
-inputs that are not in the variables of @racket[tbn], and adds missing
-inputs with 0 weight.
-
-@ex[
-(normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
-                     'y (tbf/state (hash 'y 3) 1)))
-]}
-
-@defproc[(compact-tbn [tbn TBN]) TBN]{
-
-Compacts the @racket[tbn] by removing all inputs which are 0 or which
-are not variables of the network.
-
-@ex[
-(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 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 6960c35..5e253de 100644
--- a/tbn.rkt
+++ b/tbn.rkt
@@ -47,8 +47,8 @@
    group-truth-table-by-nai
 
    TBN sbn? tbn->network
-   parse-org-tbn read-org-tbn read-org-sbn
    build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
+   parse-org-tbn read-org-tbn read-org-sbn
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -416,6 +416,87 @@
       (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")))
+
+  (: normalized-tbn? (-> TBN Boolean))
+  (define (normalized-tbn? tbn)
+    (define tbn-vars (hash-keys tbn))
+    (for/and ([tbf (in-list (hash-values tbn))])
+      (set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
+
+  (module+ test
+    (test-case "normalized-tbn?"
+      (check-true (normalized-tbn?
+                   (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
+                         'y (tbf/state (hash 'x -1 'y 0) -1))))
+      (check-false (normalized-tbn?
+                    (hash 'x (tbf/state (hash 'x 0 ) -1)
+                          'y (tbf/state (hash 'y 0) -1))))))
+
+  (: normalize-tbn (-> TBN TBN))
+  (define (normalize-tbn tbn)
+    (define vars-0 (for/hash : (VariableMapping Real)
+                             ([(x _) (in-hash tbn)])
+                     (values x 0)))
+    (: normalize-tbf (-> TBF/State TBF/State))
+    (define (normalize-tbf tbf)
+      ;; Only keep the inputs which are also the variables of tbn.
+      (define w-pruned (hash-intersect/tbn-tbf
+                        tbn
+                        (tbf/state-w tbf)
+                        #:combine (λ (_ w) w)))
+      ;; Put in the missing inputs with weight 0.
+      (define w-complete
+        (assert-type (hash-union vars-0 w-pruned #:combine (λ (_ w) w))
+                     (VariableMapping Real)))
+      (tbf/state w-complete (tbf/state-θ tbf)))
+    (for/hash : TBN ([(x tbf) (in-hash tbn)])
+      (values x (normalize-tbf tbf))))
+
+  (module+ test
+    (test-case "normalize-tbn"
+      (check-equal? (normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
+                                         'y (tbf/state (hash 'y 3) 1)))
+                    (hash 'x (tbf/state (hash 'x 2 'y 0) -1)
+                          'y (tbf/state (hash 'x 0 'y 3) 1)))))
+
+  (: compact-tbn (-> TBN TBN))
+  (define (compact-tbn tbn)
+    (: remove-0-non-var (-> TBF/State TBF/State))
+    (define (remove-0-non-var tbf)
+      (tbf/state (for/hash : (VariableMapping Real)
+                           ([(x w) (in-hash (tbf/state-w tbf))]
+                            #:when (hash-has-key? tbn x)
+                            #:unless (zero? w))
+                   (values x w))
+                 (tbf/state-θ tbf)))
+    (for/hash : TBN ([(x tbf) (in-hash tbn)])
+      (values x (remove-0-non-var tbf))))
+
+  (module+ test
+    (test-case "compact-tbn"
+      (check-equal?
+       (compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
+                          'b (tbf/state (hash 'a -1 'b 1) -1)))
+       (hash
+        'a
+        (tbf/state '#hash((b . 1)) 0)
+        'b
+        (tbf/state '#hash((a . -1) (b . 1)) -1)))))
+
   (: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
                         (#:headers Boolean
                          #:func-names Boolean)
@@ -523,87 +604,6 @@
                      (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
                      'x1
                      (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
-
-  (: 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")))
-
-  (: normalized-tbn? (-> TBN Boolean))
-  (define (normalized-tbn? tbn)
-    (define tbn-vars (hash-keys tbn))
-    (for/and ([tbf (in-list (hash-values tbn))])
-      (set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
-
-  (module+ test
-    (test-case "normalized-tbn?"
-      (check-true (normalized-tbn?
-                   (hash 'x (tbf/state (hash 'x 0 'y -1) -1)
-                         'y (tbf/state (hash 'x -1 'y 0) -1))))
-      (check-false (normalized-tbn?
-                    (hash 'x (tbf/state (hash 'x 0 ) -1)
-                          'y (tbf/state (hash 'y 0) -1))))))
-
-  (: normalize-tbn (-> TBN TBN))
-  (define (normalize-tbn tbn)
-    (define vars-0 (for/hash : (VariableMapping Real)
-                             ([(x _) (in-hash tbn)])
-                     (values x 0)))
-    (: normalize-tbf (-> TBF/State TBF/State))
-    (define (normalize-tbf tbf)
-      ;; Only keep the inputs which are also the variables of tbn.
-      (define w-pruned (hash-intersect/tbn-tbf
-                        tbn
-                        (tbf/state-w tbf)
-                        #:combine (λ (_ w) w)))
-      ;; Put in the missing inputs with weight 0.
-      (define w-complete
-        (assert-type (hash-union vars-0 w-pruned #:combine (λ (_ w) w))
-                     (VariableMapping Real)))
-      (tbf/state w-complete (tbf/state-θ tbf)))
-    (for/hash : TBN ([(x tbf) (in-hash tbn)])
-      (values x (normalize-tbf tbf))))
-
-  (module+ test
-    (test-case "normalize-tbn"
-      (check-equal? (normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
-                                         'y (tbf/state (hash 'y 3) 1)))
-                    (hash 'x (tbf/state (hash 'x 2 'y 0) -1)
-                          'y (tbf/state (hash 'x 0 'y 3) 1)))))
-
-  (: compact-tbn (-> TBN TBN))
-  (define (compact-tbn tbn)
-    (: remove-0-non-var (-> TBF/State TBF/State))
-    (define (remove-0-non-var tbf)
-      (tbf/state (for/hash : (VariableMapping Real)
-                           ([(x w) (in-hash (tbf/state-w tbf))]
-                            #:when (hash-has-key? tbn x)
-                            #:unless (zero? w))
-                   (values x w))
-                 (tbf/state-θ tbf)))
-    (for/hash : TBN ([(x tbf) (in-hash tbn)])
-      (values x (remove-0-non-var tbf))))
-
-  (module+ test
-    (test-case "compact-tbn"
-      (check-equal?
-       (compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
-                          'b (tbf/state (hash 'a -1 'b 1) -1)))
-       (hash
-        'a
-        (tbf/state '#hash((b . 1)) 0)
-        'b
-        (tbf/state '#hash((a . -1) (b . 1)) -1)))))
   )
 
 (module+ test