Type sbn-interaction-graph.

This commit is contained in:
Sergiu Ivanov 2023-08-08 16:10:35 +02:00
parent e9ecbd8a7c
commit dd7117c733
2 changed files with 26 additions and 0 deletions

View file

@ -446,6 +446,18 @@ Pretty prints the node labels of the interaction graph of a TBN.
'b (tbf/state (hash 'a -1) -1)))))
]}
@defproc[(sbn-interaction-graph [sbn TBN]) Graph]{
Constructs the interaction graph of @racket[sbn], like
@racket[tbn-interaction-graph], but the nodes of the graph are labeled
with variable names only. This is an adaptation to SBNs, in which all
weights are 0. The function does not check whether @racket[sbn] is
indeed an SBN.
@ex[
(dotit (sbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
'b (tbf/state (hash 'a -1) -1))))
]}
@section{Reading and printing TBNs and SBNs}

14
tbn.rkt
View file

@ -49,6 +49,7 @@
TBN sbn? tbn->network
build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
tbn-interaction-graph pretty-print-tbn-interaction-graph
sbn-interaction-graph
parse-org-tbn read-org-tbn read-org-sbn tbn->lists sbn->lists
)
@ -537,6 +538,19 @@
(tbn-interaction-graph tbn)))
"digraph G {\n\tnode0 [label=\"a:0\"];\n\tnode1 [label=\"b:-1\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"0\"];\n\t\tnode1 -> node1 [label=\"0\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"-1\"];\n\t\tnode1 -> node0 [label=\"1\"];\n\t}\n}\n")))
(: sbn-interaction-graph (-> TBN Graph))
(define (sbn-interaction-graph sbn #:zero-edges [zero-edges #t])
(update-graph (tbn-interaction-graph sbn #:zero-edges zero-edges)
#:v-func (match-lambda
[(cons var _) var])))
(module+ test
(test-case "sbn-interaction-graph"
(define sbn (hash 'a (tbf/state (hash 'b 2) 0)
'b (tbf/state (hash 'a 2) 0)))
(check-equal? (graphviz (sbn-interaction-graph sbn))
"digraph G {\n\tnode0 [label=\"b\"];\n\tnode1 [label=\"a\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node1 [label=\"2\"];\n\t\tnode0 -> node0 [label=\"0\"];\n\t\tnode1 -> node1 [label=\"0\"];\n\t}\n\tsubgraph D {\n\t}\n}\n")))
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
(#:headers Boolean
#:func-names Boolean)