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

example/example.org

@@ -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:

networks.rkt

@@ -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")))