scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Merge branch 'network-domains'

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

47
example/dots/example1FH1rZ.svg Normal file
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>
Side by side

After

Width:  |  Height:  |  Size: 1.9 KiB

2
example/dots/exampleHc023j.svg
View file

@ -130,7 +130,7 @@
<g id="edge9" class="edge"> <g id="edge9" class="edge">
<title>node4&#45;&gt;node4</title> <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"/> <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> </g>
<!-- node4&#45;&gt;node6 --> <!-- node4&#45;&gt;node6 -->
<g id="edge16" class="edge"> <g id="edge16" class="edge">

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 8.9 KiB

After

Width:  |  Height:  |  Size: 8.9 KiB

84
example/dots/examplePIN5ac.svg
View file

@ -4,42 +4,80 @@
<!-- Generated by graphviz version 2.43.0 (0) <!-- Generated by graphviz version 2.43.0 (0)
--> -->
<!-- Title: G Pages: 1 --> <!-- Title: G Pages: 1 -->
<svg width="413pt" height="44pt" <svg width="335pt" height="270pt"
viewBox="0.00 0.00 413.24 44.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> 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 40)"> <g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 265.6)">
<title>G</title> <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 --> <!-- node0 -->
<g id="node1" class="node"> <g id="node1" class="node">
<title>node0</title> <title>node0</title>
<ellipse fill="none" stroke="black" cx="378.24" cy="-18" rx="27" ry="18"/> <ellipse fill="none" stroke="black" cx="272.32" cy="-243.6" rx="27" ry="18"/>
<text text-anchor="middle" x="378.24" y="-14.3" font-family="Times-Roman" font-size="14.00">c</text> <text text-anchor="middle" x="272.32" y="-239.9" font-family="Times-Roman" font-size="14.00">c</text>
</g> </g>
<!-- node2 --> <!-- node0&#45;&gt;node0 -->
<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 -->
<g id="edge1" class="edge"> <g id="edge1" class="edge">
<title>node0&#45;&gt;node2</title> <title>node0&#45;&gt;node0</title>
<path fill="none" stroke="black" d="M350.89,-18C321.72,-18 275.34,-18 242.85,-18"/> <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"/>
<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="322.32" y="-239.9" font-family="Times-Roman" font-size="14.00">0</text>
<text text-anchor="middle" x="290.37" y="-21.8" font-family="Times-Roman" font-size="14.00">+</text>
</g> </g>
<!-- node1 --> <!-- node1 -->
<g id="node2" class="node"> <g id="node2" class="node">
<title>node1</title> <title>node1</title>
<ellipse fill="none" stroke="black" cx="27" cy="-18" rx="27" ry="18"/> <ellipse fill="none" stroke="black" cx="27" cy="-214.2" rx="27" ry="18"/>
<text text-anchor="middle" x="27" y="-14.3" font-family="Times-Roman" font-size="14.00">b</text> <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> </g>
<!-- node1&#45;&gt;node2 --> <!-- node1&#45;&gt;node2 -->
<g id="edge2" class="edge"> <g id="edge6" class="edge">
<title>node1&#45;&gt;node2</title> <title>node1&#45;&gt;node2</title>
<path fill="none" stroke="black" d="M54.13,-18C84.64,-18 134.37,-18 168.47,-18"/> <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="168.52,-21.5 178.52,-18 168.52,-14.5 168.52,-21.5"/> <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="104.8" y="-21.8" font-family="Times-Roman" font-size="14.00">+</text> <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>
</g> </g>
</svg> </svg>

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2 KiB

After

Width:  |  Height:  |  Size: 4.1 KiB

165
example/example.org
View file

