Type build-signed-interaction-graph and build-signed-interaction-graph/form.
This commit is contained in:
Sergiu Ivanov
parent
f2f0564f72
commit
25411043c1
2 changed files with 70 additions and 53 deletions
100
networks.rkt
100
networks.rkt
|
|
@ -30,7 +30,8 @@
|
|||
|
||||
list-syntactic-interactions build-syntactic-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))
|
||||
|
|
@ -340,10 +341,10 @@
|
|||
(hash-set st x x-val)))
|
||||
;; TODO: Replace with for*/first when/if it is fixed.
|
||||
(for*/first/typed : (Option Boolean)
|
||||
([st1 : (State a) x-states]
|
||||
[st2 : (State a) x-states]
|
||||
#:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
|
||||
#:unless (equal? (y-func st1) (y-func st2)))
|
||||
([st1 : (State a) x-states]
|
||||
[st2 : (State a) x-states]
|
||||
#:unless (equal? (hash-ref st1 x) (hash-ref st2 x))
|
||||
#:unless (equal? (y-func st1) (y-func st2)))
|
||||
#t))
|
||||
;; TODO: Replace with for/first when/if it is fixed.
|
||||
(for/first/typed : (Option Boolean)
|
||||
|
|
@ -382,8 +383,8 @@
|
|||
([x-val (in-list dom-x)])
|
||||
(hash-set st x x-val)))
|
||||
(for/list : (Listof (U '< '> '=))
|
||||
([st1 (in-list x-states)]
|
||||
[st2 (in-list (cdr x-states))])
|
||||
([st1 (in-list x-states)]
|
||||
[st2 (in-list (cdr x-states))])
|
||||
(define y1-idx (assert-type (index-of dom-y (y-func st1)) Index))
|
||||
(define y2-idx (assert-type (index-of dom-y (y-func st2)) Index))
|
||||
(cond
|
||||
|
|
@ -394,7 +395,7 @@
|
|||
(define interactions
|
||||
(remove-duplicates
|
||||
(for/list : (Listof (U '< '> '= Zero))
|
||||
([st (in-list states-not-x)])
|
||||
([st (in-list states-not-x)])
|
||||
(define impacts (remove-duplicates (collect-impacts-on-y st)))
|
||||
(cond
|
||||
[(and (member '< impacts) (not (member '> impacts))) '<]
|
||||
|
|
@ -468,6 +469,44 @@
|
|||
(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=\"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)
|
||||
|
|
@ -622,51 +661,6 @@
|
|||
(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
|
||||
;;; ====================
|
||||
|
|
|
|||
|
|
@ -482,6 +482,29 @@ converts it a to @racket[(Network a)] first.
|
|||
(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}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue