networks: Add build-interaction-graph.
This commit is contained in:
parent
ff9654e5c6
commit
d190f76fdf
1 changed files with 32 additions and 0 deletions
32
networks.rkt
32
networks.rkt
|
@ -33,6 +33,7 @@
|
|||
[build-syntactic-interaction-graph (-> network-form? graph?)]
|
||||
[interaction? (-> network? domain-mapping/c variable? variable? boolean?)]
|
||||
[get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))]
|
||||
[build-interaction-graph (-> network? domain-mapping/c graph?)]
|
||||
[build-all-states (-> domain-mapping/c (listof state?))]
|
||||
[make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
|
||||
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
|
||||
|
@ -504,6 +505,37 @@
|
|||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1)
|
||||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0)))
|
||||
|
||||
;;; 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 doms)
|
||||
(define vars (hash-keys network))
|
||||
(unweighted-graph/directed
|
||||
(for*/list ([x vars]
|
||||
[y vars]
|
||||
#:when (interaction? network doms x y))
|
||||
(list x y))))
|
||||
|
||||
(module+ test
|
||||
(test-case "build-interaction-graph"
|
||||
(define n-bool (network-form->network
|
||||
(hash 'x '(not y)
|
||||
'y 'x
|
||||
'z '(and y z)
|
||||
't '(or (and (not x) y)
|
||||
(and x (not y))))))
|
||||
(define bool-doms (make-boolean-domains '(x y z t)))
|
||||
(check-equal? (graphviz (build-interaction-graph 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")
|
||||
(define n-multi (network-form->network
|
||||
(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)))
|
||||
(check-equal? (graphviz (build-interaction-graph 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;\n\t}\n\tsubgraph D {\n\t\tnode0 -> node2;\n\t\tnode0 -> node3;\n\t\tnode0 -> node1;\n\t}\n}\n")))
|
||||
|
||||
;;; ====================
|
||||
;;; Dynamics of networks
|
||||
;;; ====================
|
||||
|
|
Loading…
Reference in a new issue