Type build-signed-interaction-graph and build-signed-interaction-graph/form.
This commit is contained in:
parent
f2f0564f72
commit
25411043c1
2 changed files with 70 additions and 53 deletions
86
networks.rkt
86
networks.rkt
|
@ -30,7 +30,8 @@
|
||||||
|
|
||||||
list-syntactic-interactions build-syntactic-interaction-graph
|
list-syntactic-interactions build-syntactic-interaction-graph
|
||||||
interaction? get-interaction-sign build-interaction-graph
|
interaction? get-interaction-sign build-interaction-graph
|
||||||
build-interaction-graph/form
|
build-interaction-graph/form build-signed-interaction-graph
|
||||||
|
build-signed-interaction-graph/form
|
||||||
)
|
)
|
||||||
|
|
||||||
(define-type (State a) (VariableMapping a))
|
(define-type (State a) (VariableMapping a))
|
||||||
|
@ -468,6 +469,44 @@
|
||||||
(define n2 (network-form n-multi 123-doms))
|
(define n2 (network-form n-multi 123-doms))
|
||||||
(check-equal? (graphviz (build-interaction-graph/form n2))
|
(check-equal? (graphviz (build-interaction-graph/form n2))
|
||||||
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode0 -> node3 [];\n\t}\n}\n")])))
|
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode0 -> node3 [];\n\t}\n}\n")])))
|
||||||
|
|
||||||
|
(: build-signed-interaction-graph (All (a) (-> (Network a) Graph)))
|
||||||
|
(define (build-signed-interaction-graph network)
|
||||||
|
(define vars (hash-keys (network-functions network)))
|
||||||
|
(weighted-graph/directed
|
||||||
|
(for*/list : (Listof (List Integer Any Any))
|
||||||
|
([x (in-list vars)]
|
||||||
|
[y (in-list vars)]
|
||||||
|
[sign (in-value (get-interaction-sign network x y))]
|
||||||
|
#:unless (eq? sign #f))
|
||||||
|
(list sign x y))))
|
||||||
|
|
||||||
|
(: build-signed-interaction-graph/form (All (a) (-> (NetworkForm a) Graph)))
|
||||||
|
(define (build-signed-interaction-graph/form nf)
|
||||||
|
(build-signed-interaction-graph (network-form->network/any nf)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "build-signed-interaction-graph"
|
||||||
|
(cond
|
||||||
|
[skip-expensive-tests?
|
||||||
|
(displayln "Skipping test case build-signed-interaction-graph.")]
|
||||||
|
[else
|
||||||
|
(define n1 (make-boolean-network-form
|
||||||
|
(hash 'x '(not y)
|
||||||
|
'y 'x
|
||||||
|
'z '(and y z)
|
||||||
|
't '(or (and (not x) y)
|
||||||
|
(and x (not y))))))
|
||||||
|
(check-equal? (graphviz (build-signed-interaction-graph/form n1))
|
||||||
|
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode2 -> node2 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"-1\"];\n\t\tnode3 -> node1 [label=\"0\"];\n\t\tnode3 -> node0 [label=\"1\"];\n\t}\n}\n")
|
||||||
|
(define n-multi (hash 'x '(min (+ y 1) 2)
|
||||||
|
'y '(max (- y 1) 0)
|
||||||
|
'z '(- 2 y)
|
||||||
|
't '(abs (- y 1))))
|
||||||
|
(define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
|
||||||
|
(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=\"t\"];\n\tnode2 [label=\"z\"];\n\tnode3 [label=\"x\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"1\"];\n\t}\n}\n")])))
|
||||||
)
|
)
|
||||||
|
|
||||||
(require 'typed)
|
(require 'typed)
|
||||||
|
@ -622,51 +661,6 @@
|
||||||
(define update-function-form? any/c)
|
(define update-function-form? any/c)
|
||||||
|
|
||||||
|
|
||||||
;;; ============================
|
|
||||||
;;; Inferring interaction graphs
|
|
||||||
;;; ============================
|
|
||||||
|
|
||||||
;;; Given a network, builds its signed interaction graph. The graph
|
|
||||||
;;; has variables as nodes and has a directed edge from x to
|
|
||||||
;;; y labelled by the value get-interaction-sign for these variables,
|
|
||||||
;;; in that order, unless this value is #f.
|
|
||||||
(define (build-signed-interaction-graph network)
|
|
||||||
(define vars (hash-keys (network-functions network)))
|
|
||||||
(weighted-graph/directed
|
|
||||||
(for*/list ([x (in-list vars)]
|
|
||||||
[y (in-list vars)]
|
|
||||||
[sign (in-value (get-interaction-sign network x y))]
|
|
||||||
#:unless (eq? sign #f))
|
|
||||||
(list sign x y))))
|
|
||||||
|
|
||||||
;;; Like build-signed-interaction-graph, but takes a network form and
|
|
||||||
;;; converts it a to a network.
|
|
||||||
(define build-signed-interaction-graph/form
|
|
||||||
(compose build-signed-interaction-graph network-form->network/any))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "build-signed-interaction-graph"
|
|
||||||
(cond
|
|
||||||
[skip-expensive-tests?
|
|
||||||
(displayln "Skipping test case build-signed-interaction-graph.")]
|
|
||||||
[else
|
|
||||||
(define n1 (make-boolean-network-form
|
|
||||||
(hash 'x '(not y)
|
|
||||||
'y 'x
|
|
||||||
'z '(and y z)
|
|
||||||
't '(or (and (not x) y)
|
|
||||||
(and x (not y))))))
|
|
||||||
(check-equal? (graphviz (build-signed-interaction-graph/form n1))
|
|
||||||
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode1 -> node1 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"0\"];\n\t\tnode0 -> node1 [label=\"1\"];\n\t\tnode2 -> node3 [label=\"0\"];\n\t\tnode2 -> node0 [label=\"1\"];\n\t}\n}\n")
|
|
||||||
(define n-multi (hash 'x '(min (+ y 1) 2)
|
|
||||||
'y '(max (- y 1) 0)
|
|
||||||
'z '(- 2 y)
|
|
||||||
't '(abs (- y 1))))
|
|
||||||
(define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
|
|
||||||
(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")])))
|
|
||||||
|
|
||||||
;;; ====================
|
;;; ====================
|
||||||
;;; Dynamics of networks
|
;;; Dynamics of networks
|
||||||
;;; ====================
|
;;; ====================
|
||||||
|
|
|
@ -482,6 +482,29 @@ converts it a to @racket[(Network a)] first.
|
||||||
(b . (not b))))))
|
(b . (not b))))))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(build-signed-interaction-graph [network (Network a)]) Graph]{
|
||||||
|
|
||||||
|
Given a network, builds its signed interaction graph. The graph has variables
|
||||||
|
as nodes and has a directed edge from @italic{x} to @racket{y} labelled by the
|
||||||
|
value @racket[get-interaction-sign] produces for these variables, in that
|
||||||
|
order, unless this value is @racket[#f].
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(dotit (build-signed-interaction-graph
|
||||||
|
(forms->boolean-network #hash((a . (and a b))
|
||||||
|
(b . (not b))))))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(build-signed-interaction-graph/form [nf (NetworkForm a)]) Graph]{
|
||||||
|
|
||||||
|
Like @racket[build-signed-interaction-graph], but takes a network form and
|
||||||
|
converts it to a network.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(dotit (build-signed-interaction-graph/form
|
||||||
|
(make-boolean-network-form #hash((a . (and a b))
|
||||||
|
(b . (not b))))))
|
||||||
|
]}
|
||||||
|
|
||||||
@section{Tabulating functions and networks}
|
@section{Tabulating functions and networks}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue