network: Add get-interaction-sign.

networks.rkt

@@ -32,6 +32,7 @@
                [list-syntactic-interactions (-> network-form? variable? (listof variable?))]
                [build-syntactic-interaction-graph (-> network-form? graph?)]
                [interaction? (-> network? domain-mapping/c variable? variable? boolean?)]
+               [get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))]
                [build-all-states (-> domain-mapping/c (listof state?))]
                [make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
                [make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
@@ -435,6 +436,74 @@
     (check-false (interaction? n-multi 123-doms 'x 'y))
     (check-true (interaction? n-multi 123-doms '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
+;;; 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 doms x y)
+  (define dom-x (hash-ref doms x))
+  (define dom-y (hash-ref doms y))
+  (define y-func (hash-ref 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]))))
+  (match interactions
+    [(list '<) 1]
+    [(list '>) -1]
+    [(list '=) #f]
+    [_ 0]))
+
+(module+ test
+  (test-case "get-interaction-sign"
+    (define n-bool (network-form->network
+                    (hash 'x '(not y)
+                          'y 'x
+                          'z '(and y z)
+                          't '(or (and (not x) y)
+                                  (and x (not y))))))
+    (define bool-doms (make-boolean-domains '(x y z t)))
+    (check-equal? (get-interaction-sign n-bool bool-doms 'x 'y) 1)
+    (check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1)
+    (check-false (get-interaction-sign n-bool bool-doms 'x 'z))
+    (check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0)
+    (check-true (interaction? n-bool bool-doms 'y 'x))
+    (check-false (interaction? n-bool bool-doms 'x 'z))
+    (define n-multi (network-form->network
+                     (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)))
+    (check-false (get-interaction-sign n-multi 123-doms 'x 'y))
+    (check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1)
+    (check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1)
+    (check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0)))
+
 ;;; ====================
 ;;; Dynamics of networks
 ;;; ====================