Type build-interaction-graph and build-interaction-graph/form.

networks.rkt

@@ -5,7 +5,10 @@
            typed/graph racket/random)
 
   (module+ test
-    (require typed/rackunit))
+    (require typed/rackunit)
+    (define skip-expensive-tests? #f)
+    (unless skip-expensive-tests?
+      (displayln "Running the complete test suite...")))
 
   (provide
    State UpdateFunction Domain DomainMapping
@@ -26,7 +29,8 @@
    build-all-states build-all-boolean-states build-all-01-states
 
    list-syntactic-interactions build-syntactic-interaction-graph
-   interaction? get-interaction-sign
+   interaction? get-interaction-sign build-interaction-graph
+   build-interaction-graph/form
    )
 
   (define-type (State a) (VariableMapping a))
@@ -427,6 +431,43 @@
       (check-equal? (get-interaction-sign n2 'y 'z) -1)
       (check-equal? (get-interaction-sign n2 'y 't) 0)
       (check-equal? (get-interaction-sign n2 'y 'y) 1)))
+
+  (: build-interaction-graph (All (a) (-> (Network a) Graph)))
+  (define (build-interaction-graph network)
+    (define vars (hash-keys (network-functions network)))
+    (unweighted-graph/directed
+     (for*/list : (Listof (List Any Any))
+                ([x (in-list vars)]
+                 [y (in-list vars)]
+                 #:when (interaction? network x y))
+       (list x y))))
+
+  (: build-interaction-graph/form (All (a) (-> (NetworkForm a) Graph)))
+  (define (build-interaction-graph/form form)
+    (build-interaction-graph (network-form->network/any form)))
+
+  (module+ test
+    (test-case "build-interaction-graph"
+      (cond
+        [skip-expensive-tests?
+         (displayln "Skipping test case build-interaction-graph.")]
+        [else
+         (define n1 (make-boolean-network-form
+                     (hash 'x '(not y)
+                           'y 'x
+                           'z '(and y z)
+                           't '(or (and (not x) y)
+                                   (and x (not y))))))
+         (check-equal? (graphviz (build-interaction-graph/form n1))
+                       "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node3 [];\n\t\tnode2 -> node2 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode3 -> node1 [];\n\t}\n}\n")
+         (define n-multi (hash 'x '(min (+ y 1) 2)
+                               'y '(max (- y 1) 0)
+                               'z '(- 2 y)
+                               't '(abs (- y 1))))
+         (define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
+         (define n2 (network-form n-multi 123-doms))
+         (check-equal? (graphviz (build-interaction-graph/form n2))
+                       "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode0 -> node3 [];\n\t}\n}\n")])))
   )
 
 (require 'typed)
@@ -585,46 +626,6 @@
 ;;; Inferring interaction graphs
 ;;; ============================
 
-
-;;; Given a network, builds its interaction graph.  The graph has
-;;; variables as nodes and has a directed edge from x to y if
-;;; interaction? returns #t for these variables, in this order.
-(define (build-interaction-graph network)
-  (define vars (hash-keys (network-functions network)))
-  (unweighted-graph/directed
-   (for*/list ([x (in-list vars)]
-               [y (in-list vars)]
-               #:when (interaction? network x y))
-     (list x y))))
-
-;;; Like build-interaction-graph, but accepts a network form and
-;;; converts it a to a network.
-(define build-interaction-graph/form
-  (compose build-interaction-graph network-form->network/any))
-
-(module+ test
-  (test-case "build-interaction-graph"
-    (cond
-      [skip-expensive-tests?
-       (displayln "Skipping test case build-interaction-graph.")]
-      [else
-       (define n1 (make-boolean-network-form
-                   (hash 'x '(not y)
-                         'y 'x
-                         'z '(and y z)
-                         't '(or (and (not x) y)
-                                 (and x (not y))))))
-       (check-equal? (graphviz (build-interaction-graph/form n1))
-                     "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node1;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t\tnode2 -> node3;\n\t}\n}\n")
-       (define n-multi (hash 'x '(min (+ y 1) 2)
-                             'y '(max (- y 1) 0)
-                             'z '(- 2 y)
-                             't '(abs (- y 1))))
-       (define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
-       (define n2 (network-form n-multi 123-doms))
-       (check-equal? (graphviz (build-interaction-graph/form n2))
-                     "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t}\n}\n")])))
-
 ;;; Given a network, builds its signed interaction graph.  The graph
 ;;; has variables as nodes and has a directed edge from x to
 ;;; y labelled by the value get-interaction-sign for these variables,

scribblings/networks.scrbl

@@ -458,6 +458,31 @@ between @racket[x] and @racket[y], it is more costly than calling
           (get-interaction-sign bn 'b 'a)
           (get-interaction-sign bn 'b 'b)))
 ]}
+
+@defproc[(build-interaction-graph [network (Network a)]) Graph]{
+
+Given a network, builds its interaction graph.  The graph has variables as
+nodes and has a directed edge from @italic{x} to @italic{y} if
+@racket[interaction?] returns @racket[#t] for these variables, in this order.
+
+@ex[
+(dotit (build-interaction-graph
+        (forms->boolean-network #hash((a . (and a b))
+                                      (b . (not b))))))
+]}
+
+@defproc[(build-interaction-graph/form [nf (NetworkForm a)]) Graph]{
+
+Like @racket[build-interaction-graph], but accepts a network form and
+converts it a to @racket[(Network a)] first.
+
+@ex[
+(dotit (build-interaction-graph/form
+        (make-boolean-network-form #hash((a . (and a b))
+                                         (b . (not b))))))
+]}
+
+
 @section{Tabulating functions and networks}
 
 @section{Constructing functions and networks}