From 8e100c2e8bd7a4b920fcc3054c96eba2c2d9acbb Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Wed, 18 Nov 2020 01:11:37 +0100
Subject: [PATCH] networks: Add build-signed-interaction-graph.

---
 networks.rkt | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/networks.rkt b/networks.rkt
index a8bad84..dd27136 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -34,6 +34,7 @@
                [interaction? (-> network? domain-mapping/c variable? variable? boolean?)]
                [get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))]
                [build-interaction-graph (-> network? domain-mapping/c graph?)]
+               [build-signed-interaction-graph (-> network? domain-mapping/c graph?)]
                [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)))]
@@ -536,6 +537,39 @@
     (check-equal? (graphviz (build-interaction-graph n-multi 123-doms))
                   "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,
+;;; in that order, unless this value is #f.
+(define (build-signed-interaction-graph network doms)
+  (define vars (hash-keys network))
+  (weighted-graph/directed
+   (for*/list ([x (in-list vars)]
+               [y (in-list vars)]
+               [sign (in-value (get-interaction-sign network doms x y))]
+               #:unless (eq? sign #f))
+     (list sign x y))))
+
+(module+ test
+  (test-case "build-signed-interaction-graph"
+    (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? (graphviz (build-signed-interaction-graph n-bool bool-doms))
+                  "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 (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-equal? (graphviz (build-signed-interaction-graph n-multi 123-doms))
+                  "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
 ;;; ====================