@ -436,7 +436,12 @@ tab
Here's the unsigned syntactic interaction graph of this network: Here's the unsigned syntactic interaction graph of this network:
#+NAME: simple-bn-syig #+NAME: simple-bn-syig
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+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 #+END_SRC
#+BEGIN_SRC dot :file dots/examplejTo8XT.svg :results raw drawer :cmd sfdp :noweb yes #+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: time constructed according to the canonical definition:
#+NAME: simple-bn-ig #+NAME: simple-bn-ig
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+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 #+END_SRC
#+BEGIN_SRC dot :file dots/example1FH1rZ.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/example1FH1rZ.svg :results raw drawer :cmd sfdp :noweb yes
@ -486,7 +496,12 @@ tab
#+NAME: simple-bn-sig #+NAME: simple-bn-sig
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+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 #+END_SRC
#+BEGIN_SRC dot :file dots/exampledpQygl.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/exampledpQygl.svg :results raw drawer :cmd sfdp :noweb yes
@ -502,28 +517,37 @@ tab
dynamics: dynamics:
#+NAME: simple-bn-sg #+NAME: simple-bn-sg
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn)
(let* ([bn (network-form->network (unorgv simple-bn))] ((compose
[bn-asyn (make-asyn-dynamics bn)]) dotit
(dotit (pretty-print-state-graph (build-full-boolean-state-graph bn-asyn)))) pretty-print-state-graph
build-full-state-graph
make-asyn-dynamics
forms->boolean-network
unorgv)
simple-bn)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/examplem7LpTs.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/examplem7LpTs.svg :results raw drawer :cmd sfdp :noweb yes
<<simple-bn-sg()>> <<simple-bn-sg()>>
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
[[file:dots/examplem7LpTs.svg]] [[file:dots/examplem7LpTs.svg]]
:END: :end:
Alternatively, you may prefer a slighty more compact representation Alternatively, you may prefer a slighty more compact representation
of Boolean values as 0 and 1: of Boolean values as 0 and 1:
#+NAME: simple-bn-sg-bool #+NAME: simple-bn-sg-bool
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn)
(let* ([bn (network-form->network (unorgv simple-bn))] ((compose
[bn-asyn (make-asyn-dynamics bn)]) dotit
(dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph bn-asyn)))) pretty-print-boolean-state-graph
build-full-state-graph
make-asyn-dynamics
forms->boolean-network
unorgv)
simple-bn)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/examplex1Irnk.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/examplex1Irnk.svg :results raw drawer :cmd sfdp :noweb yes
@ -531,9 +555,9 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
[[file:dots/examplex1Irnk.svg]] [[file:dots/examplex1Irnk.svg]]
:END: :end:
Consider the following state (appearing in the upper left corner of Consider the following state (appearing in the upper left corner of
the state graph): the state graph):
@ -549,7 +573,7 @@ tab
#+HEADER: :var simple-bn=munch-sexp(simple-bn) #+HEADER: :var simple-bn=munch-sexp(simple-bn)
#+HEADER: :var some-state=munch-sexp(some-state) #+HEADER: :var some-state=munch-sexp(some-state)
#+BEGIN_SRC racket :results silent #+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)] [bn-asyn (make-asyn-dynamics bn)]
[s0 (booleanize-state (unorgv some-state))]) [s0 (booleanize-state (unorgv some-state))])
(dotit (pretty-print-boolean-state-graph (dds-build-n-step-state-graph bn-asyn (set s0) 2)))) (dotit (pretty-print-boolean-state-graph (dds-build-n-step-state-graph bn-asyn (set s0) 2))))
@ -560,17 +584,22 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
[[file:dots/examplecHA6gL.svg]] [[file:dots/examplecHA6gL.svg]]
:END: :end:
Here is the complete state graph with edges annotated with the Here is the complete state graph with edges annotated with the
modality leading to the update. modality leading to the update.
#+NAME: simple-bn-sg-bool-ann #+NAME: simple-bn-sg-bool-ann
#+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn) #+BEGIN_SRC racket :results silent :var simple-bn=munch-sexp(simple-bn)
(let* ([bn (network-form->network (unorgv simple-bn))] ((compose
[bn-asyn (make-asyn-dynamics bn)]) dotit
(dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph-annotated bn-asyn)))) pretty-print-boolean-state-graph
build-full-state-graph-annotated
make-asyn-dynamics
forms->boolean-network
unorgv)
simple-bn)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/examplei4we6j.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/examplei4we6j.svg :results raw drawer :cmd sfdp :noweb yes
@ -590,9 +619,14 @@ tab
#+NAME: bn2-sgr #+NAME: bn2-sgr
#+BEGIN_SRC racket :results silent :var input-bn=munch-sexp(bn2) #+BEGIN_SRC racket :results silent :var input-bn=munch-sexp(bn2)
(let* ([bn (network-form->network (unorgv input-bn))] ((compose
[bn-asyn (make-asyn-dynamics bn)]) dotit
(dotit (pretty-print-boolean-state-graph (build-full-boolean-state-graph-annotated bn-asyn)))) pretty-print-boolean-state-graph
build-full-state-graph-annotated
make-asyn-dynamics
forms->boolean-network
unorgv)
input-bn)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/examplehsuRqc.svg :results raw drawer :cmd dot :noweb yes #+BEGIN_SRC dot :file dots/examplehsuRqc.svg :results raw drawer :cmd dot :noweb yes
@ -615,14 +649,14 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| 1 | 0 | 1 | | 1 | 0 | 1 |
| 1 | 2 | 3 | | 1 | 2 | 3 |
| 1 | 4 | 5 | | 1 | 4 | 5 |
| 2 | 0 | 2 | | 2 | 0 | 2 |
| 2 | 2 | 4 | | 2 | 2 | 4 |
| 2 | 4 | 6 | | 2 | 4 | 6 |
:END: :end:
Here's how you tabulate a Boolean function: Here's how you tabulate a Boolean function:
#+BEGIN_SRC racket :results table drawer #+BEGIN_SRC racket :results table drawer
@ -630,12 +664,12 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| #f | #f | #f | | #f | #f | #f |
| #f | #t | #f | | #f | #t | #f |
| #t | #f | #f | | #t | #f | #f |
| #t | #t | #t | | #t | #t | #t |
:END: :end:
You can tabulate multiple functions taking the same arguments over You can tabulate multiple functions taking the same arguments over
the same domains together. the same domains together.
@ -644,21 +678,21 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| #f | #f | #f | #f | | #f | #f | #f | #f |
| #f | #t | #f | #t | | #f | #t | #f | #t |
| #t | #f | #f | #t | | #t | #f | #f | #t |
| #t | #t | #t | #t | | #t | #t | #t | #t |
:END: :end:
Here's how to tabulate the network =simple-bn=, defined at the top Here's how to tabulate the network =simple-bn=, defined at the top
of this section: of this section:
#+BEGIN_SRC racket :results table drawer :var in-bn=munch-sexp(simple-bn) #+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 #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| a | b | c | f-a | f-b | f-c | | a | b | c | f-a | f-b | f-c |
| #f | #f | #f | #f | #f | #t | | #f | #f | #f | #f | #f | #t |
| #f | #f | #t | #f | #t | #f | | #f | #f | #t | #f | #t | #f |
@ -668,7 +702,7 @@ tab
| #t | #f | #t | #f | #f | #f | | #t | #f | #t | #f | #f | #f |
| #t | #t | #f | #t | #f | #t | | #t | #t | #f | #t | #f | #t |
| #t | #t | #t | #t | #f | #f | | #t | #t | #t | #t | #f | #f |
:END: :end:
** Random functions and networks ** Random functions and networks
To avoid having different results every time a code block in this To avoid having different results every time a code block in this
@ -691,7 +725,7 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| a | b | c | f | | a | b | c | f |
| #f | 1 | cold | 4 | | #f | 1 | cold | 4 |
| #f | 1 | hot | 5 | | #f | 1 | hot | 5 |
@ -701,17 +735,17 @@ tab
| #t | 1 | hot | 6 | | #t | 1 | hot | 6 |
| #t | 2 | cold | 4 | | #t | 2 | cold | 4 |
| #t | 2 | hot | 5 | | #t | 2 | hot | 5 |
:END: :end:
We can build an entire random network over these domains: We can build an entire random network over these domains:
#+BEGIN_SRC racket :results table drawer :var simple-domains=munch-sexp(simple-domains) #+BEGIN_SRC racket :results table drawer :var simple-domains=munch-sexp(simple-domains)
(random-seed 0) (random-seed 0)
(define n (random-network (unorgv simple-domains))) (define n (random-network (unorgv simple-domains)))
(tabulate-network n (unorgv simple-domains)) (tabulate-network n)
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
| a | b | c | f-a | f-b | f-c | | a | b | c | f-a | f-b | f-c |
| #f | 1 | cold | #f | 2 | hot | | #f | 1 | cold | #f | 2 | hot |
| #f | 1 | hot | #f | 2 | cold | | #f | 1 | hot | #f | 2 | cold |
@ -721,7 +755,7 @@ tab
| #t | 1 | hot | #t | 1 | cold | | #t | 1 | hot | #t | 1 | cold |
| #t | 2 | cold | #f | 2 | hot | | #t | 2 | cold | #f | 2 | hot |
| #t | 2 | hot | #t | 1 | cold | | #t | 2 | hot | #t | 1 | cold |
:END: :end:
Let's snapshot this random network and give it a name. Let's snapshot this random network and give it a name.
#+NAME: rnd-network #+NAME: rnd-network
@ -735,16 +769,16 @@ tab
| #t | 2 | cold | #f | 2 | hot | | #t | 2 | cold | #f | 2 | hot |
| #t | 2 | hot | #t | 1 | cold | | #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) #+HEADER: :var rnd-network=munch-sexp(rnd-network)
#+BEGIN_SRC racket :results output drawer #+BEGIN_SRC racket :results output drawer
(string->any rnd-network) (string->any rnd-network)
#+END_SRC #+END_SRC
#+RESULTS: #+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")) '(("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]] You can use =table->network= to convert a table such as [[rnd-network][rnd-network]]
to a network. to a network.
@ -754,19 +788,23 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
'#hash((a . #<procedure:...dds/networks.rkt:518:4>) (b . #<procedure:...dds/networks.rkt:518:4>) (c . #<procedure:...dds/networks.rkt:518:4>)) (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: :end:
Here's the state graph of [[rnd-network][rnd-network]]. Here's the state graph of [[rnd-network][rnd-network]].
#+NAME: rnd-network-sg #+NAME: rnd-network-sg
#+HEADER: :var rnd-network=munch-sexp(rnd-network) #+HEADER: :var rnd-network=munch-sexp(rnd-network)
#+HEADER: :var simple-domains=munch-sexp(simple-domains) #+HEADER: :var simple-domains=munch-sexp(simple-domains)
#+BEGIN_SRC racket :results silent drawer #+BEGIN_SRC racket :results silent drawer
(define n (table->network (unorg rnd-network))) ((compose
(define rnd-asyn (make-asyn-dynamics n)) dotit
(define states (list->set (build-all-states (unorgv simple-domains)))) pretty-print-state-graph
(dotit (pretty-print-state-graph (dds-build-state-graph-annotated rnd-asyn states))) build-full-state-graph-annotated
make-asyn-dynamics
table->network
unorg)
rnd-network)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/exampleHc023j.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/exampleHc023j.svg :results raw drawer :cmd sfdp :noweb yes
@ -774,17 +812,21 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
[[file:dots/exampleHc023j.svg]] [[file:dots/exampleHc023j.svg]]
:END: :end:
Here's the signed interaction graph of [[rnd-network][rnd-network]]. Here's the signed interaction graph of [[rnd-network][rnd-network]].
#+NAME: rnd-network-ig #+NAME: rnd-network-ig
#+HEADER: :var rnd-network=munch-sexp(rnd-network) #+HEADER: :var rnd-network=munch-sexp(rnd-network)
#+HEADER: :var simple-domains=munch-sexp(simple-domains) #+HEADER: :var simple-domains=munch-sexp(simple-domains)
#+BEGIN_SRC racket :results silent drawer #+BEGIN_SRC racket :results silent drawer
(define n (table->network (unorg rnd-network))) ((compose
(dotit (build-signed-interaction-graph n (unorgv simple-domains))) dotit
build-signed-interaction-graph
table->network
unorg)
rnd-network)
#+END_SRC #+END_SRC
#+BEGIN_SRC dot :file dots/examplePIN5ac.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/examplePIN5ac.svg :results raw drawer :cmd sfdp :noweb yes
@ -792,13 +834,9 @@ tab
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
:RESULTS: :results:
[[file:dots/examplePIN5ac.svg]] [[file:dots/examplePIN5ac.svg]]
:END: :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.
** Standalone threshold Boolean functions (TBF) ** Standalone threshold Boolean functions (TBF)
/Note:/ Before using the objects described in this section, /Note:/ Before using the objects described in this section,
@ -1071,7 +1109,11 @@ tab
#+NAME: tbfs-nots-sg #+NAME: tbfs-nots-sg
#+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots) #+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 #+END_SRC
#+BEGIN_SRC dot :file dots/examplew206DH.svg :results raw drawer :cmd sfdp :noweb yes #+BEGIN_SRC dot :file dots/examplew206DH.svg :results raw drawer :cmd sfdp :noweb yes
@ -1174,7 +1216,12 @@ tab
#+NAME: tbfs-nots-ig-pp #+NAME: tbfs-nots-ig-pp
#+BEGIN_SRC racket :results silent drawer :var tbfs-nots=munch-sexp(tbfs-nots) #+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 #+END_SRC
#+BEGIN_SRC dot :file dots/exampleQLHMVK.svg :results raw drawer :cmd dot :noweb yes #+BEGIN_SRC dot :file dots/exampleQLHMVK.svg :results raw drawer :cmd dot :noweb yes

