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

networks.rkt

@@ -30,7 +30,8 @@
 
    list-syntactic-interactions build-syntactic-interaction-graph
    interaction? get-interaction-sign build-interaction-graph
-   build-interaction-graph/form
+   build-interaction-graph/form build-signed-interaction-graph
+   build-signed-interaction-graph/form
    )
 
   (define-type (State a) (VariableMapping a))
@@ -340,10 +341,10 @@
                          (hash-set st x x-val)))
       ;; TODO: Replace with for*/first when/if it is fixed.
       (for*/first/typed : (Option Boolean)
-          ([st1 : (State a) x-states]
+                        ([st1 : (State a) x-states]
-           [st2 : (State a) x-states]
+                         [st2 : (State a) x-states]
-           #:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
+                         #:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
-           #:unless (equal? (y-func st1) (y-func st2)))
+                         #:unless (equal? (y-func st1) (y-func st2)))
         #t))
     ;; TODO: Replace with for/first when/if it is fixed.
     (for/first/typed : (Option Boolean)
@@ -382,8 +383,8 @@
                                  ([x-val (in-list dom-x)])
                          (hash-set st x x-val)))
       (for/list : (Listof (U '< '> '=))
-          ([st1 (in-list x-states)]
+                ([st1 (in-list x-states)]
-           [st2 (in-list (cdr x-states))])
+                 [st2 (in-list (cdr x-states))])
         (define y1-idx (assert-type (index-of dom-y (y-func st1)) Index))
         (define y2-idx (assert-type (index-of dom-y (y-func st2)) Index))
         (cond
@@ -394,7 +395,7 @@
     (define interactions
       (remove-duplicates
        (for/list : (Listof (U '< '> '= Zero))
-           ([st (in-list states-not-x)])
+                 ([st (in-list states-not-x)])
          (define impacts (remove-duplicates (collect-impacts-on-y st)))
          (cond
            [(and (member '< impacts) (not (member '> impacts))) '<]
@@ -468,6 +469,44 @@
          (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")])))
+
+  (: build-signed-interaction-graph (All (a) (-> (Network a) Graph)))
+  (define (build-signed-interaction-graph network)
+    (define vars (hash-keys (network-functions network)))
+    (weighted-graph/directed
+     (for*/list : (Listof (List Integer Any Any))
+         ([x (in-list vars)]
+          [y (in-list vars)]
+          [sign (in-value (get-interaction-sign network x y))]
+          #:unless (eq? sign #f))
+       (list sign x y))))
+
+  (: build-signed-interaction-graph/form (All (a) (-> (NetworkForm a) Graph)))
+  (define (build-signed-interaction-graph/form nf)
+    (build-signed-interaction-graph (network-form->network/any nf)))
+
+  (module+ test
+    (test-case "build-signed-interaction-graph"
+      (cond
+        [skip-expensive-tests?
+         (displayln "Skipping test case build-signed-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-signed-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\tnode2 -> node2 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"-1\"];\n\t\tnode3 -> node1 [label=\"0\"];\n\t\tnode3 -> node0 [label=\"1\"];\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-signed-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 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"1\"];\n\t}\n}\n")])))
   )
 
 (require 'typed)
@@ -622,51 +661,6 @@
 (define update-function-form? any/c)
 
 
-;;; ============================
-;;; Inferring interaction graphs
-;;; ============================
-
-;;; 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,
-;;; in that order, unless this value is #f.
-(define (build-signed-interaction-graph network)
-  (define vars (hash-keys (network-functions network)))
-  (weighted-graph/directed
-   (for*/list ([x (in-list vars)]
-               [y (in-list vars)]
-               [sign (in-value (get-interaction-sign network x y))]
-               #:unless (eq? sign #f))
-     (list sign x y))))
-
-;;; Like build-signed-interaction-graph, but takes a network form and
-;;; converts it a to a network.
-(define build-signed-interaction-graph/form
-  (compose build-signed-interaction-graph network-form->network/any))
-
-(module+ test
-  (test-case "build-signed-interaction-graph"
-    (cond
-      [skip-expensive-tests?
-       (displayln "Skipping test case build-signed-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-signed-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\tnode1 -> node1 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode2 -> node3 [label=\"0\"];\n\t\tnode2 -> node0 [label=\"1\"];\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-signed-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 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"-1\"];\n\t}\n}\n")])))
-
 ;;; ====================
 ;;; Dynamics of networks
 ;;; ====================

scribblings/networks.scrbl

@@ -482,6 +482,29 @@ converts it a to @racket[(Network a)] first.
                                          (b . (not b))))))
 ]}
 
+@defproc[(build-signed-interaction-graph [network (Network a)]) Graph]{
+
+Given a network, builds its signed interaction graph.  The graph has variables
+as nodes and has a directed edge from @italic{x} to @racket{y} labelled by the
+value @racket[get-interaction-sign] produces for these variables, in that
+order, unless this value is @racket[#f].
+
+@ex[
+(dotit (build-signed-interaction-graph
+        (forms->boolean-network #hash((a . (and a b))
+                                      (b . (not b))))))
+]}
+
+@defproc[(build-signed-interaction-graph/form [nf (NetworkForm a)]) Graph]{
+
+Like @racket[build-signed-interaction-graph], but takes a network form and
+converts it to a network.
+
+@ex[
+(dotit (build-signed-interaction-graph/form
+        (make-boolean-network-form #hash((a . (and a b))
+                                         (b . (not b))))))
+]}
 
 @section{Tabulating functions and networks}