Type get-interaction-sign.

networks.rkt

@@ -26,7 +26,7 @@
    build-all-states build-all-boolean-states build-all-01-states
 
    list-syntactic-interactions build-syntactic-interaction-graph
-   interaction?
+   interaction? get-interaction-sign
    )
 
   (define-type (State a) (VariableMapping a))
@@ -362,6 +362,71 @@
       (define n2 (network-form->network/any (network-form n-multi 123-doms)))
       (check-false (interaction? n2 'x 'y))
       (check-true (interaction? n2 'y 'x))))
+
+  (: get-interaction-sign (All (a) (-> (Network a) Variable Variable (Option Integer))))
+  (define (get-interaction-sign network x y)
+    (define doms (network-domains network))
+    (define dom-x (hash-ref doms x))
+    (define dom-y (hash-ref doms y))
+    (define y-func (hash-ref (network-functions network) y))
+    (define (collect-impacts-on-y [st : (State a)])
+      ;; The way in which the values are ordered in the domains gives
+      ;; a total order on these values.  This means that considering
+      ;; pairs of consecutive values of x is sufficient for testing the
+      ;; sign of the interaction.
+      (define x-states (for/list : (Listof (State a))
+                                 ([x-val (in-list dom-x)])
+                         (hash-set st x x-val)))
+      (for/list : (Listof (U '< '> '=))
+          ([st1 (in-list 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
+          [(< y1-idx y2-idx) '<]
+          [(> y1-idx y2-idx) '>]
+          [else '=])))
+    (define states-not-x (build-all-states (hash-remove doms x)))
+    (define interactions
+      (remove-duplicates
+       (for/list : (Listof (U '< '> '= Zero))
+           ([st (in-list states-not-x)])
+         (define impacts (remove-duplicates (collect-impacts-on-y st)))
+         (cond
+           [(and (member '< impacts) (not (member '> impacts))) '<]
+           [(and (member '> impacts) (not (member '< impacts))) '>]
+           [(equal? impacts '(=)) '=]
+           [else 0]))))
+    (cond
+      [(and (member '< interactions) (not (member '> interactions))) 1]
+      [(and (member '> interactions) (not (member '< interactions))) -1]
+      [(equal? interactions '(=)) #f]
+      [else 0]))
+
+  (module+ test
+    (test-case "get-interaction-sign"
+      (define n1 (forms->boolean-network
+                  (hash 'x '(not y)
+                        'y 'x
+                        'z '(and y z)
+                        't '(or (and (not x) y)
+                                (and x (not y))))))
+      (check-equal? (get-interaction-sign n1 'x 'y) 1)
+      (check-equal? (get-interaction-sign n1 'y 'x) -1)
+      (check-false (get-interaction-sign n1 'x 'z))
+      (check-equal? (get-interaction-sign n1 'y 'z) 1)
+      (check-equal? (get-interaction-sign n1 'x 't) 0)
+      (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->network/any (network-form n-multi 123-doms)))
+      (check-false (get-interaction-sign n2 'x 'y))
+      (check-equal? (get-interaction-sign n2 'y 'x) 1)
+      (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)))
   )
 
 (require 'typed)
@@ -378,10 +443,7 @@
                [struct dynamics ([network network?]
                                  [mode mode?])])
  ;; Functions
- (contract-out [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
+ (contract-out [build-signed-interaction-graph (-> network? graph?)]
-               [build-interaction-graph (-> network? graph?)]
-               [build-interaction-graph/form (-> network-form? graph?)]
-               [build-signed-interaction-graph (-> network? graph?)]
                [build-signed-interaction-graph/form (-> network-form? graph?)]
                [make-asyn (-> (listof variable?) mode?)]
                [make-syn (-> (listof variable?) mode?)]
@@ -523,73 +585,6 @@
 ;;; Inferring interaction graphs
 ;;; ============================
 
-;;; 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
-;;; can lead to both.  If x has no impact on y, returns #f.
-;;;
-;;; Use interaction? if you only need to know whether two variables
-;;; interact, because interaction? will be often faster.
-(define (get-interaction-sign network x y)
-  (define doms (network-domains network))
-  (define dom-x (hash-ref doms x))
-  (define dom-y (hash-ref doms y))
-  (define y-func (hash-ref (network-functions network) y))
-  (define (collect-impacts-on-y st)
-    ;; The way in which the values are ordered in the domains gives
-    ;; a total order on these values.  This means that considering
-    ;; pairs of consecutive values of x is sufficient for testing the
-    ;; sign of the interaction.
-    (define x-states (for/list ([x-val (in-list dom-x)])
-                       (hash-set st x x-val)))
-    (for/list ([st1 (in-list x-states)]
-               [st2 (in-list (cdr x-states))])
-      (define y1-idx (index-of dom-y (y-func st1)))
-      (define y2-idx (index-of dom-y (y-func st2)))
-      (cond
-        [(< y1-idx y2-idx) '<]
-        [(> y1-idx y2-idx) '>]
-        [else '=])))
-  (define states-not-x (build-all-states (hash-remove doms x)))
-  (define interactions
-    (remove-duplicates
-     (for/list ([st (in-list states-not-x)])
-       (define impacts (remove-duplicates (collect-impacts-on-y st)))
-       (cond
-         [(and (member '< impacts) (not (member '> impacts))) '<]
-         [(and (member '> impacts) (not (member '< impacts))) '>]
-         [(equal? impacts '(=)) '=]
-         [else 0]))))
-  (cond
-    [(and (member '< interactions) (not (member '> interactions))) 1]
-    [(and (member '> interactions) (not (member '< interactions))) -1]
-    [(equal? interactions '(=)) #f]
-    [else 0]))
-
-(module+ test
-  (test-case "get-interaction-sign"
-    (define n1 (forms->boolean-network
-                (hash 'x '(not y)
-                      'y 'x
-                      'z '(and y z)
-                      't '(or (and (not x) y)
-                              (and x (not y))))))
-    (check-equal? (get-interaction-sign n1 'x 'y) 1)
-    (check-equal? (get-interaction-sign n1 'y 'x) -1)
-    (check-false (get-interaction-sign n1 'x 'z))
-    (check-equal? (get-interaction-sign n1 'y 'z) 1)
-    (check-equal? (get-interaction-sign n1 'x 't) 0)
-    (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->network/any (network-form n-multi 123-doms)))
-    (check-false (get-interaction-sign n2 'x 'y))
-    (check-equal? (get-interaction-sign n2 'y 'x) 1)
-    (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)))
 
 ;;; Given a network, builds its interaction graph.  The graph has
 ;;; variables as nodes and has a directed edge from x to y if

scribblings/networks.scrbl

@@ -434,6 +434,30 @@ values for @racket[y].}
           (interaction? bn 'b 'a)))
 ]}
 
+@defproc[(get-interaction-sign [network (Network a)]
+			       [x Variable]
+			       [y Variable])
+			       (Option Integer)]{
+
+Given two variables @racket[x] and @racket[y] of @racket[network], checks
+whether they interact, and if they interact, returns 1 if increasing @racket[x]
+leads to an increase in @racket[y], -1 if it leads to a decrease in @racket[y],
+and 0 if it can lead to both.  If @racket[x] has no impact on @racket[y], returns @racket[#f].
+
+The values in the domains are ordered according to the order in which they are
+listed in @racket[network].
+
+Since @racket[get-interaction-sign] needs to check all possible interactions
+between @racket[x] and @racket[y], it is more costly than calling
+@racket[interaction?].
+
+@ex[
+(let ([bn (forms->boolean-network #hash((a . (and a b))
+                                        (b . (not b))))])
+  (values (get-interaction-sign bn 'a 'b)
+          (get-interaction-sign bn 'b 'a)
+          (get-interaction-sign bn 'b 'b)))
+]}
 @section{Tabulating functions and networks}
 
 @section{Constructing functions and networks}