networks: Add build-interaction-graph.

This commit is contained in:
Sergiu Ivanov 2020-02-20 15:56:48 +01:00
parent cd714773be
commit 038e543eff
2 changed files with 25 additions and 6 deletions

View file

@ -2,7 +2,7 @@
;;; Tests for dds/networks. ;;; Tests for dds/networks.
(require rackunit "networks.rkt") (require rackunit graph "networks.rkt")
;;; This test case sets up the following Boolean network: ;;; This test case sets up the following Boolean network:
;;; x1 = x1 AND NOT x2 ;;; x1 = x1 AND NOT x2
@ -46,7 +46,16 @@
(check-equal? ((hash-ref bn3 'a) s) #t))) (check-equal? ((hash-ref bn3 'a) s) #t)))
(test-case "Inferring interaction graphs" (test-case "Inferring interaction graphs"
(let ([n #hash((a . (+ a b c)) (let* ([n #hash((a . (+ a b c))
(b . (- 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 '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))))

View file

@ -10,7 +10,7 @@
;;; This model can generalise Boolean networks, TBANs, multivalued ;;; This model can generalise Boolean networks, TBANs, multivalued
;;; networks, etc. ;;; networks, etc.
(require "utils.rkt") (require "utils.rkt" graph)
(provide (provide
;; Functions ;; Functions
@ -21,7 +21,8 @@
[network-form->network (-> network-form? network?)] [network-form->network (-> network-form? network?)]
[make-network-from-forms (-> (listof (cons/c symbol? update-function-form?)) [make-network-from-forms (-> (listof (cons/c symbol? update-function-form?))
network?)] network?)]
[list-interactions (-> network-form? variable? (listof variable?))]) [list-interactions (-> network-form? variable? (listof variable?))]
[build-interaction-graph (-> network-form? graph?)])
;; Predicates ;; Predicates
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
@ -129,3 +130,12 @@
(set-intersect (set-intersect
(extract-symbols (hash-ref nf x)) (extract-symbols (hash-ref nf x))
(hash-keys nf))) (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)))))))