From 3e1dca8d63f1d39a863c9002ea6301b3904af98e Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Fri, 1 Jul 2022 00:25:19 +0200 Subject: [PATCH] Type interaction?. --- networks.rkt | 81 ++++++++++++++++++++------------------ scribblings/networks.scrbl | 22 +++++++++++ 2 files changed, 64 insertions(+), 39 deletions(-) diff --git a/networks.rkt b/networks.rkt index 056efac..cc83a18 100644 --- a/networks.rkt +++ b/networks.rkt @@ -26,6 +26,7 @@ build-all-states build-all-boolean-states build-all-01-states list-syntactic-interactions build-syntactic-interaction-graph + interaction? ) (define-type (State a) (VariableMapping a)) @@ -321,6 +322,46 @@ (check-true (has-edge? ig 'b 'b)) (check-false (has-edge? ig 'c 'b)) (check-false (has-edge? ig 'c 'a)))) + + (: interaction? (All (a) (-> (Network a) Variable Variable Boolean))) + (define (interaction? network x y) + (define doms (network-domains network)) + (define states-not-x (build-all-states (hash-remove doms x))) + (define dom-x (hash-ref doms x)) + (define y-func (hash-ref (network-functions network) y)) + (: different-ys-exist? (-> (State a) Boolean)) + (define (different-ys-exist? st) + (define x-states (for/list ([x-val (in-list dom-x)]) + : (Listof (State a)) + (hash-set st x x-val))) + ;; TODO: Replace with for*/first when/if it is fixed. + (for*/first/typed : (Option Boolean) + ([st1 : (State a) x-states] + [st2 : (State a) x-states] + #:unless (equal? (hash-ref st1 x) (hash-ref st2 x)) + #:unless (equal? (y-func st1) (y-func st2))) + #t)) + ;; TODO: Replace with for/first when/if it is fixed. + (for/first/typed : (Option Boolean) + ([st (in-list states-not-x)] + #:when (different-ys-exist? st)) + #t)) + + (module+ test + (test-case "interaction?" + (define n1 (forms->boolean-network + (hash 'x '(not y) + 'y 'x + 'z '(and y z)))) + (check-true (interaction? n1 'x 'y)) + (check-true (interaction? n1 'y 'x)) + (check-false (interaction? n1 'x 'z)) + (define n-multi (hash 'x '(max (+ y 1) 2) + 'y '(min (- y 1) 0))) + (define 123-doms (make-same-domains '(x y) '(0 1 2))) + (define n2 (network-form->network/any (network-form n-multi 123-doms))) + (check-false (interaction? n2 'x 'y)) + (check-true (interaction? n2 'y 'x)))) ) (require 'typed) @@ -337,8 +378,7 @@ [struct dynamics ([network network?] [mode mode?])]) ;; Functions - (contract-out [interaction? (-> network? variable? variable? boolean?)] - [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))] + (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?)] @@ -483,43 +523,6 @@ ;;; Inferring interaction graphs ;;; ============================ -;;; Given two variables x and y of a network f, verifies if they -;;; interact, i.e. that there exists such a state s with the property -;;; that s' which is s with a different value for x yields such a new -;;; state f(s') in which the value for y is different from f(s). -(define (interaction? network x y) - (define doms (network-domains network)) - (define states-not-x (build-all-states (hash-remove doms x))) - (define dom-x (hash-ref doms x)) - (define y-func (hash-ref (network-functions network) y)) - (define (different-ys-exist? st) - (define x-states (for/list ([x-val (in-list dom-x)]) - (hash-set st x x-val))) - (for*/first ([st1 x-states] - [st2 x-states] - #:unless (equal? (hash-ref st1 x) (hash-ref st2 x)) - #:unless (equal? (y-func st1) (y-func st2))) - #t)) - (for*/first ([st (in-list states-not-x)] - #:when (different-ys-exist? st)) - #t)) - -(module+ test - (test-case "interaction?" - (define n1 (forms->boolean-network - (hash 'x '(not y) - 'y 'x - 'z '(and y z)))) - (check-true (interaction? n1 'x 'y)) - (check-true (interaction? n1 'y 'x)) - (check-false (interaction? n1 'x 'z)) - (define n-multi (hash 'x '(max (+ y 1) 2) - 'y '(min (- y 1) 0))) - (define 123-doms (make-same-domains '(x y) '(0 1 2))) - (define n2 (network-form->network/any (network-form n-multi 123-doms))) - (check-false (interaction? n2 'x 'y)) - (check-true (interaction? n2 'y 'x)))) - ;;; 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 diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 36d42b6..33c3704 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -412,6 +412,28 @@ appears in @racket[(list-interactions y)]. (b . (- b)))))) ]} +@defproc[(interaction? [network (Network a)] + [x Variable] + [y Variable]) + Boolean]{ + +Given two variables @racket[x] and @racket[y] of a @racket[network], verifies +if they interact, i.e. that there exists a pair of states @italic{s} and +@italic{s'} with the following properties: + +@itemlist[ +@item{@italic{s} and @italic{s'} only differ in the value of @racket[x];} +@item{running the network from @italic{s} and @italic{s'} yields different +values for @racket[y].} +] + +@ex[ +(let ([bn (forms->boolean-network #hash((a . (and a b)) + (b . (not b))))]) + (values (interaction? bn 'a 'b) + (interaction? bn 'b 'a))) +]} + @section{Tabulating functions and networks} @section{Constructing functions and networks}