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