scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Type tbn-interaction-graph.

Browse source
This commit is contained in:
Sergiu Ivanov 2023-08-08 08:46:43 +02:00
parent aca3fb7868
commit ac7f928737
2 changed files with 46 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
scribblings/tbn.scrbl
View file

@ -417,6 +417,25 @@ are not variables of the network.
'b (tbf/state (hash 'a -1 'b 1) -1)))
]}
@defproc[(tbn-interaction-graph [tbn TBN]
[#:zero-edges zero-edges Boolean #t])
Graph]{
Constructs the interaction graph of @racket[tbn]. The nodes of this
graph are labeled with pairs (variable name, threshold), while the
edges are labeled with the weights.
If @racket[#:zero-edges] is @racket[#t], the edges with zero weights
will also appear in the interaction graph.
@ex[
(dotit (tbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
'b (tbf/state (hash 'a -1) -1))))
(dotit (tbn-interaction-graph (hash 'a (tbf/state (hash 'b 1) 0)
'b (tbf/state (hash 'a -1) -1))
#:zero-edges #f))
]}
@section{Reading and printing TBNs and SBNs}
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]

27
tbn.rkt
View file

@ -48,6 +48,7 @@
TBN sbn? tbn->network
build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
tbn-interaction-graph
parse-org-tbn read-org-tbn read-org-sbn tbn->lists sbn->lists
)
@ -497,6 +498,32 @@
'b
(tbf/state '#hash((a . -1) (b . 1)) -1)))))
(: tbn-interaction-graph (->* (TBN) (#:zero-edges Boolean) Graph))
(define (tbn-interaction-graph tbn #:zero-edges [zero-edges #t])
(define ntbn (normalize-tbn tbn))
(define ig (weighted-graph/directed
(if zero-edges
(for*/list : (Listof (List Real Variable Variable))
([(tar tbf) (in-hash ntbn)]
[(src w) (in-hash (tbf/state-w tbf))])
(list w src tar))
(for*/list : (Listof (List Real Variable Variable))
([(tar tbf) (in-hash ntbn)]
[(src w) (in-hash (tbf/state-w tbf))]
#:unless (zero? w))
(list w src tar)))))
(update-graph
ig #:v-func (λ (x) (cons x (tbf/state-θ (hash-ref ntbn (assert-type x Variable)))))))
(module+ test
(test-case "tbn-interaction-graph"
(define tbn (hash 'a (tbf/state (hash 'b 1) 0)
'b (tbf/state (hash 'a -1) -1)))
(check-equal? (graphviz (tbn-interaction-graph tbn))
"digraph G {\n\tnode0 [label=\"'(b . -1)\"];\n\tnode1 [label=\"'(a . 0)\"];\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")
(check-equal? (graphviz (tbn-interaction-graph tbn #:zero-edges #f))
"digraph G {\n\tnode0 [label=\"'(b . -1)\"];\n\tnode1 [label=\"'(a . 0)\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode1 -> node0 [label=\"-1\"];\n\t}\n}\n")))
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
(#:headers Boolean
#:func-names Boolean)