Merge branch 'network-domains'

This commit is contained in:
Sergiu Ivanov 2020-11-28 23:21:34 +01:00
commit 34fe8a8316
5 changed files with 455 additions and 278 deletions

View file

@ -0,0 +1,47 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<!-- Generated by graphviz version 2.43.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="431pt" height="44pt"
viewBox="0.00 0.00 431.16 44.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 40)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-40 427.16,-40 427.16,4 -4,4"/>
<!-- node0 -->
<g id="node1" class="node">
<title>node0</title>
<ellipse fill="none" stroke="black" cx="378.16" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="378.16" y="-14.3" font-family="Times-Roman" font-size="14.00">c</text>
</g>
<!-- node0&#45;&gt;node0 -->
<g id="edge1" class="edge">
<title>node0&#45;&gt;node0</title>
<path fill="none" stroke="black" d="M403.61,-24.69C414.19,-25.15 423.16,-22.92 423.16,-18 423.16,-13.08 414.19,-10.85 403.61,-11.31"/>
</g>
<!-- node1 -->
<g id="node2" class="node">
<title>node1</title>
<ellipse fill="none" stroke="black" cx="210.56" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="210.56" y="-14.3" font-family="Times-Roman" font-size="14.00">b</text>
</g>
<!-- node0&#45;&gt;node1 -->
<g id="edge3" class="edge">
<title>node0&#45;&gt;node1</title>
<path fill="none" stroke="black" d="M350.86,-18C322.78,-18 278.85,-18 247.63,-18"/>
<polygon fill="black" stroke="black" points="247.57,-14.5 237.57,-18 247.57,-21.5 247.57,-14.5"/>
</g>
<!-- node2 -->
<g id="node3" class="node">
<title>node2</title>
<ellipse fill="none" stroke="black" cx="27" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="27" y="-14.3" font-family="Times-Roman" font-size="14.00">a</text>
</g>
<!-- node1&#45;&gt;node2 -->
<g id="edge2" class="edge">
<title>node1&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M183.48,-18C148.77,-18 88.96,-18 54.2,-18"/>
</g>
</g>
</svg>

After

Width:  |  Height:  |  Size: 1.9 KiB

View file

@ -130,7 +130,7 @@
<g id="edge9" class="edge">
<title>node4&#45;&gt;node4</title>
<path fill="none" stroke="black" d="M866.46,-816.69C879.83,-815.94 889.32,-813.79 889.32,-810.24 889.32,-806.69 879.83,-804.54 866.46,-803.79"/>
<text text-anchor="middle" x="915.82" y="-806.54" font-family="Times-Roman" font-size="14.00">{c}{b}</text>
<text text-anchor="middle" x="915.82" y="-806.54" font-family="Times-Roman" font-size="14.00">{b}{c}</text>
</g>
<!-- node4&#45;&gt;node6 -->
<g id="edge16" class="edge">

Before

Width:  |  Height:  |  Size: 8.9 KiB

After

Width:  |  Height:  |  Size: 8.9 KiB

View file

