networks: Add build-signed-interaction-graph/form.
This commit is contained in:
parent
0345cd3648
commit
fe0fbc3ed0
1 changed files with 19 additions and 13 deletions
18
networks.rkt
18
networks.rkt
|
@ -36,6 +36,7 @@
|
||||||
[build-interaction-graph (-> network? domain-mapping/c graph?)]
|
[build-interaction-graph (-> network? domain-mapping/c graph?)]
|
||||||
[build-interaction-graph/form (-> network-form? domain-mapping/c graph?)]
|
[build-interaction-graph/form (-> network-form? domain-mapping/c graph?)]
|
||||||
[build-signed-interaction-graph (-> network? domain-mapping/c graph?)]
|
[build-signed-interaction-graph (-> network? domain-mapping/c graph?)]
|
||||||
|
[build-signed-interaction-graph/form (-> network-form? domain-mapping/c 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)))]
|
||||||
|
@ -556,24 +557,29 @@
|
||||||
#: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
|
||||||
|
;;; converts it a to a network.
|
||||||
|
(define (build-signed-interaction-graph/form form doms)
|
||||||
|
(build-signed-interaction-graph (network-form->network form) doms))
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(test-case "build-signed-interaction-graph"
|
(test-case "build-signed-interaction-graph"
|
||||||
(define n-bool (network-form->network
|
(define n-bool
|
||||||
(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)))
|
(define bool-doms (make-boolean-domains '(x y z t)))
|
||||||
(check-equal? (graphviz (build-signed-interaction-graph n-bool bool-doms))
|
(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 (network-form->network
|
(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 n-multi 123-doms))
|
(check-equal? (graphviz (build-signed-interaction-graph/form n-multi 123-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 -> 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")))
|
||||||
|
|
||||||
;;; ====================
|
;;; ====================
|
||||||
|
|
Loading…
Reference in a new issue