Type interaction?.

networks.rkt

@@ -26,6 +26,7 @@
    build-all-states build-all-boolean-states build-all-01-states
 
    list-syntactic-interactions build-syntactic-interaction-graph
+   interaction?
    )
 
   (define-type (State a) (VariableMapping a))
@@ -321,6 +322,46 @@
       (check-true (has-edge? ig 'b 'b))
       (check-false (has-edge? ig 'c 'b))
       (check-false (has-edge? ig 'c 'a))))
+
+  (: interaction? (All (a) (-> (Network a) Variable Variable Boolean)))
+  (define (interaction? network x y)
+    (define doms (network-domains network))
+    (define states-not-x (build-all-states (hash-remove doms x)))
+    (define dom-x (hash-ref doms x))
+    (define y-func (hash-ref (network-functions network) y))
+    (: different-ys-exist? (-> (State a) Boolean))
+    (define (different-ys-exist? st)
+      (define x-states (for/list ([x-val (in-list dom-x)])
+                         : (Listof (State a))
+                         (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]
+           [st2 : (State a) x-states]
+           #:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
+           #:unless (equal? (y-func st1) (y-func st2)))
+        #t))
+    ;; TODO: Replace with for/first when/if it is fixed.
+    (for/first/typed : (Option Boolean)
+                     ([st (in-list states-not-x)]
+                      #:when (different-ys-exist? st))
+      #t))
+
+  (module+ test
+    (test-case "interaction?"
+      (define n1 (forms->boolean-network
+                  (hash 'x '(not y)
+                        'y 'x
+                        'z '(and y z))))
+      (check-true (interaction? n1 'x 'y))
+      (check-true (interaction? n1 'y 'x))
+      (check-false (interaction? n1 'x 'z))
+      (define n-multi (hash 'x '(max (+ y 1) 2)
+                            'y '(min (- y 1) 0)))
+      (define 123-doms (make-same-domains '(x y) '(0 1 2)))
+      (define n2 (network-form->network/any (network-form n-multi 123-doms)))
+      (check-false (interaction? n2 'x 'y))
+      (check-true (interaction? n2 'y 'x))))
   )
 
 (require 'typed)
@@ -337,8 +378,7 @@
                [struct dynamics ([network network?]
                                  [mode mode?])])
  ;; Functions
- (contract-out [interaction? (-> network? variable? variable? boolean?)]
-               [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
+ (contract-out [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
                [build-interaction-graph (-> network? graph?)]
                [build-interaction-graph/form (-> network-form? graph?)]
                [build-signed-interaction-graph (-> network? graph?)]
@@ -483,43 +523,6 @@
 ;;; Inferring interaction graphs
 ;;; ============================
 
-;;; Given two variables x and y of a network f, verifies if they
-;;; interact, i.e. that there exists such a state s with the property
-;;; that s' which is s with a different value for x yields such a new
-;;; state f(s') in which the value for y is different from f(s).
-(define (interaction? network x y)
-  (define doms (network-domains network))
-  (define states-not-x (build-all-states (hash-remove doms x)))
-  (define dom-x (hash-ref doms x))
-  (define y-func (hash-ref (network-functions network) y))
-  (define (different-ys-exist? st)
-    (define x-states (for/list ([x-val (in-list dom-x)])
-                       (hash-set st x x-val)))
-    (for*/first ([st1 x-states]
-                 [st2 x-states]
-                 #:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
-                 #:unless (equal? (y-func st1) (y-func st2)))
-      #t))
-  (for*/first ([st (in-list states-not-x)]
-               #:when (different-ys-exist? st))
-    #t))
-
-(module+ test
-  (test-case "interaction?"
-    (define n1 (forms->boolean-network
-                (hash 'x '(not y)
-                      'y 'x
-                      'z '(and y z))))
-    (check-true (interaction? n1 'x 'y))
-    (check-true (interaction? n1 'y 'x))
-    (check-false (interaction? n1 'x 'z))
-    (define n-multi (hash 'x '(max (+ y 1) 2)
-                          'y '(min (- y 1) 0)))
-    (define 123-doms (make-same-domains '(x y) '(0 1 2)))
-    (define n2 (network-form->network/any (network-form n-multi 123-doms)))
-    (check-false (interaction? n2 'x 'y))
-    (check-true (interaction? n2 'y 'x))))
-
 ;;; Given two variables x and y of a network f, checks whether they
 ;;; interact, and if they interact, returns 1 if increasing x leads to
 ;;; an increase in y, -1 if it leads to a decrease in y, and 0 if it

scribblings/networks.scrbl

@@ -412,6 +412,28 @@ appears in @racket[(list-interactions y)].
                                          (b . (- b))))))
 ]}
 
+@defproc[(interaction? [network (Network a)]
+		       [x Variable]
+		       [y Variable])
+		       Boolean]{
+
+Given two variables @racket[x] and @racket[y] of a @racket[network], verifies
+if they interact, i.e. that there exists a pair of states @italic{s} and
+@italic{s'} with the following properties:
+
+@itemlist[
+@item{@italic{s} and @italic{s'} only differ in the value of @racket[x];}
+@item{running the network from @italic{s} and @italic{s'} yields different
+values for @racket[y].}
+]
+
+@ex[
+(let ([bn (forms->boolean-network #hash((a . (and a b))
+                                        (b . (not b))))])
+  (values (interaction? bn 'a 'b)
+          (interaction? bn 'b 'a)))
+]}
+
 @section{Tabulating functions and networks}
 
 @section{Constructing functions and networks}