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

networks: Add tbn-interaction-graph and explain in example.

This commit is contained in:
Sergiu Ivanov 2020-11-08 20:29:00 +01:00
parent 000c2eeba7
commit 7af1bb8d79
2 changed files with 64 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
example/example.org
View File

@ -1107,6 +1107,38 @@ tab
| C | -1 | 2 | -1 |
:end:
=dds= also defines functions to draw the interaction graphs
of TBNs:
#+NAME: tbfs-nots-ig
#+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots)
(dotit (tbn-interaction-graph (read-org-tbn tbfs-nots)))
#+END_SRC
#+BEGIN_SRC dot :file dots/exampletCklZa.svg :results raw drawer :cmd dot :noweb yes
<<tbfs-nots-ig()>>
#+END_SRC
#+RESULTS:
:results:
[[file:dots/exampletCklZa.svg]]
:end:
=tbn-interaction-graph= can optionally omit edges with zero weight:
#+NAME: tbfs-nots-ig-no0
#+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots)
(dotit (tbn-interaction-graph (read-org-tbn tbfs-nots) #:zero-edges #f))
#+END_SRC
#+BEGIN_SRC dot :file dots/exampleudm6jn.svg :results raw drawer :cmd dot :noweb yes
<<tbfs-nots-ig-no0()>>
#+END_SRC
#+RESULTS:
:results:
[[file:dots/exampleudm6jn.svg]]
:end:
* Reaction systems
:PROPERTIES:

33
networks.rkt
View File

@ -126,7 +126,9 @@
[print-org-tbn (->* (tbn?) (#:headers boolean? #:func-names boolean?)
(listof (listof (or/c number? symbol?))))]
[print-org-sbn (->* (sbn?) (#:headers boolean? #:func-names boolean?)
(listof (listof (or/c number? symbol?))))])
(listof (listof (or/c number? symbol?))))]
[tbn-interaction-graph (->* (tbn?) (#:zero-edges boolean?)
graph?)])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
@ -1633,3 +1635,32 @@
(tbf/state (hash 'a 2) 0)))
(check-equal? (print-org-sbn sbn)
'((- a b) (a 0 2) (b 2 0)))))
;;; Given a TBN, constructs its interaction graph. The nodes of this
;;; graph are labeled with pairs (variable name . threshold), while
;;; the edges are labelled with the weights.
;;;
;;; If #:zero-edges is #t, the edges with zero weights will appear in
;;; the interaction 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 ([(tar tbf) (in-hash ntbn)]
[(src w) (in-hash (tbf/state-w tbf))])
(list w src tar))
(for*/list ([(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 x))))))
(module+ test
(test-case "tbn-interaction-graph"
(define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1))))
(b . ,(make-tbf/state '((a . -1)) -1)))))
(check-equal? (graphviz (tbn-interaction-graph tbn))
"digraph G {\n\tnode0 [label=\"'(b . -1)\\n\"];\n\tnode1 [label=\"'(a . 0)\\n\"];\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\"];\n\tnode1 [label=\"'(a . 0)\\n\"];\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")))