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 + + + + 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 bb722a7..ee42521 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 @@ -615,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 @@ -630,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. @@ -644,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 | @@ -668,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 @@ -691,7 +725,7 @@ tab #+END_SRC #+RESULTS: - :RESULTS: + :results: | a | b | c | f | | #f | 1 | cold | 4 | | #f | 1 | hot | 5 | @@ -701,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 | @@ -721,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 @@ -735,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. @@ -754,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 @@ -774,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 @@ -792,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, @@ -1071,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 @@ -1174,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 diff --git a/networks.rkt b/networks.rkt index 5f59387..515f92d 100644 --- a/networks.rkt +++ b/networks.rkt @@ -18,25 +18,30 @@ (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])] + [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?)] + [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?)] [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?)) - 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? 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)))] @@ -48,8 +53,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?))] @@ -64,10 +67,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-01-state-graph (-> dynamics? graph?)] - [build-full-01-state-graph-annotated (-> dynamics? graph?)] + [build-full-state-graph (-> dynamics? graph?)] + [build-full-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?) @@ -76,10 +77,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?)] @@ -138,7 +137,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?)]) @@ -173,20 +171,46 @@ ;;; state. (define update-function/c (-> state? any/c)) -;;; A network is a mapping from its variables to its update functions. +;;; 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. ;;; -;;; 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?)) +;;; 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) #:transparent) + +;;; 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)))) + +;;; 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)] + [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? (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) + (define funcs (network-functions network)) (for/fold ([new-s s]) ([x xs]) - (let ([f (hash-ref network x)]) - (hash-set new-s x (f s))))) + (define fx (hash-ref funcs x)) + (hash-set new-s x (fx s)))) (module+ test (test-case "basic definitions" @@ -195,7 +219,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 (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)))) @@ -218,6 +242,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))) @@ -225,13 +253,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)]))) - -;;; A version of make-immutable-hash restricted to creating networks. -(define (make-network-from-functions funcs) (make-immutable-hash funcs)) - ;;; ================================= ;;; Syntactic description of networks @@ -242,9 +263,14 @@ ;;; '(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. +;;; +;;; 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) #:transparent) ;;; Build an update function from an update function form. (define (update-function-form->update-function form) @@ -257,27 +283,46 @@ (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) - (network-form->network (make-immutable-hash forms))) +;;; 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-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))) + (test-case "make-boolean-network-form" + (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. +(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))))) ;;; ============================ @@ -289,18 +334,27 @@ ;;; 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. (define (list-syntactic-interactions nf x) (set-intersect - (extract-symbols (hash-ref nf x)) - (hash-keys nf))) + (extract-symbols (hash-ref (network-form-forms nf) x)) + (hash-keys (network-form-forms 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))))) @@ -320,12 +374,13 @@ (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" - (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)) @@ -336,10 +391,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) @@ -412,10 +463,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))) @@ -430,20 +482,19 @@ (module+ test (test-case "interaction?" - (define n-bool (network-form->network - (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 (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))) - (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 @@ -452,10 +503,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 @@ -489,45 +541,44 @@ (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 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 (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))) - (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" @@ -535,41 +586,40 @@ [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))) - (check-equal? (graphviz (build-interaction-graph/form n-bool bool-doms)) + (define n1 (make-boolean-network-form + (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) - '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 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" @@ -577,22 +627,21 @@ [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))) - (check-equal? (graphviz (build-signed-interaction-graph/form n-bool bool-doms)) + (define n1 (make-boolean-network-form + (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) - '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 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")]))) ;;; ==================== @@ -634,7 +683,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) @@ -646,7 +695,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) @@ -654,14 +703,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))) @@ -701,20 +742,26 @@ (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" - (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)))) @@ -724,8 +771,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) @@ -801,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 @@ -887,13 +920,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 @@ -904,17 +937,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))))) @@ -935,6 +963,10 @@ ;;; ;;; This function relies on table->function, so the same caveats ;;; apply. +;;; +;;; 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 @@ -956,8 +988,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. - (make-network-from-functions (map cons var-names funcs))) + (network (for/hash ([x (in-list var-names)] + [f (in-list funcs)]) + (values x f)) + domains)) (module+ test (test-case "table->network" @@ -966,8 +1005,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))))) @@ -977,7 +1016,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)))))) ;;; ============================= @@ -1005,7 +1047,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) @@ -1018,8 +1060,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) @@ -1379,8 +1422,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-01-network (for/hash ([(var tbf) (in-hash tbn)]) + (values var ((curry apply-tbf/state) tbf))))) (module+ test (test-case "tbn->network" @@ -1390,13 +1433,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. @@ -1529,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))