@ -4,42 +4,80 @@
<!-- Generated by graphviz version 2.43.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="413pt" height="44pt"
viewBox="0.00 0.00 413.24 44.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 40)">
<svg width="335pt" height="270pt"
viewBox="0.00 0.00 335.32 269.60" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 265.6)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-40 409.24,-40 409.24,4 -4,4"/>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-265.6 331.32,-265.6 331.32,4 -4,4"/>
<!-- node0 -->
<g id="node1" class="node">
<title>node0</title>
<ellipse fill="none" stroke="black" cx="378.24" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="378.24" y="-14.3" font-family="Times-Roman" font-size="14.00">c</text>
<ellipse fill="none" stroke="black" cx="272.32" cy="-243.6" rx="27" ry="18"/>
<text text-anchor="middle" x="272.32" y="-239.9" font-family="Times-Roman" font-size="14.00">c</text>
</g>
<!-- node2 -->
<g id="node3" class="node">
<title>node2</title>
<ellipse fill="none" stroke="black" cx="205.6" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="205.6" y="-14.3" font-family="Times-Roman" font-size="14.00">a</text>
</g>
<!-- node0&#45;&gt;node2 -->
<!-- node0&#45;&gt;node0 -->
<g id="edge1" class="edge">
<title>node0&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M350.89,-18C321.72,-18 275.34,-18 242.85,-18"/>
<polygon fill="black" stroke="black" points="242.83,-14.5 232.83,-18 242.83,-21.5 242.83,-14.5"/>
<text text-anchor="middle" x="290.37" y="-21.8" font-family="Times-Roman" font-size="14.00">+</text>
<title>node0&#45;&gt;node0</title>
<path fill="none" stroke="black" d="M297.76,-250.29C308.35,-250.75 317.32,-248.52 317.32,-243.6 317.32,-238.67 308.35,-236.44 297.76,-236.9"/>
<text text-anchor="middle" x="322.32" y="-239.9" font-family="Times-Roman" font-size="14.00">0</text>
</g>
<!-- node1 -->
<g id="node2" class="node">
<title>node1</title>
<ellipse fill="none" stroke="black" cx="27" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="27" y="-14.3" font-family="Times-Roman" font-size="14.00">b</text>
<ellipse fill="none" stroke="black" cx="27" cy="-214.2" rx="27" ry="18"/>
<text text-anchor="middle" x="27" y="-210.5" font-family="Times-Roman" font-size="14.00">b</text>
</g>
<!-- node0&#45;&gt;node1 -->
<g id="edge2" class="edge">
<title>node0&#45;&gt;node1</title>
<path fill="none" stroke="black" d="M245.6,-240.39C198.41,-234.74 100.85,-223.05 53.69,-217.4"/>
<text text-anchor="middle" x="144.64" y="-232.7" font-family="Times-Roman" font-size="14.00">0</text>
</g>
<!-- node2 -->
<g id="node3" class="node">
<title>node2</title>
<ellipse fill="none" stroke="black" cx="175.3" cy="-18" rx="27" ry="18"/>
<text text-anchor="middle" x="175.3" y="-14.3" font-family="Times-Roman" font-size="14.00">a</text>
</g>
<!-- node0&#45;&gt;node2 -->
<g id="edge5" class="edge">
<title>node0&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M268.62,-225.53C255.48,-185.59 214.61,-89.85 191.36,-43.69"/>
<polygon fill="black" stroke="black" points="194.38,-41.91 186.69,-34.63 188.16,-45.13 194.38,-41.91"/>
<text text-anchor="middle" x="224.99" y="-138.41" font-family="Times-Roman" font-size="14.00">1</text>
</g>
<!-- node1&#45;&gt;node1 -->
<g id="edge3" class="edge">
<title>node1&#45;&gt;node1</title>
<path fill="none" stroke="black" d="M52.44,-220.89C63.03,-221.36 72,-219.13 72,-214.2 72,-209.28 63.03,-207.05 52.44,-207.51"/>
<text text-anchor="middle" x="79.5" y="-210.5" font-family="Times-Roman" font-size="14.00">&#45;1</text>
</g>
<!-- node1&#45;&gt;node2 -->
<g id="edge2" class="edge">
<g id="edge6" class="edge">
<title>node1&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M54.13,-18C84.64,-18 134.37,-18 168.47,-18"/>
<polygon fill="black" stroke="black" points="168.52,-21.5 178.52,-18 168.52,-14.5 168.52,-21.5"/>
<text text-anchor="middle" x="104.8" y="-21.8" font-family="Times-Roman" font-size="14.00">+</text>
<path fill="none" stroke="black" d="M43.1,-199.56C72.52,-166.38 133.83,-85.56 161.49,-43.8"/>
<polygon fill="black" stroke="black" points="164.51,-45.58 167,-35.28 158.63,-41.77 164.51,-45.58"/>
<text text-anchor="middle" x="97.29" y="-125.48" font-family="Times-Roman" font-size="14.00">1</text>
</g>
<!-- node2&#45;&gt;node0 -->
<g id="edge7" class="edge">
<title>node2&#45;&gt;node0</title>
<path fill="none" stroke="black" d="M179,-36.07C192.15,-76 233.01,-171.75 256.26,-217.9"/>
<polygon fill="black" stroke="black" points="253.24,-219.68 260.94,-226.96 259.46,-216.47 253.24,-219.68"/>
<text text-anchor="middle" x="212.63" y="-130.78" font-family="Times-Roman" font-size="14.00">0</text>
</g>
<!-- node2&#45;&gt;node1 -->
<g id="edge8" class="edge">
<title>node2&#45;&gt;node1</title>
<path fill="none" stroke="black" d="M159.2,-32.65C129.78,-65.82 68.47,-146.65 40.82,-188.4"/>
<polygon fill="black" stroke="black" points="37.79,-186.63 35.3,-196.92 43.67,-190.43 37.79,-186.63"/>
<text text-anchor="middle" x="95.01" y="-99.32" font-family="Times-Roman" font-size="14.00">0</text>
</g>
<!-- node2&#45;&gt;node2 -->
<g id="edge4" class="edge">
<title>node2&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M200.75,-24.69C211.33,-25.15 220.3,-22.92 220.3,-18 220.3,-13.08 211.33,-10.85 200.75,-11.31"/>
<text text-anchor="middle" x="225.3" y="-14.3" font-family="Times-Roman" font-size="14.00">0</text>
</g>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 2 KiB

After

Width:  |  Height:  |  Size: 4.1 KiB

View file

@ -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
<<simple-bn-sg()>>
#+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 . #<procedure:...dds/networks.rkt:518:4>) (b . #<procedure:...dds/networks.rkt:518:4>) (c . #<procedure:...dds/networks.rkt:518:4>))
:END:
:results:
(network '#hash((a . #<procedure:...ds/functions.rkt:145:4>) (b . #<procedure:...ds/functions.rkt:145:4>) (c . #<procedure:...ds/functions.rkt:145:4>)) '#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

View file

@ -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,9 +77,7 @@
(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?)
(listof (listof any/c)))]
[tabulate-boolean-network (->* (network?) (#:headers boolean?)
[tabulate-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?)]
@ -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
(define n1 (forms->boolean-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))))
(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
(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))))))
(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)
(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)))))
'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
(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)))))
(define bool-doms (make-boolean-domains '(x y z t)))
(check-equal? (graphviz (build-interaction-graph/form n-bool bool-doms))
(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)
(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
(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)))))
(define bool-doms (make-boolean-domains '(x y z t)))
(check-equal? (graphviz (build-signed-interaction-graph/form n-bool bool-doms))
(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)
(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))