Merge branch 'network-domains'
This commit is contained in:
Sergiu Ivanov
commit
34fe8a8316
47
example/dots/example1FH1rZ.svg
Normal file
47
example/dots/example1FH1rZ.svg
Normal 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->node0 -->
|
||||||
|
<g id="edge1" class="edge">
|
||||||
|
<title>node0->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->node1 -->
|
||||||
|
<g id="edge3" class="edge">
|
||||||
|
<title>node0->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->node2 -->
|
||||||
|
<g id="edge2" class="edge">
|
||||||
|
<title>node1->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 |
|
|
@ -130,7 +130,7 @@
|
||||||
<g id="edge9" class="edge">
|
<g id="edge9" class="edge">
|
||||||
<title>node4->node4</title>
|
<title>node4->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->node6 -->
|
<!-- node4->node6 -->
|
||||||
<g id="edge16" class="edge">
|
<g id="edge16" class="edge">
|
||||||
|
|
|
||||||
|
Before Width: | Height: | Size: 8.9 KiB After Width: | Height: | Size: 8.9 KiB |
|
|
@ -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->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->node2 -->
|
|
||||||
<g id="edge1" class="edge">
|
<g id="edge1" class="edge">
|
||||||
<title>node0->node2</title>
|
<title>node0->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->node1 -->
|
||||||
|
<g id="edge2" class="edge">
|
||||||
|
<title>node0->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->node2 -->
|
||||||
|
<g id="edge5" class="edge">
|
||||||
|
<title>node0->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->node1 -->
|
||||||
|
<g id="edge3" class="edge">
|
||||||
|
<title>node1->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">-1</text>
|
||||||
</g>
|
</g>
|
||||||
<!-- node1->node2 -->
|
<!-- node1->node2 -->
|
||||||
<g id="edge2" class="edge">
|
<g id="edge6" class="edge">
|
||||||
<title>node1->node2</title>
|
<title>node1->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->node0 -->
|
||||||
|
<g id="edge7" class="edge">
|
||||||
|
<title>node2->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->node1 -->
|
||||||
|
<g id="edge8" class="edge">
|
||||||
|
<title>node2->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->node2 -->
|
||||||
|
<g id="edge4" class="edge">
|
||||||
|
<title>node2->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>
|
||||||
|
|
|
||||||
|
Before Width: | Height: | Size: 2.0 KiB After Width: | Height: | Size: 4.1 KiB |
|
|
@ -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
435
networks.rkt
|
|
@ -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))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user