435
networks.rkt
View file

@ -18,25 +18,30 @@
(contract-out [struct tbf/state ([weights (hash/c variable? number?)] (contract-out [struct tbf/state ([weights (hash/c variable? number?)]
[threshold number?])] [threshold number?])]
[struct dynamics ([network network?] [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 ;; 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 (-> (listof (cons/c symbol? any/c)) state?)]
[make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)]
[booleanize-state (-> state? 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)] [update-function-form->update-function (-> update-function-form? update-function/c)]
[network-form->network (-> network-form? network?)] [network-form->network (-> network-form? network?)]
[make-network-from-forms (-> (listof (cons/c symbol? update-function-form?)) [make-boolean-network-form (-> variable-mapping? network-form?)]
network?)] [forms->boolean-network (-> variable-mapping? network?)]
[list-syntactic-interactions (-> network-form? variable? (listof variable?))] [list-syntactic-interactions (-> network-form? variable? (listof variable?))]
[build-syntactic-interaction-graph (-> network-form? graph?)] [build-syntactic-interaction-graph (-> network-form? graph?)]
[interaction? (-> network? domain-mapping/c variable? variable? boolean?)] [interaction? (-> network? variable? variable? boolean?)]
[get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))] [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
[build-interaction-graph (-> network? domain-mapping/c graph?)] [build-interaction-graph (-> network? graph?)]
[build-interaction-graph/form (-> network-form? domain-mapping/c graph?)] [build-interaction-graph/form (-> network-form? graph?)]
[build-signed-interaction-graph (-> network? domain-mapping/c graph?)] [build-signed-interaction-graph (-> network? graph?)]
[build-signed-interaction-graph/form (-> network-form? domain-mapping/c graph?)] [build-signed-interaction-graph/form (-> network-form? graph?)]
[build-all-states (-> domain-mapping/c (listof state?))] [build-all-states (-> domain-mapping/c (listof state?))]
[make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)] [make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))] [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-dynamics-from-func (-> network? (-> (listof variable?) mode?) dynamics?)]
[make-asyn-dynamics (-> network? dynamics?)] [make-asyn-dynamics (-> network? dynamics?)]
[make-syn-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 (-> dynamics? state? (set/c state?))]
[dds-step-one-annotated (-> dynamics? state? (set/c (cons/c modality? 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?))] [dds-step (-> dynamics? (set/c state? #:kind 'dont-care) (set/c state?))]
@ -64,10 +67,8 @@
[ppsg (-> graph? graph?)] [ppsg (-> graph? graph?)]
[pretty-print-boolean-state-graph (-> graph? graph?)] [pretty-print-boolean-state-graph (-> graph? graph?)]
[ppsgb (-> graph? graph?)] [ppsgb (-> graph? graph?)]
[build-full-boolean-state-graph (-> dynamics? graph?)] [build-full-state-graph (-> dynamics? graph?)]
[build-full-boolean-state-graph-annotated (-> dynamics? graph?)] [build-full-state-graph-annotated (-> dynamics? graph?)]
[build-full-01-state-graph (-> dynamics? graph?)]
[build-full-01-state-graph-annotated (-> dynamics? graph?)]
[tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?) [tabulate-state (->* (procedure? domain-mapping/c) (#:headers boolean?)
(listof (listof any/c)))] (listof (listof any/c)))]
[tabulate-state* (->* ((non-empty-listof procedure?) domain-mapping/c) (#:headers boolean?) [tabulate-state* (->* ((non-empty-listof procedure?) domain-mapping/c) (#:headers boolean?)
@ -76,10 +77,8 @@
(listof (listof any/c)))] (listof (listof any/c)))]
[tabulate-state*/boolean (->* ((non-empty-listof procedure?) (listof variable?)) (#:headers boolean?) [tabulate-state*/boolean (->* ((non-empty-listof procedure?) (listof variable?)) (#:headers boolean?)
(listof (listof any/c)))] (listof (listof any/c)))]
[tabulate-network (->* (network? domain-mapping/c) (#:headers boolean?) [tabulate-network (->* (network?) (#:headers boolean?)
(listof (listof any/c)))] (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?)] [table->network (->* ((listof (*list/c any/c any/c))) (#:headers boolean?) network?)]
[random-function/state (domain-mapping/c generic-set? . -> . procedure?)] [random-function/state (domain-mapping/c generic-set? . -> . procedure?)]
[random-boolean-function/state ((listof variable?) . -> . procedure?)] [random-boolean-function/state ((listof variable?) . -> . procedure?)]
@ -138,7 +137,6 @@
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
[update-function-form? (-> any/c boolean?)] [update-function-form? (-> any/c boolean?)]
[network-form? (-> any/c boolean?)]
[modality? (-> any/c boolean?)] [modality? (-> any/c boolean?)]
[mode? (-> any/c boolean?)] [mode? (-> any/c boolean?)]
[sbf/state? (-> any/c boolean?)]) [sbf/state? (-> any/c boolean?)])
@ -173,20 +171,46 @@
;;; state. ;;; state.
(define update-function/c (-> state? any/c)) (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 ;;; The domain mapping does not have to assign domains to all
;;; of the network definition. This is because the variables of some ;;; variables (e.g., it may be empty), but in this case the functions
;;; networks may have infinite domains, which can be restricted in ;;; which need to know the domains will not work.
;;; multiple different ways. (struct network (functions domains) #:transparent)
(define network? (hash/c variable? procedure?))
;;; 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. ;;; Given a state s updates all the variables from xs.
(define (update network s xs) (define (update network s xs)
(define funcs (network-functions network))
(for/fold ([new-s s]) (for/fold ([new-s s])
([x xs]) ([x xs])
(let ([f (hash-ref network x)]) (define fx (hash-ref funcs x))
(hash-set new-s x (f s))))) (hash-set new-s x (fx s))))
(module+ test (module+ test
(test-case "basic definitions" (test-case "basic definitions"
@ -195,7 +219,7 @@
(and x1 (not x2))))) (and x1 (not x2)))))
(define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)])
(not 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 s1 (make-state '((x1 . #t) (x2 . #f))))
(define new-s1 (update bn s1 '(x2 x1))) (define new-s1 (update bn s1 '(x2 x1)))
(define s2 (make-state '((x1 . #f) (x2 . #f)))) (define s2 (make-state '((x1 . #f) (x2 . #f))))
@ -218,6 +242,10 @@
[(cons var 0) (cons var #f)] [(cons var 0) (cons var #f)]
[(cons var 1) (cons var #t)])))) [(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 (module+ test
(test-case "make-state, make-state-booleanize, booleanize-state" (test-case "make-state, make-state-booleanize, booleanize-state"
(check-equal? (make-state-booleanize '((a . 0) (b . 1))) (check-equal? (make-state-booleanize '((a . 0) (b . 1)))
@ -225,13 +253,6 @@
(check-equal? (booleanize-state (make-state '((a . 0) (b . 1)))) (check-equal? (booleanize-state (make-state '((a . 0) (b . 1))))
(make-state '((a . #f) (b . #t)))))) (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 ;;; Syntactic description of networks
@ -242,9 +263,14 @@
;;; '(and x y (not z)) or '(+ 1 a (- b 10)). ;;; '(and x y (not z)) or '(+ 1 a (- b 10)).
(define update-function-form? any/c) (define update-function-form? any/c)
;;; A Boolean network form is a mapping from its variables to the ;;; A network form consists of a mapping from variables to the forms
;;; forms of their update functions. ;;; of their update functions, together with a mapping from its
(define network-form? variable-mapping?) ;;; 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. ;;; Build an update function from an update function form.
(define (update-function-form->update-function form) (define (update-function-form->update-function form)
@ -257,27 +283,46 @@
(check-equal? (f s) #f))) (check-equal? (f s) #f)))
;;; Build a network from a network form. ;;; Build a network from a network form.
(define (network-form->network bnf) (define (network-form->network nf)
(for/hash ([(x form) bnf]) (network
(values x (update-function-form->update-function form)))) (for/hash ([(x form) (in-hash (network-form-forms nf))])
(values x (update-function-form->update-function form)))
(network-form-domains nf)))
(module+ test (module+ test
(test-case "network-form->network" (test-case "network-form->network"
(define bn (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)))) (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. ;;; Build a Boolean network form from a given mapping assigning forms
(define (make-network-from-forms forms) ;;; to variables.
(network-form->network (make-immutable-hash forms))) (define (make-boolean-network-form forms)
(network-form forms (make-boolean-domains (hash-keys forms))))
(module+ test (module+ test
(test-case "make-network-from-forms" (test-case "make-boolean-network-form"
(define bn (make-network-from-forms '((a . (and a b)) (check-equal? (make-boolean-network-form (hash 'a '(and a b)
(b . (not b))))) 'b '(not b)))
(define s (make-state '((a . #t) (b . #t)))) (network-form
(check-equal? ((hash-ref bn 'a) s) #t))) '#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 ;;; graphs is based on analysing the dynamics of the networks, it may
;;; be quite resource-consuming, especially since I allow any ;;; be quite resource-consuming, especially since I allow any
;;; syntactic forms in the definitions of the functions. ;;; 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 ;;; Lists the variables of the network form appearing in the update
;;; function form for x. ;;; function form for x.
(define (list-syntactic-interactions nf x) (define (list-syntactic-interactions nf x)
(set-intersect (set-intersect
(extract-symbols (hash-ref nf x)) (extract-symbols (hash-ref (network-form-forms nf) x))
(hash-keys nf))) (hash-keys (network-form-forms nf))))
(module+ test (module+ test
(test-case "list-syntactic-interactions" (test-case "list-syntactic-interactions"
(define n #hash((a . (+ a b c)) (define n (make-boolean-network-form #hash((a . (+ a b c))
(b . (- b c)))) (b . (- b c)))))
(check-true (set=? (list-syntactic-interactions n 'a) '(a b))) (check-true (set=? (list-syntactic-interactions n 'a) '(a b)))
(check-true (set=? (list-syntactic-interactions n 'b) '(b))))) (check-true (set=? (list-syntactic-interactions n 'b) '(b)))))
@ -320,12 +374,13 @@
(define (build-syntactic-interaction-graph n) (define (build-syntactic-interaction-graph n)
(transpose (transpose
(unweighted-graph/adj (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 (module+ test
(test-case "build-syntactic-interaction-graph" (test-case "build-syntactic-interaction-graph"
(define n #hash((a . (+ a b c)) (define n (make-boolean-network-form #hash((a . (+ a b c))
(b . (- b c)))) (b . (- b c)))))
(define ig (build-syntactic-interaction-graph n)) (define ig (build-syntactic-interaction-graph n))
(check-true (has-vertex? ig 'a)) (check-true (has-vertex? ig 'a))
(check-true (has-vertex? ig 'b)) (check-true (has-vertex? ig 'b))
@ -336,10 +391,6 @@
(check-false (has-edge? ig 'c 'b)) (check-false (has-edge? ig 'c 'b))
(check-false (has-edge? ig 'c 'a)))) (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 ;;; Given a hash-set mapping variables to generic sets of their
;;; possible values, constructs the list of all possible states. ;;; possible values, constructs the list of all possible states.
(define (build-all-states vars-domains) (define (build-all-states vars-domains)
@ -412,10 +463,11 @@
;;; interact, i.e. that there exists such a state s with the property ;;; 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 ;;; 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). ;;; 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 states-not-x (build-all-states (hash-remove doms x)))
(define dom-x (hash-ref 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 (different-ys-exist? st)
(define x-states (for/list ([x-val (in-list dom-x)]) (define x-states (for/list ([x-val (in-list dom-x)])
(hash-set st x x-val))) (hash-set st x x-val)))
@ -430,20 +482,19 @@
(module+ test (module+ test
(test-case "interaction?" (test-case "interaction?"
(define n-bool (network-form->network (define n1 (forms->boolean-network
(hash 'x '(not y) (hash 'x '(not y)
'y 'x 'y 'x
'z '(and y z)))) 'z '(and y z))))
(define bool-doms (make-boolean-domains '(x y z))) (check-true (interaction? n1 'x 'y))
(check-true (interaction? n-bool bool-doms 'x 'y)) (check-true (interaction? n1 'y 'x))
(check-true (interaction? n-bool bool-doms 'y 'x)) (check-false (interaction? n1 'x 'z))
(check-false (interaction? n-bool bool-doms 'x 'z)) (define n-multi (hash 'x '(max (+ y 1) 2)
(define n-multi (network-form->network 'y '(min (- y 1) 0)))
(hash 'x '(max (+ y 1) 2)
'y '(min (- y 1) 0))))
(define 123-doms (make-same-domains '(x y) '(0 1 2))) (define 123-doms (make-same-domains '(x y) '(0 1 2)))
(check-false (interaction? n-multi 123-doms 'x 'y)) (define n2 (network-form->network (network-form n-multi 123-doms)))
(check-true (interaction? n-multi 123-doms 'y 'x)))) (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 ;;; 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 ;;; 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 ;;; Use interaction? if you only need to know whether two variables
;;; interact, because interaction? will be often faster. ;;; 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-x (hash-ref doms x))
(define dom-y (hash-ref doms y)) (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) (define (collect-impacts-on-y st)
;; The way in which the values are ordered in the domains gives ;; The way in which the values are ordered in the domains gives
;; a total order on these values. This means that considering ;; a total order on these values. This means that considering
@ -489,45 +541,44 @@
(module+ test (module+ test
(test-case "get-interaction-sign" (test-case "get-interaction-sign"
(define n-bool (network-form->network (define n1 (forms->boolean-network
(hash 'x '(not y) (hash 'x '(not y)
'y 'x 'y 'x
'z '(and y z) 'z '(and y z)
't '(or (and (not x) y) 't '(or (and (not x) y)
(and x (not y)))))) (and x (not y))))))
(define bool-doms (make-boolean-domains '(x y z t))) (check-equal? (get-interaction-sign n1 'x 'y) 1)
(check-equal? (get-interaction-sign n-bool bool-doms 'x 'y) 1) (check-equal? (get-interaction-sign n1 'y 'x) -1)
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1) (check-false (get-interaction-sign n1 'x 'z))
(check-false (get-interaction-sign n-bool bool-doms 'x 'z)) (check-equal? (get-interaction-sign n1 'y 'z) 1)
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'z) 1) (check-equal? (get-interaction-sign n1 'x 't) 0)
(check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0) (define n-multi (hash 'x '(min (+ y 1) 2)
(define n-multi (network-form->network 'y '(max (- y 1) 0)
(hash 'x '(min (+ y 1) 2) 'z '(- 2 y)
'y '(max (- y 1) 0) 't '(abs (- y 1))))
'z '(- 2 y)
't '(abs (- y 1)))))
(define 123-doms (make-same-domains '(x y z t) '(0 1 2))) (define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
(check-false (get-interaction-sign n-multi 123-doms 'x 'y)) (define n2 (network-form->network (network-form n-multi 123-doms)))
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1) (check-false (get-interaction-sign n2 'x 'y))
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1) (check-equal? (get-interaction-sign n2 'y 'x) 1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0) (check-equal? (get-interaction-sign n2 'y 'z) -1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'y) 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 ;;; Given a network, builds its interaction graph. The graph has
;;; variables as nodes and has a directed edge from x to y if ;;; variables as nodes and has a directed edge from x to y if
;;; interaction? returns #t for these variables, in this order. ;;; interaction? returns #t for these variables, in this order.
(define (build-interaction-graph network doms) (define (build-interaction-graph network)
(define vars (hash-keys network)) (define vars (hash-keys (network-functions network)))
(unweighted-graph/directed (unweighted-graph/directed
(for*/list ([x (in-list vars)] (for*/list ([x (in-list vars)]
[y (in-list vars)] [y (in-list vars)]
#:when (interaction? network doms x y)) #:when (interaction? network x y))
(list x y)))) (list x y))))
;;; Like build-interaction-graph, but accepts a network form and ;;; Like build-interaction-graph, but accepts a network form and
;;; converts it a to a network. ;;; converts it a to a network.
(define (build-interaction-graph/form form doms) (define build-interaction-graph/form
(build-interaction-graph (network-form->network form) doms)) (compose build-interaction-graph network-form->network))
(module+ test (module+ test
(test-case "build-interaction-graph" (test-case "build-interaction-graph"
@ -535,41 +586,40 @@
[skip-expensive-tests? [skip-expensive-tests?
(displayln "Skipping test case build-interaction-graph.")] (displayln "Skipping test case build-interaction-graph.")]
[else [else
(define n-bool (define n1 (make-boolean-network-form
(hash 'x '(not y) (hash 'x '(not y)
'y 'x 'y 'x
'z '(and y z) 'z '(and y z)
't '(or (and (not x) y) 't '(or (and (not x) y)
(and x (not y))))) (and x (not y))))))
(define bool-doms (make-boolean-domains '(x y z t))) (check-equal? (graphviz (build-interaction-graph/form n1))
(check-equal? (graphviz (build-interaction-graph/form n-bool bool-doms))
"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") "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 (define n-multi (hash 'x '(min (+ y 1) 2)
(hash 'x '(min (+ y 1) 2) 'y '(max (- y 1) 0)
'y '(max (- y 1) 0) 'z '(- 2 y)
'z '(- 2 y) 't '(abs (- y 1))))
't '(abs (- y 1))))
(define 123-doms (make-same-domains '(x y z t) '(0 1 2))) (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")]))) "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 ;;; Given a network, builds its signed interaction graph. The graph
;;; has variables as nodes and has a directed edge from x to ;;; has variables as nodes and has a directed edge from x to
;;; y labelled by the value get-interaction-sign for these variables, ;;; y labelled by the value get-interaction-sign for these variables,
;;; in that order, unless this value is #f. ;;; in that order, unless this value is #f.
(define (build-signed-interaction-graph network doms) (define (build-signed-interaction-graph network)
(define vars (hash-keys network)) (define vars (hash-keys (network-functions network)))
(weighted-graph/directed (weighted-graph/directed
(for*/list ([x (in-list vars)] (for*/list ([x (in-list vars)]
[y (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)) #:unless (eq? sign #f))
(list sign x y)))) (list sign x y))))
;;; Like build-signed-interaction-graph, but takes a network form and ;;; Like build-signed-interaction-graph, but takes a network form and
;;; converts it a to a network. ;;; converts it a to a network.
(define (build-signed-interaction-graph/form form doms) (define build-signed-interaction-graph/form
(build-signed-interaction-graph (network-form->network form) doms)) (compose build-signed-interaction-graph network-form->network))
(module+ test (module+ test
(test-case "build-signed-interaction-graph" (test-case "build-signed-interaction-graph"
@ -577,22 +627,21 @@
[skip-expensive-tests? [skip-expensive-tests?
(displayln "Skipping test case build-signed-interaction-graph.")] (displayln "Skipping test case build-signed-interaction-graph.")]
[else [else
(define n-bool (define n1 (make-boolean-network-form
(hash 'x '(not y) (hash 'x '(not y)
'y 'x 'y 'x
'z '(and y z) 'z '(and y z)
't '(or (and (not x) y) 't '(or (and (not x) y)
(and x (not y))))) (and x (not y))))))
(define bool-doms (make-boolean-domains '(x y z t))) (check-equal? (graphviz (build-signed-interaction-graph/form n1))
(check-equal? (graphviz (build-signed-interaction-graph/form n-bool bool-doms))
"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") "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 (define n-multi (hash 'x '(min (+ y 1) 2)
(hash 'x '(min (+ y 1) 2) 'y '(max (- y 1) 0)
'y '(max (- y 1) 0) 'z '(- 2 y)
'z '(- 2 y) 't '(abs (- y 1))))
't '(abs (- y 1))))
(define 123-doms (make-same-domains '(x y z t) '(0 1 2))) (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")]))) "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 ;;; Given a network, applies a function for building a mode to its
;;; variables and returns the corresponding network dynamics. ;;; variables and returns the corresponding network dynamics.
(define (make-dynamics-from-func network mode-func) (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. ;;; Creates the asynchronous dynamics for a given network.
(define (make-asyn-dynamics network) (define (make-asyn-dynamics network)
@ -646,7 +695,7 @@
(module+ test (module+ test
(test-case "make-asyn-dynamics, make-syn-dynamics" (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 asyn (make-asyn-dynamics n))
(define syn (make-syn-dynamics n)) (define syn (make-syn-dynamics n))
(check-equal? (dynamics-network asyn) n) (check-equal? (dynamics-network asyn) n)
@ -654,14 +703,6 @@
(check-equal? (dynamics-network syn) n) (check-equal? (dynamics-network syn) n)
(check-equal? (dynamics-mode syn) (set (set 'a 'b))))) (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. ;;; Pretty-prints a state of the network.
(define (pretty-print-state s) (define (pretty-print-state s)
(string-join (hash-map s (λ (key val) (format "~a:~a" key val)) #t))) (string-join (hash-map s (λ (key val) (format "~a:~a" key val)) #t)))
@ -701,20 +742,26 @@
(define ppsgb pretty-print-boolean-state-graph) (define ppsgb pretty-print-boolean-state-graph)
;;; Builds the full state graph of a Boolean network. ;;; 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 (dds-build-state-graph
dyn 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. ;;; 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 (dds-build-state-graph-annotated
dyn 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 (module+ test
(test-case "Dynamics of networks" (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 asyn (make-asyn-dynamics n))
(define syn (make-syn-dynamics n)) (define syn (make-syn-dynamics n))
(define s (make-state '((a . #t) (b . #f)))) (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 (dds-build-state-graph asyn (set s)))
(define gr-full-pp (pretty-print-state-graph gr-full)) (define gr-full-pp (pretty-print-state-graph gr-full))
(define gr-full-ppb (pretty-print-boolean-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 (build-full-state-graph asyn))
(define gr-complete-bool-ann (build-full-boolean-state-graph-annotated 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))) (check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f)))
(make-state '((a . #t) (b . #f))))) (make-state '((a . #t) (b . #f)))))
(check-equal? (dds-step-one-annotated asyn s) (check-equal? (dds-step-one-annotated asyn s)
@ -801,20 +848,6 @@
#hash((a . #f) (b . #t)) #hash((a . #t) (b . #t))) #hash((a . #f) (b . #t)) #hash((a . #t) (b . #t)))
(set (set 'a))))) (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 ;;; Tabulating functions and networks
@ -887,13 +920,13 @@
;;; network. If headers is #t, prepends a list of variable names and ;;; network. If headers is #t, prepends a list of variable names and
;;; update functions (f-x, where x is the name of the corresponding ;;; update functions (f-x, where x is the name of the corresponding
;;; variable) to the result. ;;; 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 ;; I use hash-map with try-order? set to #t to ask the hash table to
;; sort the keys for me. ;; sort the keys for me.
(define-values (vars funcs) (for/lists (l1 l2) (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)))) (values (car pair) (cdr pair))))
(define tab (tabulate-state* funcs domains #:headers headers)) (define tab (tabulate-state* funcs (network-domains network) #:headers headers))
(cond (cond
[headers [headers
;; Replace the names of the functions tabulate-state* gave us by ;; Replace the names of the functions tabulate-state* gave us by
@ -904,17 +937,12 @@
(cons (append (take hdrs (length vars)) fnames) vals)])] (cons (append (take hdrs (length vars)) fnames) vals)])]
[else tab])) [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 (module+ test
(test-case "tabulate-boolean-network" (test-case "tabulate-network"
(define bn (network-form->network #hash((a . (not a)) (b . b)))) (define bn (forms->boolean-network #hash((a . (not a)) (b . b))))
(check-equal? (tabulate-boolean-network bn) (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))) '((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))))) '((#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 ;;; This function relies on table->function, so the same caveats
;;; apply. ;;; 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 (table->network table #:headers [headers #t])
(define n (/ (length (car table)) 2)) (define n (/ (length (car table)) 2))
;; Get the variable names from the table or generate them, if ;; Get the variable names from the table or generate them, if
@ -956,8 +988,15 @@
(define funcs (for/list ([out func-lines]) (define funcs (for/list ([out func-lines])
(table->function (for/list ([in st-ins] [o out]) (table->function (for/list ([in st-ins] [o out])
(list in o))))) (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. ;; 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 (module+ test
(test-case "table->network" (test-case "table->network"
@ -966,8 +1005,8 @@
(#f #t #f #t) (#f #t #f #t)
(#t #f #t #f) (#t #f #t #f)
(#t #t #t #t)))) (#t #t #t #t))))
(define f1 (hash-ref n 'x1)) (define f1 (hash-ref (network-functions n) 'x1))
(define f2 (hash-ref n 'x2)) (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 . #f)))))
(check-false (f1 (make-state '((x1 . #f) (x2 . #t))))) (check-false (f1 (make-state '((x1 . #f) (x2 . #t)))))
@ -977,7 +1016,10 @@
(check-false (f2 (make-state '((x1 . #f) (x2 . #f))))) (check-false (f2 (make-state '((x1 . #f) (x2 . #f)))))
(check-true (f2 (make-state '((x1 . #f) (x2 . #t))))) (check-true (f2 (make-state '((x1 . #f) (x2 . #t)))))
(check-false (f2 (make-state '((x1 . #t) (x2 . #f))))) (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) (check-equal? (tabulate-state/boolean f '(x1 x2) #:headers #f)
'((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))) '((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t)))
(define bn (random-boolean-network/vars 3)) (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) '((x0 x1 x2 f-x0 f-x1 f-x2)
(#f #f #f #f #t #f) (#f #f #f #f #t #f)
(#f #f #t #t #f #f) (#f #f #t #t #f #f)
@ -1018,8 +1060,9 @@
;;; Generates a random network from the given domain mapping. ;;; Generates a random network from the given domain mapping.
(define (random-network domains) (define (random-network domains)
(for/hash ([(x x-dom) (in-hash domains)]) (network (for/hash ([(x x-dom) (in-hash domains)])
(values x (random-function/state domains x-dom)))) (values x (random-function/state domains x-dom)))
domains))
;;; Generates a random Boolean network with the given variables. ;;; Generates a random Boolean network with the given variables.
(define (random-boolean-network vars) (define (random-boolean-network vars)
@ -1379,8 +1422,8 @@
;;; Constructs a network from a network form defining a TBN. ;;; Constructs a network from a network form defining a TBN.
(define (tbn->network tbn) (define (tbn->network tbn)
(for/hash ([(var tbf) (in-hash tbn)]) (make-01-network (for/hash ([(var tbf) (in-hash tbn)])
(values var ((curry apply-tbf/state) tbf)))) (values var ((curry apply-tbf/state) tbf)))))
(module+ test (module+ test
(test-case "tbn->network" (test-case "tbn->network"
@ -1390,13 +1433,15 @@
(define s1 (make-state '((a . 0) (b . 0)))) (define s1 (make-state '((a . 0) (b . 0))))
(check-equal? (update n s1 '(a b)) (check-equal? (update n s1 '(a b))
(make-state '((a . 0) (b . 1)))) (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)))) (define sbn (make-sbn `((a . ,(make-sbf/state '((b . -1))))
(b . ,(make-sbf/state '((a . 1))))))) (b . ,(make-sbf/state '((a . 1)))))))
(define sn (tbn->network sbn)) (define sn (tbn->network sbn))
(define s2 (make-state '((a . 1) (b . 1)))) (define s2 (make-state '((a . 1) (b . 1))))
(check-equal? (update sn s2 '(a b)) (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 ;;; 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. ;;; 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. ;;; A shortcut for building the state graphs of TBN.
(define build-tbn-state-graph (define build-tbn-state-graph
(compose pretty-print-state-graph (compose pretty-print-state-graph
build-full-01-state-graph build-full-state-graph
make-syn-dynamics make-syn-dynamics
tbn->network)) tbn->network))