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

Type build-interaction-graph and build-interaction-graph/form.

This commit is contained in:
Sergiu Ivanov 2022-07-05 22:46:02 +02:00
parent 2424e155fd
commit f2f0564f72
2 changed files with 68 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
networks.rkt
View File

@ -5,7 +5,10 @@
typed/graph racket/random)
(module+ test
(require typed/rackunit))
(require typed/rackunit)
(define skip-expensive-tests? #f)
(unless skip-expensive-tests?
(displayln "Running the complete test suite...")))
(provide
State UpdateFunction Domain DomainMapping
@ -26,7 +29,8 @@
build-all-states build-all-boolean-states build-all-01-states
list-syntactic-interactions build-syntactic-interaction-graph
interaction? get-interaction-sign
interaction? get-interaction-sign build-interaction-graph
build-interaction-graph/form
)
(define-type (State a) (VariableMapping a))
@ -427,6 +431,43 @@
(check-equal? (get-interaction-sign n2 'y 'z) -1)
(check-equal? (get-interaction-sign n2 'y 't) 0)
(check-equal? (get-interaction-sign n2 'y 'y) 1)))
(: build-interaction-graph (All (a) (-> (Network a) Graph)))
(define (build-interaction-graph network)
(define vars (hash-keys (network-functions network)))
(unweighted-graph/directed
(for*/list : (Listof (List Any Any))
([x (in-list vars)]
[y (in-list vars)]
#:when (interaction? network x y))
(list x y))))
(: build-interaction-graph/form (All (a) (-> (NetworkForm a) Graph)))
(define (build-interaction-graph/form form)
(build-interaction-graph (network-form->network/any form)))
(module+ test
(test-case "build-interaction-graph"
(cond
[skip-expensive-tests?
(displayln "Skipping test case build-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-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\tnode0 -> node3 [];\n\t\tnode2 -> node2 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode3 -> node1 [];\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-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")])))
)
(require 'typed)
@ -585,46 +626,6 @@
;;; Inferring interaction graphs
;;; ============================
;;; Given a network, builds its interaction graph. The graph has
;;; variables as nodes and has a directed edge from x to y if
;;; interaction? returns #t for these variables, in this order.
(define (build-interaction-graph network)
(define vars (hash-keys (network-functions network)))
(unweighted-graph/directed
(for*/list ([x (in-list vars)]
[y (in-list vars)]
#:when (interaction? network x y))
(list x y))))
;;; Like build-interaction-graph, but accepts a network form and
;;; converts it a to a network.
(define build-interaction-graph/form
(compose build-interaction-graph network-form->network/any))
(module+ test
(test-case "build-interaction-graph"
(cond
[skip-expensive-tests?
(displayln "Skipping test case build-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-interaction-graph/form n1))
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node2;\n\t\tnode1 -> node1;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t\tnode2 -> node3;\n\t}\n}\n")
(define n-multi (hash 'x '(min (+ y 1) 2)
'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-interaction-graph/form n2))
"digraph G {\n\tnode0 [label=\"y\"];\n\tnode1 [label=\"z\"];\n\tnode2 [label=\"x\"];\n\tnode3 [label=\"t\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t}\n}\n")])))
;;; Given a network, builds its signed interaction graph. The graph
;;; has variables as nodes and has a directed edge from x to
;;; y labelled by the value get-interaction-sign for these variables,

25
scribblings/networks.scrbl
View File

@ -458,6 +458,31 @@ between @racket[x] and @racket[y], it is more costly than calling
(get-interaction-sign bn 'b 'a)
(get-interaction-sign bn 'b 'b)))
]}
@defproc[(build-interaction-graph [network (Network a)]) Graph]{
Given a network, builds its interaction graph. The graph has variables as
nodes and has a directed edge from @italic{x} to @italic{y} if
@racket[interaction?] returns @racket[#t] for these variables, in this order.
@ex[
(dotit (build-interaction-graph
(forms->boolean-network #hash((a . (and a b))
(b . (not b))))))
]}
@defproc[(build-interaction-graph/form [nf (NetworkForm a)]) Graph]{
Like @racket[build-interaction-graph], but accepts a network form and
converts it a to @racket[(Network a)] first.
@ex[
(dotit (build-interaction-graph/form
(make-boolean-network-form #hash((a . (and a b))
(b . (not b))))))
]}
@section{Tabulating functions and networks}
@section{Constructing functions and networks}