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)))))))