From a3ac1c7fcd94c0458f770c41196e5625efbca6fd Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 21 Nov 2020 22:53:45 +0100 Subject: [PATCH 01/46] networks: Include domains into the network. This change is breaking. The following commits will progressively fix the whole network module. --- networks.rkt | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/networks.rkt b/networks.rkt index 5f59387..951a4b8 100644 --- a/networks.rkt +++ b/networks.rkt @@ -18,7 +18,9 @@ (contract-out [struct tbf/state ([weights (hash/c variable? number?)] [threshold number?])] [struct dynamics ([network network?] - [mode mode?])]) + [mode mode?])] + [struct network ([functions (hash/c variable? procedure?)] + [domains domain-mapping/c])]) ;; Functions (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] @@ -173,13 +175,10 @@ ;;; state. (define update-function/c (-> state? any/c)) -;;; A network is a mapping from its variables to its update functions. -;;; -;;; Note that the domains of the variables of the network are not part -;;; of the network definition. This is because the variables of some -;;; networks may have infinite domains, which can be restricted in -;;; multiple different ways. -(define network? (hash/c variable? procedure?)) +;;; A network consists of a mapping from its variables to its update +;;; variables, as a well as of a mapping from its variables to +;;; their domains. +(struct network (functions domains)) ;;; Given a state s updates all the variables from xs. (define (update network s xs) From a654ac58963c3eb50fdb290efbd087a976d8e617 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 21 Nov 2020 23:13:50 +0100 Subject: [PATCH 02/46] network: Remove make-network-from-forms. --- networks.rkt | 4 ---- 1 file changed, 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 951a4b8..0be4950 100644 --- a/networks.rkt +++ b/networks.rkt @@ -26,7 +26,6 @@ [make-state (-> (listof (cons/c symbol? any/c)) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] [booleanize-state (-> state? state?)] - [make-network-from-functions (-> (listof (cons/c symbol? update-function/c)) network?)] [update-function-form->update-function (-> update-function-form? update-function/c)] [network-form->network (-> network-form? network?)] [make-network-from-forms (-> (listof (cons/c symbol? update-function-form?)) @@ -228,9 +227,6 @@ (define (booleanize-state s) (for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)]))) -;;; A version of make-immutable-hash restricted to creating networks. -(define (make-network-from-functions funcs) (make-immutable-hash funcs)) - ;;; ================================= ;;; Syntactic description of networks From 6560dcbe6ce37dcd57e0f6515b8ec3bbaec16fb0 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 21 Nov 2020 23:15:17 +0100 Subject: [PATCH 03/46] networks: Move booleanize-state before its own test case. --- networks.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 0be4950..0dda5cb 100644 --- a/networks.rkt +++ b/networks.rkt @@ -216,6 +216,10 @@ [(cons var 0) (cons var #f)] [(cons var 1) (cons var #t)])))) +;;; Booleanizes a given state: replaces 0 with #f and 1 with #t. +(define (booleanize-state s) + (for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)]))) + (module+ test (test-case "make-state, make-state-booleanize, booleanize-state" (check-equal? (make-state-booleanize '((a . 0) (b . 1))) @@ -223,10 +227,6 @@ (check-equal? (booleanize-state (make-state '((a . 0) (b . 1)))) (make-state '((a . #f) (b . #t)))))) -;;; Booleanizes a given state: replaces 0 with #f and 1 with #t. -(define (booleanize-state s) - (for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)]))) - ;;; ================================= ;;; Syntactic description of networks From 11d75bcc8934d206e7cdc77975638f9ffcc59881 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 21 Nov 2020 23:28:30 +0100 Subject: [PATCH 04/46] networks: Rewrite update. --- networks.rkt | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 0dda5cb..7f8850f 100644 --- a/networks.rkt +++ b/networks.rkt @@ -181,10 +181,9 @@ ;;; Given a state s updates all the variables from xs. (define (update network s xs) - (for/fold ([new-s s]) - ([x xs]) - (let ([f (hash-ref network x)]) - (hash-set new-s x (f s))))) + (define funcs (network-functions network)) + (for/hash ([x xs]) + (x ((hash-ref funcs x) s)))) (module+ test (test-case "basic definitions" From cfe710e6b2200cafdd85aaeb73dbebaeb726acad Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 00:08:46 +0100 Subject: [PATCH 05/46] network: Don't use make-network-from-functions in basic definitions. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 7f8850f..344fc53 100644 --- a/networks.rkt +++ b/networks.rkt @@ -192,7 +192,7 @@ (and x1 (not x2))))) (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) (not x2)))) - (define bn (make-network-from-functions `((x1 . ,f1) (x2 . ,f2)))) + (define bn (hash 'x1 f1 'x2 f2)) (define s1 (make-state '((x1 . #t) (x2 . #f)))) (define new-s1 (update bn s1 '(x2 x1))) (define s2 (make-state '((x1 . #f) (x2 . #f)))) From ed03015e8181856da5189a1635c95e0e2f06e3ff Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 00:22:44 +0100 Subject: [PATCH 06/46] network: Add domains to network-form. --- networks.rkt | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 344fc53..447c187 100644 --- a/networks.rkt +++ b/networks.rkt @@ -20,7 +20,9 @@ [struct dynamics ([network network?] [mode mode?])] [struct network ([functions (hash/c variable? procedure?)] - [domains domain-mapping/c])]) + [domains domain-mapping/c])] + [struct network-form ([forms variable-mapping?] + [domains domain-mapping/c])]) ;; Functions (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] @@ -236,9 +238,10 @@ ;;; '(and x y (not z)) or '(+ 1 a (- b 10)). (define update-function-form? any/c) -;;; A Boolean network form is a mapping from its variables to the -;;; forms of their update functions. -(define network-form? variable-mapping?) +;;; A network form consists of a mapping from variables to the forms +;;; of their update functions, together with a mapping from its +;;; variables to its update functions. +(struct network-form (forms domains)) ;;; Build an update function from an update function form. (define (update-function-form->update-function form) From 236dca704d9d7918e7dd22a391198d1cdf2e281d Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 00:25:46 +0100 Subject: [PATCH 07/46] networks: Update network-form->network. --- networks.rkt | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/networks.rkt b/networks.rkt index 447c187..cb909f3 100644 --- a/networks.rkt +++ b/networks.rkt @@ -254,16 +254,21 @@ (check-equal? (f s) #f))) ;;; Build a network from a network form. -(define (network-form->network bnf) - (for/hash ([(x form) bnf]) - (values x (update-function-form->update-function form)))) +(define (network-form->network nf) + (network + (for/hash ([(x form) (in-hash (network-form-forms nf))]) + (values x (update-function-form->update-function form))) + (network-form-domains nf))) (module+ test (test-case "network-form->network" (define bn (network-form->network - (make-hash '((a . (and a b)) (b . (not b)))))) + (network-form (hash 'a '(and a b) + 'b '(not b)) + (hash 'a (#f #t) + 'b (#f #t))))) (define s (make-state '((a . #t) (b . #t)))) - (check-equal? ((hash-ref bn 'a) s) #t))) + (check-equal? ((hash-ref (network-functions bn) 'a) s) #t))) ;;; Build a network from a list of pairs of forms of update functions. (define (make-network-from-forms forms) From b8f29d905d5aedaf64f61f139549f1261613168e Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 00:29:36 +0100 Subject: [PATCH 08/46] networks: Remove make-network-from-forms. --- networks.rkt | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/networks.rkt b/networks.rkt index cb909f3..b75c140 100644 --- a/networks.rkt +++ b/networks.rkt @@ -30,8 +30,6 @@ [booleanize-state (-> state? state?)] [update-function-form->update-function (-> update-function-form? update-function/c)] [network-form->network (-> network-form? network?)] - [make-network-from-forms (-> (listof (cons/c symbol? update-function-form?)) - network?)] [list-syntactic-interactions (-> network-form? variable? (listof variable?))] [build-syntactic-interaction-graph (-> network-form? graph?)] [interaction? (-> network? domain-mapping/c variable? variable? boolean?)] @@ -270,17 +268,6 @@ (define s (make-state '((a . #t) (b . #t)))) (check-equal? ((hash-ref (network-functions bn) 'a) s) #t))) -;;; Build a network from a list of pairs of forms of update functions. -(define (make-network-from-forms forms) - (network-form->network (make-immutable-hash forms))) - -(module+ test - (test-case "make-network-from-forms" - (define bn (make-network-from-forms '((a . (and a b)) - (b . (not b))))) - (define s (make-state '((a . #t) (b . #t)))) - (check-equal? ((hash-ref bn 'a) s) #t))) - ;;; ============================ ;;; Inferring interaction graphs From cb208a66fc2c47c400fef77fdfb8a45cba84c102 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 20:42:30 +0100 Subject: [PATCH 09/46] networks: Add one more comment on syntactic IG vs. IG. --- networks.rkt | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/networks.rkt b/networks.rkt index b75c140..28c5d64 100644 --- a/networks.rkt +++ b/networks.rkt @@ -278,6 +278,15 @@ ;;; graphs is based on analysing the dynamics of the networks, it may ;;; be quite resource-consuming, especially since I allow any ;;; syntactic forms in the definitions of the functions. +;;; +;;; Note the fine difference between syntactic interaction graphs and +;;; interaction graphs generated from the dynamics of the network. +;;; The syntactic interaction graphs are based on the whether +;;; a variable appears or not in the form of the function for another +;;; variable. On the other hand, the normal, conventional interaction +;;; graph records the fact that one variable has an impact on the +;;; dynamics of the other variable. Depending on the model, these may +;;; or may not be the same. ;;; Lists the variables of the network form appearing in the update ;;; function form for x. From 393f1d2bba8b8d7c90f846e891f34d163e8dea18 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 20:46:53 +0100 Subject: [PATCH 10/46] networks: Move domain-mapping/c to Basic definitions. --- networks.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 28c5d64..5765165 100644 --- a/networks.rkt +++ b/networks.rkt @@ -174,6 +174,10 @@ ;;; state. (define update-function/c (-> state? any/c)) +;;; A domain mapping is a hash set mapping variables to the lists of +;;; values in their domains. +(define domain-mapping/c (hash/c variable? list?)) + ;;; A network consists of a mapping from its variables to its update ;;; variables, as a well as of a mapping from its variables to ;;; their domains. @@ -334,10 +338,6 @@ (check-false (has-edge? ig 'c 'b)) (check-false (has-edge? ig 'c 'a)))) -;;; A domain mapping is a hash set mapping variables to the lists of -;;; values in their domains. -(define domain-mapping/c (hash/c variable? list?)) - ;;; Given a hash-set mapping variables to generic sets of their ;;; possible values, constructs the list of all possible states. (define (build-all-states vars-domains) From 6fd3d41c7e4d336b90fc885c850a8168cc863d60 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:06:33 +0100 Subject: [PATCH 11/46] networks: Update the IG-related functions. IG = interaction graph --- networks.rkt | 160 ++++++++++++++++++++++++++------------------------- 1 file changed, 81 insertions(+), 79 deletions(-) diff --git a/networks.rkt b/networks.rkt index 5765165..a7ffd70 100644 --- a/networks.rkt +++ b/networks.rkt @@ -32,12 +32,12 @@ [network-form->network (-> network-form? network?)] [list-syntactic-interactions (-> network-form? variable? (listof variable?))] [build-syntactic-interaction-graph (-> network-form? graph?)] - [interaction? (-> network? domain-mapping/c variable? variable? boolean?)] - [get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))] - [build-interaction-graph (-> network? domain-mapping/c graph?)] - [build-interaction-graph/form (-> network-form? domain-mapping/c graph?)] - [build-signed-interaction-graph (-> network? domain-mapping/c graph?)] - [build-signed-interaction-graph/form (-> network-form? domain-mapping/c graph?)] + [interaction? (-> network? variable? variable? boolean?)] + [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?)] + [build-signed-interaction-graph/form (-> network-form? graph?)] [build-all-states (-> domain-mapping/c (listof state?))] [make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)] [make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))] @@ -410,10 +410,11 @@ ;;; 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 doms x y) +(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 y)) + (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))) @@ -428,20 +429,20 @@ (module+ test (test-case "interaction?" - (define n-bool (network-form->network - (hash 'x '(not y) - 'y 'x - 'z '(and y z)))) + (define n-bool (hash 'x '(not y) + 'y 'x + 'z '(and y z))) (define bool-doms (make-boolean-domains '(x y z))) - (check-true (interaction? n-bool bool-doms 'x 'y)) - (check-true (interaction? n-bool bool-doms 'y 'x)) - (check-false (interaction? n-bool bool-doms 'x 'z)) - (define n-multi (network-form->network - (hash 'x '(max (+ y 1) 2) - 'y '(min (- y 1) 0)))) + (define n1 (network-form->network (network-form n-bool bool-doms))) + (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))) - (check-false (interaction? n-multi 123-doms 'x 'y)) - (check-true (interaction? n-multi 123-doms 'y 'x)))) + (define n2 (network-form->network (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 @@ -450,10 +451,11 @@ ;;; ;;; Use interaction? if you only need to know whether two variables ;;; interact, because interaction? will be often faster. -(define (get-interaction-sign network doms x y) +(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 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 @@ -487,45 +489,45 @@ (module+ test (test-case "get-interaction-sign" - (define n-bool (network-form->network - (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y)))))) + (define n-bool (hash 'x '(not y) + 'y 'x + 'z '(and y z) + 't '(or (and (not x) y) + (and x (not y))))) (define bool-doms (make-boolean-domains '(x y z t))) - (check-equal? (get-interaction-sign n-bool bool-doms 'x 'y) 1) - (check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1) - (check-false (get-interaction-sign n-bool bool-doms 'x 'z)) - (check-equal? (get-interaction-sign n-bool bool-doms 'y 'z) 1) - (check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0) - (define n-multi (network-form->network - (hash 'x '(min (+ y 1) 2) - 'y '(max (- y 1) 0) - 'z '(- 2 y) - 't '(abs (- y 1))))) + (define n1 (network-form->network (network-form n-bool bool-doms))) + (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))) - (check-false (get-interaction-sign n-multi 123-doms 'x 'y)) - (check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1) - (check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1) - (check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0) - (check-equal? (get-interaction-sign n-multi 123-doms 'y 'y) 1))) + (define n2 (network-form->network (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 ;;; interaction? returns #t for these variables, in this order. -(define (build-interaction-graph network doms) - (define vars (hash-keys network)) +(define (build-interaction-graph network) + (define vars (hash-keys (network-functions network))) (unweighted-graph/directed (for*/list ([x (in-list vars)] [y (in-list vars)] - #:when (interaction? network doms x y)) + #:when (interaction? network x y)) (list x y)))) ;;; Like build-interaction-graph, but accepts a network form and ;;; converts it a to a network. -(define (build-interaction-graph/form form doms) - (build-interaction-graph (network-form->network form) doms)) +(define build-interaction-graph/form + (compose build-interaction-graph network-form->network)) (module+ test (test-case "build-interaction-graph" @@ -533,41 +535,41 @@ [skip-expensive-tests? (displayln "Skipping test case build-interaction-graph.")] [else - (define n-bool - (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y))))) + (define n-bool (hash 'x '(not y) + 'y 'x + 'z '(and y z) + 't '(or (and (not x) y) + (and x (not y))))) (define bool-doms (make-boolean-domains '(x y z t))) - (check-equal? (graphviz (build-interaction-graph/form n-bool bool-doms)) + (define n1 (network-form->network (network-form n-bool bool-doms))) + (check-equal? (graphviz (build-interaction-graph/form n1)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node1;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t\tnode2 -> node3;\n\t}\n}\n") - (define n-multi - (hash 'x '(min (+ y 1) 2) - 'y '(max (- y 1) 0) - 'z '(- 2 y) - 't '(abs (- y 1)))) + (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))) - (check-equal? (graphviz (build-interaction-graph/form n-multi 123-doms)) + (define n2 (network-form->network (network-form n-multi 123-doms))) + (check-equal? (graphviz (build-interaction-graph/form n2)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t}\n}\n")]))) ;;; Given a network, builds its signed interaction graph. The graph ;;; has variables as nodes and has a directed edge from x to ;;; y labelled by the value get-interaction-sign for these variables, ;;; in that order, unless this value is #f. -(define (build-signed-interaction-graph network doms) - (define vars (hash-keys network)) +(define (build-signed-interaction-graph network) + (define vars (hash-keys (network-functions network))) (weighted-graph/directed (for*/list ([x (in-list vars)] [y (in-list vars)] - [sign (in-value (get-interaction-sign network doms x y))] + [sign (in-value (get-interaction-sign network x y))] #:unless (eq? sign #f)) (list sign x y)))) ;;; Like build-signed-interaction-graph, but takes a network form and ;;; converts it a to a network. -(define (build-signed-interaction-graph/form form doms) - (build-signed-interaction-graph (network-form->network form) doms)) +(define build-signed-interaction-graph/form + (compose build-signed-interaction-graph network-form->network)) (module+ test (test-case "build-signed-interaction-graph" @@ -575,22 +577,22 @@ [skip-expensive-tests? (displayln "Skipping test case build-signed-interaction-graph.")] [else - (define n-bool - (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y))))) + (define n-bool (hash 'x '(not y) + 'y 'x + 'z '(and y z) + 't '(or (and (not x) y) + (and x (not y))))) (define bool-doms (make-boolean-domains '(x y z t))) - (check-equal? (graphviz (build-signed-interaction-graph/form n-bool bool-doms)) + (define n1 (network-form->network (network-form n-bool bool-doms))) + (check-equal? (graphviz (build-signed-interaction-graph/form n1)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode1 -> node1 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode2 -> node3 [label=\"0\"];\n\t\tnode2 -> node0 [label=\"1\"];\n\t}\n}\n") - (define n-multi - (hash 'x '(min (+ y 1) 2) - 'y '(max (- y 1) 0) - 'z '(- 2 y) - 't '(abs (- y 1)))) + (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))) - (check-equal? (graphviz (build-signed-interaction-graph/form n-multi 123-doms)) + (define n2 (network-form->network (network-form n-multi 123-doms))) + (check-equal? (graphviz (build-signed-interaction-graph/form n2)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"-1\"];\n\t}\n}\n")]))) ;;; ==================== From d5e1819fff0feaf23587e41778c07ffec0466a67 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:13:37 +0100 Subject: [PATCH 12/46] networks: Add make-boolean-network. --- networks.rkt | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index a7ffd70..bf8bb74 100644 --- a/networks.rkt +++ b/networks.rkt @@ -24,7 +24,8 @@ [struct network-form ([forms variable-mapping?] [domains domain-mapping/c])]) ;; Functions - (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] + (contract-out [make-boolean-network (-> (hash/c variable? procedure?) network?)] + [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] [booleanize-state (-> state? state?)] @@ -183,6 +184,21 @@ ;;; their domains. (struct network (functions domains)) +;;; Builds a network from a given hash table assigning functions to +;;; variables by attributing Boolean domains to every variable. +(define (make-boolean-network funcs) + (network funcs (make-boolean-domains (hash-keys funcs)))) + +(module+ test + (test-case "make-boolean-network" + (define f1 (λ (s) (let ([x1 (hash-ref s 'x1)] + [x2 (hash-ref s 'x2)]) + (and x1 (not x2))))) + (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) + (not x2)))) + (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) + (check-equal? (hash 'x1 '(#f #t) 'x2 '(#f #t))))) + ;;; Given a state s updates all the variables from xs. (define (update network s xs) (define funcs (network-functions network)) @@ -196,7 +212,7 @@ (and x1 (not x2))))) (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) (not x2)))) - (define bn (hash 'x1 f1 'x2 f2)) + (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) (define s1 (make-state '((x1 . #t) (x2 . #f)))) (define new-s1 (update bn s1 '(x2 x1))) (define s2 (make-state '((x1 . #f) (x2 . #f)))) From a4979d9c9f8f01472694bdffc402684c8900607b Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:18:22 +0100 Subject: [PATCH 13/46] networks: Add make-boolean-network-form. --- networks.rkt | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/networks.rkt b/networks.rkt index bf8bb74..82be953 100644 --- a/networks.rkt +++ b/networks.rkt @@ -31,6 +31,7 @@ [booleanize-state (-> state? state?)] [update-function-form->update-function (-> update-function-form? update-function/c)] [network-form->network (-> network-form? network?)] + [make-boolean-network-form (-> variable-mapping? network-form?)] [list-syntactic-interactions (-> network-form? variable? (listof variable?))] [build-syntactic-interaction-graph (-> network-form? graph?)] [interaction? (-> network? variable? variable? boolean?)] @@ -288,6 +289,16 @@ (define s (make-state '((a . #t) (b . #t)))) (check-equal? ((hash-ref (network-functions bn) 'a) s) #t))) +;;; Build a Boolean network form from a given mapping assigning forms +;;; to variables. +(define (make-boolean-network-form forms) + (network-form forms (make-boolean-domains (hash-keys forms)))) + +(module+ test + (test-case "make-boolean-network-form" + (make-boolean-network-form (hash 'a '(and a b) + 'b '(not b))))) + ;;; ============================ ;;; Inferring interaction graphs From ec3c74b5e273df362938cdada85949479cd66d5f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:21:31 +0100 Subject: [PATCH 14/46] networks: Add forms->boolean-network. --- networks.rkt | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/networks.rkt b/networks.rkt index 82be953..9d8e78f 100644 --- a/networks.rkt +++ b/networks.rkt @@ -32,6 +32,7 @@ [update-function-form->update-function (-> update-function-form? update-function/c)] [network-form->network (-> network-form? network?)] [make-boolean-network-form (-> variable-mapping? network-form?)] + [forms->boolean-network (-> variable-mapping? network?)] [list-syntactic-interactions (-> network-form? variable? (listof variable?))] [build-syntactic-interaction-graph (-> network-form? graph?)] [interaction? (-> network? variable? variable? boolean?)] @@ -299,6 +300,18 @@ (make-boolean-network-form (hash 'a '(and a b) 'b '(not b))))) +;;; Build a Boolean network from a given mapping assigning forms +;;; to variables. +(define forms->boolean-network + (compose network-form->network make-boolean-network-form)) + +(module+ test + (test-case "forms->boolean-network" + (define n (forms->boolean-network (hash 'a '(and a b) + 'b '(not b)))) + (check-equal? (network-domains n) (hash 'a '(#f #t) + 'b '(#f #t))))) + ;;; ============================ ;;; Inferring interaction graphs From 3e35b8e0abd866fe36ce8d1c1d35a8a198d27ca5 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:24:05 +0100 Subject: [PATCH 15/46] networks, IG: Use forms->boolean-network. IG = interaction graph --- networks.rkt | 48 ++++++++++++++++++++++-------------------------- 1 file changed, 22 insertions(+), 26 deletions(-) diff --git a/networks.rkt b/networks.rkt index 9d8e78f..93fa991 100644 --- a/networks.rkt +++ b/networks.rkt @@ -469,11 +469,10 @@ (module+ test (test-case "interaction?" - (define n-bool (hash 'x '(not y) - 'y 'x - 'z '(and y z))) - (define bool-doms (make-boolean-domains '(x y z))) - (define n1 (network-form->network (network-form n-bool bool-doms))) + (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)) @@ -529,13 +528,12 @@ (module+ test (test-case "get-interaction-sign" - (define n-bool (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y))))) - (define bool-doms (make-boolean-domains '(x y z t))) - (define n1 (network-form->network (network-form n-bool bool-doms))) + (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)) @@ -575,13 +573,12 @@ [skip-expensive-tests? (displayln "Skipping test case build-interaction-graph.")] [else - (define n-bool (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y))))) - (define bool-doms (make-boolean-domains '(x y z t))) - (define n1 (network-form->network (network-form n-bool bool-doms))) + (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? (graphviz (build-interaction-graph/form n1)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node1;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t\tnode2 -> node3;\n\t}\n}\n") (define n-multi (hash 'x '(min (+ y 1) 2) @@ -617,13 +614,12 @@ [skip-expensive-tests? (displayln "Skipping test case build-signed-interaction-graph.")] [else - (define n-bool (hash 'x '(not y) - 'y 'x - 'z '(and y z) - 't '(or (and (not x) y) - (and x (not y))))) - (define bool-doms (make-boolean-domains '(x y z t))) - (define n1 (network-form->network (network-form n-bool bool-doms))) + (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? (graphviz (build-signed-interaction-graph/form n1)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode1 -> node1 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode2 -> node3 [label=\"0\"];\n\t\tnode2 -> node0 [label=\"1\"];\n\t}\n}\n") (define n-multi (hash 'x '(min (+ y 1) 2) From 27bb25c2010d18d7898753e0e3582da24278346a Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:26:26 +0100 Subject: [PATCH 16/46] networks: Fix signed interaction graphs. --- networks.rkt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/networks.rkt b/networks.rkt index 93fa991..179dcd8 100644 --- a/networks.rkt +++ b/networks.rkt @@ -336,13 +336,13 @@ ;;; function form for x. (define (list-syntactic-interactions nf x) (set-intersect - (extract-symbols (hash-ref nf x)) + (extract-symbols (hash-ref (network-form-forms nf) x)) (hash-keys nf))) (module+ test (test-case "list-syntactic-interactions" - (define n #hash((a . (+ a b c)) - (b . (- b c)))) + (define n (make-boolean-network-form #hash((a . (+ a b c)) + (b . (- b c))))) (check-true (set=? (list-syntactic-interactions n 'a) '(a b))) (check-true (set=? (list-syntactic-interactions n 'b) '(b))))) @@ -366,8 +366,8 @@ (module+ test (test-case "build-syntactic-interaction-graph" - (define n #hash((a . (+ a b c)) - (b . (- b c)))) + (define n (make-boolean-network-form #hash((a . (+ a b c)) + (b . (- b c))))) (define ig (build-syntactic-interaction-graph n)) (check-true (has-vertex? ig 'a)) (check-true (has-vertex? ig 'b)) From 97026a2a42c55654014c79790595dee8152c684e Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:30:50 +0100 Subject: [PATCH 17/46] networks: Say that domain mappings may be empty. --- networks.rkt | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/networks.rkt b/networks.rkt index 179dcd8..3787ce2 100644 --- a/networks.rkt +++ b/networks.rkt @@ -184,6 +184,10 @@ ;;; A network consists of a mapping from its variables to its update ;;; variables, as a well as of a mapping from its variables to ;;; their domains. +;;; +;;; The domain mapping does not have to assign domains to all +;;; variables (e.g., it may be empty), but in this case the functions +;;; which need to know the domains will not work. (struct network (functions domains)) ;;; Builds a network from a given hash table assigning functions to @@ -261,6 +265,10 @@ ;;; A network form consists of a mapping from variables to the forms ;;; of their update functions, together with a mapping from its ;;; variables to its update functions. +;;; +;;; The domain mapping does not have to assign domains to all +;;; variables (e.g., it may be empty), but in this case the functions +;;; which need to know the domains will not work. (struct network-form (forms domains)) ;;; Build an update function from an update function form. From 6cfa66694d9cca182a40000ce32f53aaf878670d Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:33:16 +0100 Subject: [PATCH 18/46] networks: Remove read-org-network-make-asyn and read-org-network-make-syn. I think I initially intended these functions for Boolean networks. I'll see if I add back something similar to these when I will be fixing example.org. --- networks.rkt | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/networks.rkt b/networks.rkt index 3787ce2..4a698ba 100644 --- a/networks.rkt +++ b/networks.rkt @@ -52,8 +52,6 @@ [make-dynamics-from-func (-> network? (-> (listof variable?) mode?) dynamics?)] [make-asyn-dynamics (-> network? dynamics?)] [make-syn-dynamics (-> network? dynamics?)] - [read-org-network-make-asyn (-> string? dynamics?)] - [read-org-network-make-syn (-> string? dynamics?)] [dds-step-one (-> dynamics? state? (set/c state?))] [dds-step-one-annotated (-> dynamics? state? (set/c (cons/c modality? state?)))] [dds-step (-> dynamics? (set/c state? #:kind 'dont-care) (set/c state?))] @@ -698,14 +696,6 @@ (check-equal? (dynamics-network syn) n) (check-equal? (dynamics-mode syn) (set (set 'a 'b))))) -;;; Reads an Org-mode-produced sexp, converts it into a network, and -;;; builds the asyncronous dynamics out of it. -(define read-org-network-make-asyn (compose make-asyn-dynamics network-form->network read-org-variable-mapping)) - -;;; Reads an Org-mode-produced sexp, converts it into a network, and -;;; builds the synchronous dynamics out of it. -(define read-org-network-make-syn (compose make-syn-dynamics network-form->network read-org-variable-mapping)) - ;;; Pretty-prints a state of the network. (define (pretty-print-state s) (string-join (hash-map s (λ (key val) (format "~a:~a" key val)) #t))) From fd651ba4cc9a26bc54a44ca009b1a37fb959a865 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:35:19 +0100 Subject: [PATCH 19/46] network,Dynamics: Fixes. --- networks.rkt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/networks.rkt b/networks.rkt index 4a698ba..cf2bd50 100644 --- a/networks.rkt +++ b/networks.rkt @@ -676,7 +676,7 @@ ;;; Given a network, applies a function for building a mode to its ;;; variables and returns the corresponding network dynamics. (define (make-dynamics-from-func network mode-func) - (dynamics network (mode-func (hash-keys network)))) + (dynamics network (mode-func (hash-keys (network-functions network))))) ;;; Creates the asynchronous dynamics for a given network. (define (make-asyn-dynamics network) @@ -688,7 +688,7 @@ (module+ test (test-case "make-asyn-dynamics, make-syn-dynamics" - (define n (network-form->network #hash((a . (not a)) (b . b)))) + (define n (forms->boolean-network #hash((a . (not a)) (b . b)))) (define asyn (make-asyn-dynamics n)) (define syn (make-syn-dynamics n)) (check-equal? (dynamics-network asyn) n) @@ -748,7 +748,7 @@ (module+ test (test-case "Dynamics of networks" - (define n (network-form->network #hash((a . (not a)) (b . b)))) + (define n (forms->boolean-network #hash((a . (not a)) (b . b)))) (define asyn (make-asyn-dynamics n)) (define syn (make-syn-dynamics n)) (define s (make-state '((a . #t) (b . #f)))) From 3a2453c92e5ae3398447e7bd6a0cbb0721c1fe8f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:41:06 +0100 Subject: [PATCH 20/46] networks: Fix tabulating functions and networks. --- networks.rkt | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/networks.rkt b/networks.rkt index cf2bd50..e4d4f32 100644 --- a/networks.rkt +++ b/networks.rkt @@ -78,10 +78,8 @@ (listof (listof any/c)))] [tabulate-state*/boolean (->* ((non-empty-listof procedure?) (listof variable?)) (#:headers boolean?) (listof (listof any/c)))] - [tabulate-network (->* (network? domain-mapping/c) (#:headers boolean?) + [tabulate-network (->* (network?) (#:headers boolean?) (listof (listof any/c)))] - [tabulate-boolean-network (->* (network?) (#:headers boolean?) - (listof (listof any/c)))] [table->network (->* ((listof (*list/c any/c any/c))) (#:headers boolean?) network?)] [random-function/state (domain-mapping/c generic-set? . -> . procedure?)] [random-boolean-function/state ((listof variable?) . -> . procedure?)] @@ -921,13 +919,13 @@ ;;; network. If headers is #t, prepends a list of variable names and ;;; update functions (f-x, where x is the name of the corresponding ;;; variable) to the result. -(define (tabulate-network network domains #:headers [headers #t]) +(define (tabulate-network network #:headers [headers #t]) ;; I use hash-map with try-order? set to #t to ask the hash table to ;; sort the keys for me. (define-values (vars funcs) (for/lists (l1 l2) - ([pair (hash-map network cons #t)]) + ([pair (hash-map (network-functions network) cons #t)]) (values (car pair) (cdr pair)))) - (define tab (tabulate-state* funcs domains #:headers headers)) + (define tab (tabulate-state* funcs (network-domains network) #:headers headers)) (cond [headers ;; Replace the names of the functions tabulate-state* gave us by @@ -938,17 +936,12 @@ (cons (append (take hdrs (length vars)) fnames) vals)])] [else tab])) -;;; Like tabulate-network, but assumes all the variables are Boolean. -(define (tabulate-boolean-network bn #:headers [headers #t]) - (tabulate-network bn (make-boolean-domains (hash-map bn (λ (x y) x) #t)) - #:headers headers)) - (module+ test - (test-case "tabulate-boolean-network" - (define bn (network-form->network #hash((a . (not a)) (b . b)))) - (check-equal? (tabulate-boolean-network bn) + (test-case "tabulate-network" + (define bn (forms->boolean-network #hash((a . (not a)) (b . b)))) + (check-equal? (tabulate-network bn) '((a b f-a f-b) (#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t))) - (check-equal? (tabulate-boolean-network bn #:headers #f) + (check-equal? (tabulate-network bn #:headers #f) '((#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t))))) From 2c68055818d8baf18d97925cecad436dea279a7a Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:42:41 +0100 Subject: [PATCH 21/46] networks: Fix constructing functions and networks. --- networks.rkt | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/networks.rkt b/networks.rkt index e4d4f32..56b1dfb 100644 --- a/networks.rkt +++ b/networks.rkt @@ -962,6 +962,9 @@ ;;; ;;; This function relies on table->function, so the same caveats ;;; apply. +;;; +;;; This function sets the domain mappings of the network to the empty +;;; hash table. (define (table->network table #:headers [headers #t]) (define n (/ (length (car table)) 2)) ;; Get the variable names from the table or generate them, if @@ -984,7 +987,7 @@ (table->function (for/list ([in st-ins] [o out]) (list in o))))) ;; Construct the network. - (make-network-from-functions (map cons var-names funcs))) + (network (map cons var-names funcs) (hash))) (module+ test (test-case "table->network" @@ -993,8 +996,8 @@ (#f #t #f #t) (#t #f #t #f) (#t #t #t #t)))) - (define f1 (hash-ref n 'x1)) - (define f2 (hash-ref n 'x2)) + (define f1 (hash-ref (network-functions n) 'x1)) + (define f2 (hash-ref (network-functions n) 'x2)) (check-false (f1 (make-state '((x1 . #f) (x2 . #f))))) (check-false (f1 (make-state '((x1 . #f) (x2 . #t))))) From 5475bc5fbfe612aa6c58cf805525983da5d3d00f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:58:00 +0100 Subject: [PATCH 22/46] networks: Fix Random networks. --- networks.rkt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index 56b1dfb..ae0f158 100644 --- a/networks.rkt +++ b/networks.rkt @@ -1048,8 +1048,9 @@ ;;; Generates a random network from the given domain mapping. (define (random-network domains) - (for/hash ([(x x-dom) (in-hash domains)]) - (values x (random-function/state domains x-dom)))) + (network (for/hash ([(x x-dom) (in-hash domains)]) + (values x (random-function/state domains x-dom))) + domains)) ;;; Generates a random Boolean network with the given variables. (define (random-boolean-network vars) From 0085eb964bbdfd1cba31972fc7b5a4e7f05af4a7 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:02:56 +0100 Subject: [PATCH 23/46] networks: Fix make-boolean-network. --- networks.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index ae0f158..9b76583 100644 --- a/networks.rkt +++ b/networks.rkt @@ -1410,8 +1410,8 @@ ;;; Constructs a network from a network form defining a TBN. (define (tbn->network tbn) - (for/hash ([(var tbf) (in-hash tbn)]) - (values var ((curry apply-tbf/state) tbf)))) + (make-boolean-network (for/hash ([(var tbf) (in-hash tbn)]) + (values var ((curry apply-tbf/state) tbf))))) (module+ test (test-case "tbn->network" From e4751c6ed25779461461b5a97f1c57fb6763795b Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:05:41 +0100 Subject: [PATCH 24/46] networks: Don't re-export network-form?. --- networks.rkt | 1 - 1 file changed, 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 9b76583..f987e82 100644 --- a/networks.rkt +++ b/networks.rkt @@ -138,7 +138,6 @@ (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] [update-function-form? (-> any/c boolean?)] - [network-form? (-> any/c boolean?)] [modality? (-> any/c boolean?)] [mode? (-> any/c boolean?)] [sbf/state? (-> any/c boolean?)]) From b38adc89cf7996e9e3ac7afe2ff2b733185b5b10 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:08:45 +0100 Subject: [PATCH 25/46] networks: Don't use tabulate-boolean-network. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index f987e82..9b3ca39 100644 --- a/networks.rkt +++ b/networks.rkt @@ -1034,7 +1034,7 @@ (check-equal? (tabulate-state/boolean f '(x1 x2) #:headers #f) '((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))) (define bn (random-boolean-network/vars 3)) - (check-equal? (tabulate-boolean-network bn) + (check-equal? (tabulate-network bn) '((x0 x1 x2 f-x0 f-x1 f-x2) (#f #f #f #f #t #f) (#f #f #t #t #f #f) From ff6fa2c88b9ff909b545938c108e50cca2a32f57 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:11:25 +0100 Subject: [PATCH 26/46] network: Fix the test for make-boolean-network. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 9b3ca39..bb32b4c 100644 --- a/networks.rkt +++ b/networks.rkt @@ -198,7 +198,7 @@ (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) (not x2)))) (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) - (check-equal? (hash 'x1 '(#f #t) 'x2 '(#f #t))))) + (check-equal? (network-domains bn) (hash 'x1 '(#f #t) 'x2 '(#f #t))))) ;;; Given a state s updates all the variables from xs. (define (update network s xs) From eb3e851a9d9be08d76bfe8b98bb054481315887b Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:38:45 +0100 Subject: [PATCH 27/46] networks: Make network and network-form transparent. --- networks.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index bb32b4c..482cc94 100644 --- a/networks.rkt +++ b/networks.rkt @@ -183,7 +183,7 @@ ;;; The domain mapping does not have to assign domains to all ;;; variables (e.g., it may be empty), but in this case the functions ;;; which need to know the domains will not work. -(struct network (functions domains)) +(struct network (functions domains) #:transparent) ;;; Builds a network from a given hash table assigning functions to ;;; variables by attributing Boolean domains to every variable. @@ -264,7 +264,7 @@ ;;; The domain mapping does not have to assign domains to all ;;; variables (e.g., it may be empty), but in this case the functions ;;; which need to know the domains will not work. -(struct network-form (forms domains)) +(struct network-form (forms domains) #:transparent) ;;; Build an update function from an update function form. (define (update-function-form->update-function form) From 3abf548ac26cb6c536a2b6fe237105f45002949d Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:44:04 +0100 Subject: [PATCH 28/46] networks: Bug in update. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 482cc94..2923a53 100644 --- a/networks.rkt +++ b/networks.rkt @@ -204,7 +204,7 @@ (define (update network s xs) (define funcs (network-functions network)) (for/hash ([x xs]) - (x ((hash-ref funcs x) s)))) + (values x ((hash-ref funcs x) s)))) (module+ test (test-case "basic definitions" From 354fad2b1d8a626b0df6f83d44f0b0317876febe Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:50:29 +0100 Subject: [PATCH 29/46] network: Roll back update to its previous version. I thought I was clever to rewrite update using for/hash, but in fact this new version only included the updated variables in the new state :D --- networks.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index 2923a53..426a91a 100644 --- a/networks.rkt +++ b/networks.rkt @@ -203,8 +203,10 @@ ;;; Given a state s updates all the variables from xs. (define (update network s xs) (define funcs (network-functions network)) - (for/hash ([x xs]) - (values x ((hash-ref funcs x) s)))) + (for/fold ([new-s s]) + ([x xs]) + (define fx (hash-ref funcs x)) + (hash-set new-s x (fx s)))) (module+ test (test-case "basic definitions" From f016fbb0caf3ba81241ac270516e2e6ade42e35f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 22:58:21 +0100 Subject: [PATCH 30/46] networks: Fix the tests for network-form->network. --- networks.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index 426a91a..a59b791 100644 --- a/networks.rkt +++ b/networks.rkt @@ -290,8 +290,8 @@ (define bn (network-form->network (network-form (hash 'a '(and a b) 'b '(not b)) - (hash 'a (#f #t) - 'b (#f #t))))) + (hash 'a '(#f #t) + 'b '(#f #t))))) (define s (make-state '((a . #t) (b . #t)))) (check-equal? ((hash-ref (network-functions bn) 'a) s) #t))) From 0a4035d9f7c249aa54142c47b6103d9c3d1d84c2 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 23:00:26 +0100 Subject: [PATCH 31/46] networks: Fix the tests of make-boolean-network-form. --- networks.rkt | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/networks.rkt b/networks.rkt index a59b791..d093dac 100644 --- a/networks.rkt +++ b/networks.rkt @@ -302,8 +302,11 @@ (module+ test (test-case "make-boolean-network-form" - (make-boolean-network-form (hash 'a '(and a b) - 'b '(not b))))) + (check-equal? (make-boolean-network-form (hash 'a '(and a b) + 'b '(not b))) + (network-form + '#hash((a . (and a b)) (b . (not b))) + '#hash((a . (#f #t)) (b . (#f #t))))))) ;;; Build a Boolean network from a given mapping assigning forms ;;; to variables. From fbd6ded717316a6a6689ca842bf3f665cddccf18 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 23 Nov 2020 23:09:23 +0100 Subject: [PATCH 32/46] networks: Fix list-syntactic-interactions. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index d093dac..646763c 100644 --- a/networks.rkt +++ b/networks.rkt @@ -345,7 +345,7 @@ (define (list-syntactic-interactions nf x) (set-intersect (extract-symbols (hash-ref (network-form-forms nf) x)) - (hash-keys nf))) + (hash-keys (network-form-forms nf)))) (module+ test (test-case "list-syntactic-interactions" From 34ceccc446374610e91b8a269bd483dab242eb04 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 23 Nov 2020 23:16:11 +0100 Subject: [PATCH 33/46] networks: Fix build-syntactic-interaction-graph. --- networks.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 646763c..13ad415 100644 --- a/networks.rkt +++ b/networks.rkt @@ -370,7 +370,8 @@ (define (build-syntactic-interaction-graph n) (transpose (unweighted-graph/adj - (for/list ([(var _) n]) (cons var (list-syntactic-interactions n var)))))) + (for/list ([(var _) (in-hash (network-form-forms n))]) + (cons var (list-syntactic-interactions n var)))))) (module+ test (test-case "build-syntactic-interaction-graph" From a074258b1aaf9fe54fb865a22cb5e8d00fac9e2e Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 22:13:57 +0100 Subject: [PATCH 34/46] networks: Rename and generalize state graph functions. build-full-state-graph and build-full-state-graph-annotated now retrieve the domains from the network and are not limited to Boolean state graphs. --- networks.rkt | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/networks.rkt b/networks.rkt index 13ad415..70c9d46 100644 --- a/networks.rkt +++ b/networks.rkt @@ -66,8 +66,8 @@ [ppsg (-> graph? graph?)] [pretty-print-boolean-state-graph (-> graph? graph?)] [ppsgb (-> graph? graph?)] - [build-full-boolean-state-graph (-> dynamics? graph?)] - [build-full-boolean-state-graph-annotated (-> dynamics? graph?)] + [build-full-state-graph (-> dynamics? graph?)] + [build-full-state-graph-annotated (-> dynamics? graph?)] [build-full-01-state-graph (-> dynamics? graph?)] [build-full-01-state-graph-annotated (-> dynamics? graph?)] [tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?) @@ -738,16 +738,22 @@ (define ppsgb pretty-print-boolean-state-graph) ;;; Builds the full state graph of a Boolean network. -(define (build-full-boolean-state-graph dyn) +(define (build-full-state-graph dyn) (dds-build-state-graph dyn - (list->set (build-all-boolean-states (hash-keys (dynamics-network dyn)))))) + ((compose list->set + build-all-states + network-domains + dynamics-network) dyn))) ;;; Build the full annotated state graph of a Boolean network. -(define (build-full-boolean-state-graph-annotated dyn) +(define (build-full-state-graph-annotated dyn) (dds-build-state-graph-annotated dyn - (list->set (build-all-boolean-states (hash-keys (dynamics-network dyn)))))) + ((compose list->set + build-all-states + network-domains + dynamics-network) dyn))) (module+ test (test-case "Dynamics of networks" @@ -761,8 +767,8 @@ (define gr-full (dds-build-state-graph asyn (set s))) (define gr-full-pp (pretty-print-state-graph gr-full)) (define gr-full-ppb (pretty-print-boolean-state-graph gr-full)) - (define gr-complete-bool (build-full-boolean-state-graph asyn)) - (define gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)) + (define gr-complete-bool (build-full-state-graph asyn)) + (define gr-complete-bool-ann (build-full-state-graph-annotated asyn)) (check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f))) (make-state '((a . #t) (b . #f))))) (check-equal? (dds-step-one-annotated asyn s) From cdb2149358607a436190ca97a8d0497863ecdc16 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 22:25:25 +0100 Subject: [PATCH 35/46] network: Fix table->network. --- networks.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 70c9d46..6c6808d 100644 --- a/networks.rkt +++ b/networks.rkt @@ -998,7 +998,10 @@ (table->function (for/list ([in st-ins] [o out]) (list in o))))) ;; Construct the network. - (network (map cons var-names funcs) (hash))) + (network (for/hash ([x (in-list var-names)] + [f (in-list funcs)]) + (values x f)) + (hash))) (module+ test (test-case "table->network" From 8f9740d2d7d19a89f6095297533ed92c63fbddfe Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 22:36:19 +0100 Subject: [PATCH 36/46] network: Fix the tests for interaction graphs. --- networks.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 6c6808d..08ef2f0 100644 --- a/networks.rkt +++ b/networks.rkt @@ -582,7 +582,7 @@ [skip-expensive-tests? (displayln "Skipping test case build-interaction-graph.")] [else - (define n1 (forms->boolean-network + (define n1 (make-boolean-network-form (hash 'x '(not y) 'y 'x 'z '(and y z) @@ -595,7 +595,7 @@ '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 (network-form n-multi 123-doms))) + (define n2 (network-form n-multi 123-doms)) (check-equal? (graphviz (build-interaction-graph/form n2)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t}\n}\n")]))) @@ -623,7 +623,7 @@ [skip-expensive-tests? (displayln "Skipping test case build-signed-interaction-graph.")] [else - (define n1 (forms->boolean-network + (define n1 (make-boolean-network-form (hash 'x '(not y) 'y 'x 'z '(and y z) @@ -636,7 +636,7 @@ '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 (network-form n-multi 123-doms))) + (define n2 (network-form n-multi 123-doms)) (check-equal? (graphviz (build-signed-interaction-graph/form n2)) "digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"-1\"];\n\t}\n}\n")]))) From dae4f6570fe63c722477b4635857f62cdf450e41 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 23:20:44 +0100 Subject: [PATCH 37/46] example: Update the section on Boolean networks. --- example/example.org | 80 ++++++++++++++++++++++++++++++++------------- 1 file changed, 57 insertions(+), 23 deletions(-) diff --git a/example/example.org b/example/example.org index bb722a7..5774741 100644 --- a/example/example.org +++ b/example/example.org @@ -436,7 +436,12 @@ tab Here's the unsigned syntactic interaction graph of this network: #+NAME: simple-bn-syig #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(dotit (build-syntactic-interaction-graph (unorgv simple-bn))) +((compose + dotit + build-syntactic-interaction-graph + make-boolean-network-form + unorgv) + simple-bn) #+END_SRC #+BEGIN_SRC dot :file dots/examplejTo8XT.svg :results raw drawer :cmd sfdp :noweb yes @@ -461,7 +466,12 @@ tab time constructed according to the canonical definition: #+NAME: simple-bn-ig #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(dotit (build-interaction-graph/form (unorgv simple-bn) (make-boolean-domains '(a b c)))) +((compose + dotit + build-interaction-graph/form + make-boolean-network-form + unorgv) + simple-bn) #+END_SRC #+BEGIN_SRC dot :file dots/example1FH1rZ.svg :results raw drawer :cmd sfdp :noweb yes @@ -486,7 +496,12 @@ tab #+NAME: simple-bn-sig #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(dotit (build-signed-interaction-graph/form (unorgv simple-bn) (make-boolean-domains '(a b c)))) +((compose + dotit + build-signed-interaction-graph/form + make-boolean-network-form + unorgv) + simple-bn) #+END_SRC #+BEGIN_SRC dot :file dots/exampledpQygl.svg :results raw drawer :cmd sfdp :noweb yes @@ -502,28 +517,37 @@ tab dynamics: #+NAME: simple-bn-sg #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(let* ([bn (network-form->network (unorgv simple-bn))] - [bn-asyn (make-asyn-dynamics bn)]) - (dotit (pretty-print-state-graph (build-full-boolean-state-graph bn-asyn)))) +((compose + dotit + pretty-print-state-graph + build-full-state-graph + make-asyn-dynamics + forms->boolean-network + unorgv) + simple-bn) #+END_SRC - #+BEGIN_SRC dot :file dots/examplem7LpTs.svg :results raw drawer :cmd sfdp :noweb yes <> #+END_SRC #+RESULTS: - :RESULTS: + :results: [[file:dots/examplem7LpTs.svg]] - :END: + :end: Alternatively, you may prefer a slighty more compact representation of Boolean values as 0 and 1: #+NAME: simple-bn-sg-bool #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(let* ([bn (network-form->network (unorgv simple-bn))] - [bn-asyn (make-asyn-dynamics bn)]) - (dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph bn-asyn)))) +((compose + dotit + pretty-print-boolean-state-graph + build-full-state-graph + make-asyn-dynamics + forms->boolean-network + unorgv) + simple-bn) #+END_SRC #+BEGIN_SRC dot :file dots/examplex1Irnk.svg :results raw drawer :cmd sfdp :noweb yes @@ -531,9 +555,9 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: [[file:dots/examplex1Irnk.svg]] - :END: + :end: Consider the following state (appearing in the upper left corner of the state graph): @@ -549,7 +573,7 @@ tab #+HEADER: :var simple-bn=munch-sexp(simple-bn) #+HEADER: :var some-state=munch-sexp(some-state) #+BEGIN_SRC racket :results silent -(let* ([bn (network-form->network (unorgv simple-bn))] +(let* ([bn (forms->boolean-network (unorgv simple-bn))] [bn-asyn (make-asyn-dynamics bn)] [s0 (booleanize-state (unorgv some-state))]) (dotit (pretty-print-boolean-state-graph (dds-build-n-step-state-graph bn-asyn (set s0) 2)))) @@ -560,17 +584,22 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: [[file:dots/examplecHA6gL.svg]] - :END: + :end: Here is the complete state graph with edges annotated with the modality leading to the update. #+NAME: simple-bn-sg-bool-ann #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) -(let* ([bn (network-form->network (unorgv simple-bn))] - [bn-asyn (make-asyn-dynamics bn)]) - (dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph-annotated bn-asyn)))) +((compose + dotit + pretty-print-boolean-state-graph + build-full-state-graph-annotated + make-asyn-dynamics + forms->boolean-network + unorgv) + simple-bn) #+END_SRC #+BEGIN_SRC dot :file dots/examplei4we6j.svg :results raw drawer :cmd sfdp :noweb yes @@ -590,9 +619,14 @@ tab #+NAME: bn2-sgr #+BEGIN_SRC racket :results silent :var input-bn=munch-sexp(bn2) -(let* ([bn (network-form->network (unorgv input-bn))] - [bn-asyn (make-asyn-dynamics bn)]) - (dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph-annotated bn-asyn)))) +((compose + dotit + pretty-print-boolean-state-graph + build-full-state-graph-annotated + make-asyn-dynamics + forms->boolean-network + unorgv) + input-bn) #+END_SRC #+BEGIN_SRC dot :file dots/examplehsuRqc.svg :results raw drawer :cmd dot :noweb yes From 83deda31a920feb52cb77dbba172db6f9f00e3e4 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 23:20:58 +0100 Subject: [PATCH 38/46] example: Stage a forgotten figure. --- example/dots/example1FH1rZ.svg | 47 ++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 example/dots/example1FH1rZ.svg diff --git a/example/dots/example1FH1rZ.svg b/example/dots/example1FH1rZ.svg new file mode 100644 index 0000000..e7111f1 --- /dev/null +++ b/example/dots/example1FH1rZ.svg @@ -0,0 +1,47 @@ + + + + + + +G + + + +node0 + +c + + + +node0->node0 + + + + +node1 + +b + + + +node0->node1 + + + + + +node2 + +a + + + +node1->node2 + + + + From a1085d50b8794b2d0db2b25600b9faec0d014fa8 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Thu, 26 Nov 2020 23:26:53 +0100 Subject: [PATCH 39/46] example: Update Tabulating functions and networks. --- example/example.org | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/example/example.org b/example/example.org index 5774741..bac091c 100644 --- a/example/example.org +++ b/example/example.org @@ -649,14 +649,14 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: | 1 | 0 | 1 | | 1 | 2 | 3 | | 1 | 4 | 5 | | 2 | 0 | 2 | | 2 | 2 | 4 | | 2 | 4 | 6 | - :END: + :end: Here's how you tabulate a Boolean function: #+BEGIN_SRC racket :results table drawer @@ -664,12 +664,12 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: | #f | #f | #f | | #f | #t | #f | | #t | #f | #f | | #t | #t | #t | - :END: + :end: You can tabulate multiple functions taking the same arguments over the same domains together. @@ -678,21 +678,21 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: | #f | #f | #f | #f | | #f | #t | #f | #t | | #t | #f | #f | #t | | #t | #t | #t | #t | - :END: + :end: Here's how to tabulate the network =simple-bn=, defined at the top of this section: #+BEGIN_SRC racket :results table drawer :var in-bn=munch-sexp(simple-bn) -(tabulate-boolean-network (network-form->network (unorgv in-bn))) +(tabulate-network (forms->boolean-network (unorgv in-bn))) #+END_SRC #+RESULTS: - :RESULTS: + :results: | a | b | c | f-a | f-b | f-c | | #f | #f | #f | #f | #f | #t | | #f | #f | #t | #f | #t | #f | @@ -702,7 +702,7 @@ tab | #t | #f | #t | #f | #f | #f | | #t | #t | #f | #t | #f | #t | | #t | #t | #t | #t | #f | #f | - :END: + :end: ** Random functions and networks To avoid having different results every time a code block in this From 5fc4875adfefb52dc331dddf5e2314856baed833 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 22:46:43 +0100 Subject: [PATCH 40/46] networks: Make table->network infer the domains. --- networks.rkt | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/networks.rkt b/networks.rkt index 08ef2f0..ffbb33a 100644 --- a/networks.rkt +++ b/networks.rkt @@ -974,8 +974,9 @@ ;;; This function relies on table->function, so the same caveats ;;; apply. ;;; -;;; This function sets the domain mappings of the network to the empty -;;; hash table. +;;; The domains of the network is a mapping assigning to each variable +;;; the set of values which can appear in its column in the table. +;;; This function does not check whether the table is complete. (define (table->network table #:headers [headers #t]) (define n (/ (length (car table)) 2)) ;; Get the variable names from the table or generate them, if @@ -997,11 +998,15 @@ (define funcs (for/list ([out func-lines]) (table->function (for/list ([in st-ins] [o out]) (list in o))))) + ;; Infer the domains. + (define domains (for/hash [(dom (in-list (lists-transpose ins))) + (x (in-list var-names))] + (values x (remove-duplicates dom)))) ;; Construct the network. (network (for/hash ([x (in-list var-names)] [f (in-list funcs)]) (values x f)) - (hash))) + domains)) (module+ test (test-case "table->network" @@ -1021,7 +1026,10 @@ (check-false (f2 (make-state '((x1 . #f) (x2 . #f))))) (check-true (f2 (make-state '((x1 . #f) (x2 . #t))))) (check-false (f2 (make-state '((x1 . #t) (x2 . #f))))) - (check-true (f2 (make-state '((x1 . #t) (x2 . #t))))))) + (check-true (f2 (make-state '((x1 . #t) (x2 . #t))))) + + (check-equal? (network-domains n) + #hash((x1 . (#f #t)) (x2 . (#f #t)))))) ;;; ============================= From ce2d10526a8018f41f8b354808c7f07c87b657a8 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 22:55:44 +0100 Subject: [PATCH 41/46] example: Update Random functions and networks. --- example/dots/exampleHc023j.svg | 2 +- example/dots/examplePIN5ac.svg | 84 ++++++++++++++++++++++++---------- example/example.org | 54 ++++++++++++---------- 3 files changed, 91 insertions(+), 49 deletions(-) diff --git a/example/dots/exampleHc023j.svg b/example/dots/exampleHc023j.svg index 05d4020..c613c00 100644 --- a/example/dots/exampleHc023j.svg +++ b/example/dots/exampleHc023j.svg @@ -130,7 +130,7 @@ node4->node4 -{c}{b} +{b}{c} diff --git a/example/dots/examplePIN5ac.svg b/example/dots/examplePIN5ac.svg index 7b10d04..cac11b3 100644 --- a/example/dots/examplePIN5ac.svg +++ b/example/dots/examplePIN5ac.svg @@ -4,42 +4,80 @@ - - + + G - + node0 - -c + +c - - -node2 - -a - - + -node0->node2 - - -+ +node0->node0 + +0 node1 - -b + +b + + + +node0->node1 + +0 + + + +node2 + +a + + + +node0->node2 + + +1 + + + +node1->node1 + +-1 - + node1->node2 - - -+ + + +1 + + + +node2->node0 + + +0 + + + +node2->node1 + + +0 + + + +node2->node2 + +0 diff --git a/example/example.org b/example/example.org index bac091c..0277927 100644 --- a/example/example.org +++ b/example/example.org @@ -725,7 +725,7 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: | a | b | c | f | | #f | 1 | cold | 4 | | #f | 1 | hot | 5 | @@ -735,17 +735,17 @@ tab | #t | 1 | hot | 6 | | #t | 2 | cold | 4 | | #t | 2 | hot | 5 | - :END: + :end: We can build an entire random network over these domains: #+BEGIN_SRC racket :results table drawer :var simple-domains=munch-sexp(simple-domains) (random-seed 0) (define n (random-network (unorgv simple-domains))) -(tabulate-network n (unorgv simple-domains)) +(tabulate-network n) #+END_SRC #+RESULTS: - :RESULTS: + :results: | a | b | c | f-a | f-b | f-c | | #f | 1 | cold | #f | 2 | hot | | #f | 1 | hot | #f | 2 | cold | @@ -755,7 +755,7 @@ tab | #t | 1 | hot | #t | 1 | cold | | #t | 2 | cold | #f | 2 | hot | | #t | 2 | hot | #t | 1 | cold | - :END: + :end: Let's snapshot this random network and give it a name. #+NAME: rnd-network @@ -769,16 +769,16 @@ tab | #t | 2 | cold | #f | 2 | hot | | #t | 2 | hot | #t | 1 | cold | - Here's how we can read back this table as a Boolean network: + Here's how we can read back this table as a network: #+HEADER: :var rnd-network=munch-sexp(rnd-network) #+BEGIN_SRC racket :results output drawer (string->any rnd-network) #+END_SRC #+RESULTS: - :RESULTS: + :results: '(("a" "b" "c" "f-a" "f-b" "f-c") ("#f" 1 "cold" "#f" 2 "hot") ("#f" 1 "hot" "#f" 2 "cold") ("#f" 2 "cold" "#t" 1 "cold") ("#f" 2 "hot" "#t" 2 "hot") ("#t" 1 "cold" "#f" 2 "cold") ("#t" 1 "hot" "#t" 1 "cold") ("#t" 2 "cold" "#f" 2 "hot") ("#t" 2 "hot" "#t" 1 "cold")) - :END: + :end: You can use =table->network= to convert a table such as [[rnd-network][rnd-network]] to a network. @@ -788,19 +788,23 @@ tab #+END_SRC #+RESULTS: - :RESULTS: - '#hash((a . #) (b . #) (c . #)) - :END: + :results: + (network '#hash((a . #) (b . #) (c . #)) '#hash((a . (#f #t)) (b . (1 2)) (c . (cold hot)))) + :end: Here's the state graph of [[rnd-network][rnd-network]]. #+NAME: rnd-network-sg #+HEADER: :var rnd-network=munch-sexp(rnd-network) #+HEADER: :var simple-domains=munch-sexp(simple-domains) #+BEGIN_SRC racket :results silent drawer -(define n (table->network (unorg rnd-network))) -(define rnd-asyn (make-asyn-dynamics n)) -(define states (list->set (build-all-states (unorgv simple-domains)))) -(dotit (pretty-print-state-graph (dds-build-state-graph-annotated rnd-asyn states))) +((compose + dotit + pretty-print-state-graph + build-full-state-graph-annotated + make-asyn-dynamics + table->network + unorg) + rnd-network) #+END_SRC #+BEGIN_SRC dot :file dots/exampleHc023j.svg :results raw drawer :cmd sfdp :noweb yes @@ -808,17 +812,21 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: [[file:dots/exampleHc023j.svg]] - :END: + :end: Here's the signed interaction graph of [[rnd-network][rnd-network]]. #+NAME: rnd-network-ig #+HEADER: :var rnd-network=munch-sexp(rnd-network) #+HEADER: :var simple-domains=munch-sexp(simple-domains) #+BEGIN_SRC racket :results silent drawer -(define n (table->network (unorg rnd-network))) -(dotit (build-signed-interaction-graph n (unorgv simple-domains))) +((compose + dotit + build-signed-interaction-graph + table->network + unorg) + rnd-network) #+END_SRC #+BEGIN_SRC dot :file dots/examplePIN5ac.svg :results raw drawer :cmd sfdp :noweb yes @@ -826,13 +834,9 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: [[file:dots/examplePIN5ac.svg]] - :END: - - Note that =build-signed-interaction-graph= only includes the + and - the - arcs in the graph, as it does not have access to the symbolic - description of the function. + :end: ** Standalone threshold Boolean functions (TBF) /Note:/ Before using the objects described in this section, From c0ec7369fdfa5631c67c09b812ac0dd0704de890 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 23:01:57 +0100 Subject: [PATCH 42/46] networks: Add make-01-network. --- networks.rkt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/networks.rkt b/networks.rkt index ffbb33a..c237830 100644 --- a/networks.rkt +++ b/networks.rkt @@ -25,6 +25,7 @@ [domains domain-mapping/c])]) ;; Functions (contract-out [make-boolean-network (-> (hash/c variable? procedure?) network?)] + [make-01-network (-> (hash/c variable? procedure?) network?)] [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] @@ -190,6 +191,11 @@ (define (make-boolean-network funcs) (network funcs (make-boolean-domains (hash-keys funcs)))) +;;; Build a network from a given hash table assigning functions to +;;; variables by attributing the domain {0,1} to every variable. +(define (make-01-network funcs) + (network funcs (make-01-domains (hash-keys funcs)))) + (module+ test (test-case "make-boolean-network" (define f1 (λ (s) (let ([x1 (hash-ref s 'x1)] From 5419278462d1768eaa1c96199b1022842bd947e1 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 23:05:56 +0100 Subject: [PATCH 43/46] networks,tbn->network: Use make-01-network. Also add some tests. --- networks.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/networks.rkt b/networks.rkt index c237830..f8ea75b 100644 --- a/networks.rkt +++ b/networks.rkt @@ -1438,8 +1438,8 @@ ;;; Constructs a network from a network form defining a TBN. (define (tbn->network tbn) - (make-boolean-network (for/hash ([(var tbf) (in-hash tbn)]) - (values var ((curry apply-tbf/state) tbf))))) + (make-01-network (for/hash ([(var tbf) (in-hash tbn)]) + (values var ((curry apply-tbf/state) tbf))))) (module+ test (test-case "tbn->network" @@ -1449,13 +1449,15 @@ (define s1 (make-state '((a . 0) (b . 0)))) (check-equal? (update n s1 '(a b)) (make-state '((a . 0) (b . 1)))) + (check-equal? (network-domains n) #hash((a . (0 1)) (b . (0 1)))) (define sbn (make-sbn `((a . ,(make-sbf/state '((b . -1)))) (b . ,(make-sbf/state '((a . 1))))))) (define sn (tbn->network sbn)) (define s2 (make-state '((a . 1) (b . 1)))) (check-equal? (update sn s2 '(a b)) - (make-state '((a . 0) (b . 1)))))) + (make-state '((a . 0) (b . 1)))) + (check-equal? (network-domains sn) #hash((a . (0 1)) (b . (0 1)))))) ;;; A helper function for read-org-tbn and read-org-sbn. It reads a ;;; TBN from an Org-mode sexp containing a list of lists of numbers. From 6c30120376dd6f22a8d218fb862ec50b3db22476 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 23:10:18 +0100 Subject: [PATCH 44/46] networks: Remove 01-related state graph functions. Remove build-full-01-state-graph and build-full-01-state-graph-annotated. --- networks.rkt | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/networks.rkt b/networks.rkt index f8ea75b..273aba5 100644 --- a/networks.rkt +++ b/networks.rkt @@ -69,8 +69,6 @@ [ppsgb (-> graph? graph?)] [build-full-state-graph (-> dynamics? graph?)] [build-full-state-graph-annotated (-> dynamics? graph?)] - [build-full-01-state-graph (-> dynamics? graph?)] - [build-full-01-state-graph-annotated (-> dynamics? graph?)] [tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?) (listof (listof any/c)))] [tabulate-state* (->* ((non-empty-listof procedure?) domain-mapping/c) (#:headers boolean?) @@ -850,20 +848,6 @@ #hash((a . #f) (b . #t)) #hash((a . #t) (b . #t))) (set (set 'a))))) -;;; Like build-full-boolean-state-graph, but the states are expressed -;;; in 0 and 1, instead of #f and #t. -(define (build-full-01-state-graph dyn) - (dds-build-state-graph - dyn - (list->set (build-all-01-states (hash-keys (dynamics-network dyn)))))) - -;;; Like build-full-boolean-state-graph-annotated, but the states are expressed -;;; in 0 and 1, instead of #f and #t. -(define (build-full-01-state-graph-annotated dyn) - (dds-build-state-graph-annotated - dyn - (list->set (build-all-01-states (hash-keys (dynamics-network dyn)))))) - ;;; ================================= ;;; Tabulating functions and networks From d7d3717c834f8bfd156f79c7c7c70c57df1ff6e1 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 23:12:49 +0100 Subject: [PATCH 45/46] networks: Fix build-tbn-state-graph. --- networks.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 273aba5..515f92d 100644 --- a/networks.rkt +++ b/networks.rkt @@ -1574,7 +1574,7 @@ ;;; A shortcut for building the state graphs of TBN. (define build-tbn-state-graph (compose pretty-print-state-graph - build-full-01-state-graph + build-full-state-graph make-syn-dynamics tbn->network)) From 68afb6231a9e7d24f5d31e4597e16438843825e8 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 28 Nov 2020 23:20:14 +0100 Subject: [PATCH 46/46] example: Update Threshold Boolean networks. --- example/example.org | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/example/example.org b/example/example.org index 0277927..ee42521 100644 --- a/example/example.org +++ b/example/example.org @@ -1109,7 +1109,11 @@ tab #+NAME: tbfs-nots-sg #+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots) -(dotit (build-tbn-state-graph (read-org-tbn tbfs-nots))) +((compose + dotit + build-tbn-state-graph + read-org-tbn) + tbfs-nots) #+END_SRC #+BEGIN_SRC dot :file dots/examplew206DH.svg :results raw drawer :cmd sfdp :noweb yes @@ -1212,7 +1216,12 @@ tab #+NAME: tbfs-nots-ig-pp #+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots) -(dotit (pretty-print-tbn-interaction-graph (tbn-interaction-graph (read-org-tbn tbfs-nots)))) +((compose + dotit + pretty-print-tbn-interaction-graph + tbn-interaction-graph + read-org-tbn) + tbfs-nots) #+END_SRC #+BEGIN_SRC dot :file dots/exampleQLHMVK.svg :results raw drawer :cmd dot :noweb yes