diff --git a/networks.rkt b/networks.rkt index cc83a18..dabe6f8 100644 --- a/networks.rkt +++ b/networks.rkt @@ -26,7 +26,7 @@ build-all-states build-all-boolean-states build-all-01-states list-syntactic-interactions build-syntactic-interaction-graph - interaction? + interaction? get-interaction-sign ) (define-type (State a) (VariableMapping a)) @@ -362,6 +362,71 @@ (define n2 (network-form->network/any (network-form n-multi 123-doms))) (check-false (interaction? n2 'x 'y)) (check-true (interaction? n2 'y 'x)))) + + (: get-interaction-sign (All (a) (-> (Network a) Variable Variable (Option Integer)))) + (define (get-interaction-sign network x y) + (define doms (network-domains network)) + (define dom-x (hash-ref doms x)) + (define dom-y (hash-ref doms y)) + (define y-func (hash-ref (network-functions network) y)) + (define (collect-impacts-on-y [st : (State a)]) + ;; The way in which the values are ordered in the domains gives + ;; a total order on these values. This means that considering + ;; pairs of consecutive values of x is sufficient for testing the + ;; sign of the interaction. + (define x-states (for/list : (Listof (State a)) + ([x-val (in-list dom-x)]) + (hash-set st x x-val))) + (for/list : (Listof (U '< '> '=)) + ([st1 (in-list x-states)] + [st2 (in-list (cdr x-states))]) + (define y1-idx (assert-type (index-of dom-y (y-func st1)) Index)) + (define y2-idx (assert-type (index-of dom-y (y-func st2)) Index)) + (cond + [(< y1-idx y2-idx) '<] + [(> y1-idx y2-idx) '>] + [else '=]))) + (define states-not-x (build-all-states (hash-remove doms x))) + (define interactions + (remove-duplicates + (for/list : (Listof (U '< '> '= Zero)) + ([st (in-list states-not-x)]) + (define impacts (remove-duplicates (collect-impacts-on-y st))) + (cond + [(and (member '< impacts) (not (member '> impacts))) '<] + [(and (member '> impacts) (not (member '< impacts))) '>] + [(equal? impacts '(=)) '=] + [else 0])))) + (cond + [(and (member '< interactions) (not (member '> interactions))) 1] + [(and (member '> interactions) (not (member '< interactions))) -1] + [(equal? interactions '(=)) #f] + [else 0])) + + (module+ test + (test-case "get-interaction-sign" + (define n1 (forms->boolean-network + (hash 'x '(not y) + 'y 'x + 'z '(and y z) + 't '(or (and (not x) y) + (and x (not y)))))) + (check-equal? (get-interaction-sign n1 'x 'y) 1) + (check-equal? (get-interaction-sign n1 'y 'x) -1) + (check-false (get-interaction-sign n1 'x 'z)) + (check-equal? (get-interaction-sign n1 'y 'z) 1) + (check-equal? (get-interaction-sign n1 'x 't) 0) + (define n-multi (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))) + (define n2 (network-form->network/any (network-form n-multi 123-doms))) + (check-false (get-interaction-sign n2 'x 'y)) + (check-equal? (get-interaction-sign n2 'y 'x) 1) + (check-equal? (get-interaction-sign n2 'y 'z) -1) + (check-equal? (get-interaction-sign n2 'y 't) 0) + (check-equal? (get-interaction-sign n2 'y 'y) 1))) ) (require 'typed) @@ -378,10 +443,7 @@ [struct dynamics ([network network?] [mode mode?])]) ;; Functions - (contract-out [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))] - [build-interaction-graph (-> network? graph?)] - [build-interaction-graph/form (-> network-form? graph?)] - [build-signed-interaction-graph (-> network? graph?)] + (contract-out [build-signed-interaction-graph (-> network? graph?)] [build-signed-interaction-graph/form (-> network-form? graph?)] [make-asyn (-> (listof variable?) mode?)] [make-syn (-> (listof variable?) mode?)] @@ -523,73 +585,6 @@ ;;; Inferring interaction graphs ;;; ============================ -;;; Given two variables x and y of a network f, checks whether they -;;; interact, and if they interact, returns 1 if increasing x leads to -;;; an increase in y, -1 if it leads to a decrease in y, and 0 if it -;;; can lead to both. If x has no impact on y, returns #f. -;;; -;;; Use interaction? if you only need to know whether two variables -;;; interact, because interaction? will be often faster. -(define (get-interaction-sign network x y) - (define doms (network-domains network)) - (define dom-x (hash-ref doms x)) - (define dom-y (hash-ref doms y)) - (define y-func (hash-ref (network-functions network) y)) - (define (collect-impacts-on-y st) - ;; The way in which the values are ordered in the domains gives - ;; a total order on these values. This means that considering - ;; pairs of consecutive values of x is sufficient for testing the - ;; sign of the interaction. - (define x-states (for/list ([x-val (in-list dom-x)]) - (hash-set st x x-val))) - (for/list ([st1 (in-list x-states)] - [st2 (in-list (cdr x-states))]) - (define y1-idx (index-of dom-y (y-func st1))) - (define y2-idx (index-of dom-y (y-func st2))) - (cond - [(< y1-idx y2-idx) '<] - [(> y1-idx y2-idx) '>] - [else '=]))) - (define states-not-x (build-all-states (hash-remove doms x))) - (define interactions - (remove-duplicates - (for/list ([st (in-list states-not-x)]) - (define impacts (remove-duplicates (collect-impacts-on-y st))) - (cond - [(and (member '< impacts) (not (member '> impacts))) '<] - [(and (member '> impacts) (not (member '< impacts))) '>] - [(equal? impacts '(=)) '=] - [else 0])))) - (cond - [(and (member '< interactions) (not (member '> interactions))) 1] - [(and (member '> interactions) (not (member '< interactions))) -1] - [(equal? interactions '(=)) #f] - [else 0])) - -(module+ test - (test-case "get-interaction-sign" - (define n1 (forms->boolean-network - (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y)))))) - (check-equal? (get-interaction-sign n1 'x 'y) 1) - (check-equal? (get-interaction-sign n1 'y 'x) -1) - (check-false (get-interaction-sign n1 'x 'z)) - (check-equal? (get-interaction-sign n1 'y 'z) 1) - (check-equal? (get-interaction-sign n1 'x 't) 0) - (define n-multi (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))) - (define n2 (network-form->network/any (network-form n-multi 123-doms))) - (check-false (get-interaction-sign n2 'x 'y)) - (check-equal? (get-interaction-sign n2 'y 'x) 1) - (check-equal? (get-interaction-sign n2 'y 'z) -1) - (check-equal? (get-interaction-sign n2 'y 't) 0) - (check-equal? (get-interaction-sign n2 'y 'y) 1))) ;;; Given a network, builds its interaction graph. The graph has ;;; variables as nodes and has a directed edge from x to y if diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 33c3704..f6c2557 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -434,6 +434,30 @@ values for @racket[y].} (interaction? bn 'b 'a))) ]} +@defproc[(get-interaction-sign [network (Network a)] + [x Variable] + [y Variable]) + (Option Integer)]{ + +Given two variables @racket[x] and @racket[y] of @racket[network], checks +whether they interact, and if they interact, returns 1 if increasing @racket[x] +leads to an increase in @racket[y], -1 if it leads to a decrease in @racket[y], +and 0 if it can lead to both. If @racket[x] has no impact on @racket[y], returns @racket[#f]. + +The values in the domains are ordered according to the order in which they are +listed in @racket[network]. + +Since @racket[get-interaction-sign] needs to check all possible interactions +between @racket[x] and @racket[y], it is more costly than calling +@racket[interaction?]. + +@ex[ +(let ([bn (forms->boolean-network #hash((a . (and a b)) + (b . (not b))))]) + (values (get-interaction-sign bn 'a 'b) + (get-interaction-sign bn 'b 'a) + (get-interaction-sign bn 'b 'b))) +]} @section{Tabulating functions and networks} @section{Constructing functions and networks}