From 038e543eff8b2273947408749e23f16143b20ea5 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Thu, 20 Feb 2020 15:56:48 +0100
Subject: [PATCH] networks: Add build-interaction-graph.

---
 networks-tests.rkt | 17 +++++++++++++----
 networks.rkt       | 14 ++++++++++++--
 2 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/networks-tests.rkt b/networks-tests.rkt
index ec9e563..86d3c2b 100644
--- a/networks-tests.rkt
+++ b/networks-tests.rkt
@@ -2,7 +2,7 @@
 
 ;;; Tests for dds/networks.
 
-(require rackunit "networks.rkt")
+(require rackunit graph "networks.rkt")
 
 ;;; This test case sets up the following Boolean network:
 ;;; x1 = x1 AND NOT x2
@@ -46,7 +46,16 @@
     (check-equal? ((hash-ref bn3 'a) s) #t)))
 
 (test-case "Inferring interaction graphs"
-  (let ([n #hash((a . (+ a b c))
-                 (b . (- b c)))])
+  (let* ([n #hash((a . (+ a b c))
+                  (b . (- b c)))]
+         [ig (build-interaction-graph n)])
     (check-true (set=? (list-interactions n 'a) '(a b)))
-    (check-true (set=? (list-interactions n 'b) '(b)))))
+    (check-true (set=? (list-interactions n 'b) '(b)))
+    (check-true (has-vertex? ig 'a))
+    (check-true (has-vertex? ig 'b))
+    (check-false (has-vertex? ig 'c))
+    (check-true (has-edge? ig 'a 'a))
+    (check-true (has-edge? ig 'b 'a))
+    (check-true (has-edge? ig 'b 'b))
+    (check-false (has-edge? ig 'c 'b))
+    (check-false (has-edge? ig 'c 'a))))
diff --git a/networks.rkt b/networks.rkt
index 65b40fd..8b53457 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -10,7 +10,7 @@
 ;;; This model can generalise Boolean networks, TBANs, multivalued
 ;;; networks, etc.
 
-(require "utils.rkt")
+(require "utils.rkt" graph)
 
 (provide
  ;; Functions
@@ -21,7 +21,8 @@
                [network-form->network (-> network-form? network?)]
                [make-network-from-forms (-> (listof (cons/c symbol? update-function-form?))
                                             network?)]
-               [list-interactions (-> network-form? variable? (listof variable?))])
+               [list-interactions (-> network-form? variable? (listof variable?))]
+               [build-interaction-graph (-> network-form? graph?)])
  ;; Predicates
  (contract-out [variable? (-> any/c boolean?)]
                [state? (-> any/c boolean?)]
@@ -129,3 +130,12 @@
   (set-intersect
    (extract-symbols (hash-ref nf x))
    (hash-keys nf)))
+
+;;; Builds the graph in which the vertices are the variables of a
+;;; given network, and which contains an arrow from a to b whenever a
+;;; appears in (list-interactions a).
+(define (build-interaction-graph n)
+  (transpose
+   (unweighted-graph/adj
+    (hash-map n (λ (var _)
+                  (cons var (list-interactions n var)))))))