diff --git a/example/example.org b/example/example.org index 6241521..5f90db8 100644 --- a/example/example.org +++ b/example/example.org @@ -1140,6 +1140,23 @@ tab [[file:dots/exampleudm6jn.svg]] :end: + You can print the note labels in a slightly prettier way using + =pretty-print-tbn-interaction-graph=: + + #+NAME: tbfs-nots-ig-pp + #+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots) +(dotit (pretty-print-tbn-interaction-graph (tbn-interaction-graph (read-org-tbn tbfs-nots)))) + #+END_SRC + + #+BEGIN_SRC dot :file dots/exampleQLHMVK.svg :results raw drawer :cmd dot :noweb yes +<> + #+END_SRC + + #+RESULTS: + :results: + [[file:dots/exampleQLHMVK.svg]] + :end: + * Reaction systems :PROPERTIES: :header-args:racket: :prologue "#lang racket\n(require graph dds/rs dds/utils)" diff --git a/networks.rkt b/networks.rkt index 0483474..4f68fcb 100644 --- a/networks.rkt +++ b/networks.rkt @@ -128,7 +128,8 @@ [print-org-sbn (->* (sbn?) (#:headers boolean? #:func-names boolean?) (listof (listof (or/c number? symbol?))))] [tbn-interaction-graph (->* (tbn?) (#:zero-edges boolean?) - graph?)]) + graph?)] + [pretty-print-tbn-interaction-graph (-> graph? graph?)]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -1664,3 +1665,15 @@ "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"))) + +;;; Pretty prints the node labels of the interaction graph of a TBN. +(define (pretty-print-tbn-interaction-graph ig) + (update-graph ig #:v-func (match-lambda + [(cons var weight) (~a var ":" weight)]))) + +(module+ test + (test-case "pretty-print-tbn-interaction-graph" + (define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1)))) + (b . ,(make-tbf/state '((a . -1)) -1))))) + (check-equal? (graphviz (pretty-print-tbn-interaction-graph (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")))