diff --git a/networks.rkt b/networks.rkt index 6783f58..1f6940b 100644 --- a/networks.rkt +++ b/networks.rkt @@ -37,11 +37,6 @@ [make-01-domains (-> (listof variable?) (hash/c variable? (list/c 0 1)))] [build-all-boolean-states (-> (listof variable?) (listof state?))] [build-all-01-states (-> (listof variable?) (listof state?))] - [get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c '+ '- '0))] - [build-signed-interaction-graph/form (-> network-form? domain-mapping/c graph?)] - [build-boolean-signed-interaction-graph/form (-> network-form? graph?)] - [build-signed-interaction-graph (-> network? domain-mapping/c graph?)] - [build-boolean-signed-interaction-graph (-> network? graph?)] [make-asyn (-> (listof variable?) mode?)] [make-syn (-> (listof variable?) mode?)] [make-dynamics-from-func (-> network? (-> (listof variable?) mode?) dynamics?)] @@ -402,186 +397,6 @@ #hash((a . 1) (b . 0)) #hash((a . 1) (b . 1)))))) -;;; Given two interacting variables of a network and the domains -;;; of the variables, returns '+ if the interaction is monotonously -;;; increasing, '- if it is monotonously decreasing, and '0 otherwise. -;;; -;;; This function does not check whether the two variables indeed -;;; interact. Its behaviour is undefined if the variables do not -;;; interact. -;;; -;;; /!\ This function iterates through almost all of the states of the -;;; network, so its performance decreases very quickly with network -;;; size. -(define (get-interaction-sign network doms x y) - (let* ([dom-x (hash-ref doms x)] - [dom-y (hash-ref doms y)] - ;; Replace the domain of x by a dummy singleton. - [doms-no-x (hash-set doms x '(#f))] - ;; Build all the states, but as if x were not there: since I - ;; replace its domain by a singleton, all states will contain - ;; the same value for x. - [states-no-x (build-all-states doms-no-x)] - ;; Go through all states, then through all ordered pairs of - ;; values of x, generate pairs of states (s1, s2) such that x - ;; has a smaller value in s1, and check that updating y in s1 - ;; yields a smaller value than updating y in s2. I rely on - ;; the fact that the domains are ordered. - [x-y-interactions (for*/list ([s states-no-x] - [x1 dom-x] ; ordered pairs of values of x - [x2 (cdr (member x1 dom-x))]) - (let* ([s1 (hash-set s x x1)] ; s1(x) < s2(x) - [s2 (hash-set s x x2)] - [y1 ((hash-ref network y) s1)] - [y2 ((hash-ref network y) s2)]) - ;; y1 <= y2? - (<= (index-of dom-y y1) (index-of dom-y y2))))]) - (cond - ;; If, in all interactions, y1 <= y2, then we have an - ;; increasing/promoting interaction between x and y. - [(andmap (λ (x) (eq? x #t)) x-y-interactions) '+] - ;; If, in all interactions, y1 > y2, then we have an - ;; decreasing/inhibiting interaction between x and y. - [(andmap (λ (x) (eq? x #f)) x-y-interactions) '-] - ;; Otherwise the interaction is neither increasing nor - ;; decreasing. - [else '0]))) - -(module+ test - (test-case "get-interaction-sign" - (define n #hash((a . (not b)) (b . a))) - (define doms (make-boolean-domains '(a b))) - (check-equal? (get-interaction-sign (network-form->network n) doms 'a 'b) '+) - (check-equal? (get-interaction-sign (network-form->network n) doms 'b 'a) '-))) - -;;; Constructs a signed interaction graph of a given network form, -;;; given the ordered domains of its variables. The order on the -;;; domains determines the signs which will appear on the interaction -;;; graph. -;;; -;;; /!\ This function iterates through almost all states of the -;;; network for every arrow in the unsigned interaction graph, so its -;;; performance decreases very quickly with the size of the network. -(define (build-signed-interaction-graph/form network-form doms) - (let ([ig (build-syntactic-interaction-graph network-form)] - [network (network-form->network network-form)]) - ;; Label every edge of the interaction graph with the sign. - (define sig - (weighted-graph/directed - (for/list ([e (in-edges ig)]) - (match-let ([(list x y) e]) - (list (get-interaction-sign network doms x y) - x y))))) - ;; Ensure that every variable of the network appears in the signed - ;; interaction graph as well. - (for ([v (in-vertices ig)]) - (add-vertex! sig v)) - sig)) - -(module+ test - (test-case "build-signed-interaction-graph/form" - (define n #hash((a . (not b)) (b . a))) - (define doms (make-boolean-domains '(a b))) - (define sig1 (build-signed-interaction-graph/form n doms)) - (check-true (has-vertex? sig1 'a)) - (check-true (has-vertex? sig1 'b)) - (check-false (has-vertex? sig1 'c)) - (check-false (has-edge? sig1 'a 'a)) - (check-true (has-edge? sig1 'b 'a)) - (check-false (has-edge? sig1 'b 'b)) - (check-false (has-edge? sig1 'c 'b)) - (check-false (has-edge? sig1 'c 'a)) - (check-equal? (edge-weight sig1 'a 'b) '+) - (check-equal? (edge-weight sig1 'b 'a) '-))) - -;;; Calls build-signed-interaction-graph with the Boolean domain for -;;; all variable. -;;; -;;; /!\ The same performance warning applies as for -;;; build-signed-interaction-graph. -(define (build-boolean-signed-interaction-graph/form network-form) - (build-signed-interaction-graph/form - network-form - (make-boolean-domains (hash-keys network-form)))) - -(module+ test - (test-case "build-boolean-signed-interaction-graph/form" - (define n #hash((a . (not b)) (b . a))) - (define sig2 (build-boolean-signed-interaction-graph/form n)) - (check-true (has-vertex? sig2 'a)) - (check-true (has-vertex? sig2 'b)) - (check-false (has-vertex? sig2 'c)) - (check-false (has-edge? sig2 'a 'a)) - (check-true (has-edge? sig2 'b 'a)) - (check-false (has-edge? sig2 'b 'b)) - (check-false (has-edge? sig2 'c 'b)) - (check-false (has-edge? sig2 'c 'a)) - (check-equal? (edge-weight sig2 'a 'b) '+) - (check-equal? (edge-weight sig2 'b 'a) '-))) - -;;; Similar to build-signed-interaction-graph/form, but operates on a -;;; network rather than a form. The resulting graph only includes the -;;; edges for positive or negative interactions. -;;; -;;; This function has operates with much less knowledge than -;;; build-signed-interaction-graph/form, so prefer using the latter -;;; when you can get a network form. -;;; -;;; /!\ This function iterates through all states of the network for -;;; every arrow in the unsigned interaction graph, so its performance -;;; decreases very quickly with the size of the network. -(define (build-signed-interaction-graph network doms) - (define sig - (weighted-graph/directed - (for*/fold ([edges '()]) - ([(x _) (in-hash network)] - [(y _) (in-hash network)]) - (match (get-interaction-sign network doms x y) - ['0 edges] - [sign (cons (list sign x y) edges)])))) - ;; Ensure that all variables of the network appear in the signed - ;; interaction graph. - (for ([(v _) (in-hash network)]) - (add-vertex! sig v)) - sig) - -;;; Calls build-signed-interaction-graph assuming that the domains of -;;; all variables are Boolean. -;;; -;;; This function has operates with much less knowledge than -;;; build-boolean-signed-interaction-graph/form, so prefer using the -;;; latter when you can get a network form. -;;; -;;; /!\ This function iterates through all states of the network for -;;; every arrow in the unsigned interaction graph, so its performance -;;; decreases very quickly with the size of the network. -(define (build-boolean-signed-interaction-graph network) - (build-signed-interaction-graph network (make-boolean-domains (hash-keys network)))) - -(module+ test - (test-case "build-signed-interaction-graph, build-boolean-signed-interaction-graph" - (define n #hash((a . (not b)) (b . a))) - (define sig3 (build-boolean-signed-interaction-graph (network-form->network n))) - (check-true (has-vertex? sig3 'a)) - (check-true (has-vertex? sig3 'b)) - (check-equal? (edge-weight sig3 'a 'a) '+) - (check-equal? (edge-weight sig3 'b 'b) '+) - (check-equal? (edge-weight sig3 'a 'b) '+) - (check-equal? (edge-weight sig3 'b 'a) '-))) - -;;; Interaction graphs for networks without interactions must still -;;; contain all nodes. -(module+ test - (test-case "Interaction must graphs always contain all nodes." - (define n #hash((a . #t) (b . #t))) - (define ig (build-syntactic-interaction-graph n)) - (define sig-nf (build-boolean-signed-interaction-graph/form n)) - (define sig (build-boolean-signed-interaction-graph (network-form->network n))) - (check-equal? (get-vertices ig) '(b a)) - (check-true (empty? (get-edges ig))) - (check-equal? (get-vertices sig-nf) '(b a)) - (check-true (empty? (get-edges sig-nf))) - (check-equal? (get-vertices sig) '(b a)))) ;;; ====================