networks: Update the IG-related functions.
IG = interaction graph
This commit is contained in:
Sergiu Ivanov
parent
393f1d2bba
commit
6fd3d41c7e
1 changed files with 81 additions and 79 deletions
120
networks.rkt
120
networks.rkt
|
|
@ -32,12 +32,12 @@
|
|||
[network-form->network (-> network-form? network?)]
|
||||
[list-syntactic-interactions (-> network-form? variable? (listof variable?))]
|
||||
[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-interaction-graph/form (-> network-form? domain-mapping/c graph?)]
|
||||
[build-signed-interaction-graph (-> network? domain-mapping/c graph?)]
|
||||
[build-signed-interaction-graph/form (-> network-form? domain-mapping/c graph?)]
|
||||
[interaction? (-> network? variable? variable? boolean?)]
|
||||
[get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
|
||||
[build-interaction-graph (-> network? graph?)]
|
||||
[build-interaction-graph/form (-> network-form? graph?)]
|
||||
[build-signed-interaction-graph (-> network? graph?)]
|
||||
[build-signed-interaction-graph/form (-> network-form? 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)))]
|
||||
|
|
@ -410,10 +410,11 @@
|
|||
;;; interact, i.e. that there exists such a state s with the property
|
||||
;;; that s' which is s with a different value for x yields such a new
|
||||
;;; state f(s') in which the value for y is different from f(s).
|
||||
(define (interaction? network doms x y)
|
||||
(define (interaction? network x y)
|
||||
(define doms (network-domains network))
|
||||
(define states-not-x (build-all-states (hash-remove doms x)))
|
||||
(define dom-x (hash-ref doms x))
|
||||
(define y-func (hash-ref network y))
|
||||
(define y-func (hash-ref (network-functions network) y))
|
||||
(define (different-ys-exist? st)
|
||||
(define x-states (for/list ([x-val (in-list dom-x)])
|
||||
(hash-set st x x-val)))
|
||||
|
|
@ -428,20 +429,20 @@
|
|||
|
||||
(module+ test
|
||||
(test-case "interaction?"
|
||||
(define n-bool (network-form->network
|
||||
(hash 'x '(not y)
|
||||
(define n-bool (hash 'x '(not y)
|
||||
'y 'x
|
||||
'z '(and y z))))
|
||||
'z '(and y z)))
|
||||
(define bool-doms (make-boolean-domains '(x y z)))
|
||||
(check-true (interaction? n-bool bool-doms 'x 'y))
|
||||
(check-true (interaction? n-bool bool-doms 'y 'x))
|
||||
(check-false (interaction? n-bool bool-doms 'x 'z))
|
||||
(define n-multi (network-form->network
|
||||
(hash 'x '(max (+ y 1) 2)
|
||||
'y '(min (- y 1) 0))))
|
||||
(define n1 (network-form->network (network-form n-bool bool-doms)))
|
||||
(check-true (interaction? n1 'x 'y))
|
||||
(check-true (interaction? n1 'y 'x))
|
||||
(check-false (interaction? n1 'x 'z))
|
||||
(define n-multi (hash 'x '(max (+ y 1) 2)
|
||||
'y '(min (- y 1) 0)))
|
||||
(define 123-doms (make-same-domains '(x y) '(0 1 2)))
|
||||
(check-false (interaction? n-multi 123-doms 'x 'y))
|
||||
(check-true (interaction? n-multi 123-doms 'y 'x))))
|
||||
(define n2 (network-form->network (network-form n-multi 123-doms)))
|
||||
(check-false (interaction? n2 'x 'y))
|
||||
(check-true (interaction? n2 'y 'x))))
|
||||
|
||||
;;; Given two variables x and y of a network f, checks whether they
|
||||
;;; interact, and if they interact, returns 1 if increasing x leads to
|
||||
|
|
@ -450,10 +451,11 @@
|
|||
;;;
|
||||
;;; Use interaction? if you only need to know whether two variables
|
||||
;;; interact, because interaction? will be often faster.
|
||||
(define (get-interaction-sign network doms x y)
|
||||
(define (get-interaction-sign network x y)
|
||||
(define doms (network-domains network))
|
||||
(define dom-x (hash-ref doms x))
|
||||
(define dom-y (hash-ref doms y))
|
||||
(define y-func (hash-ref network y))
|
||||
(define y-func (hash-ref (network-functions network) y))
|
||||
(define (collect-impacts-on-y st)
|
||||
;; The way in which the values are ordered in the domains gives
|
||||
;; a total order on these values. This means that considering
|
||||
|
|
@ -487,45 +489,45 @@
|
|||
|
||||
(module+ test
|
||||
(test-case "get-interaction-sign"
|
||||
(define n-bool (network-form->network
|
||||
(hash 'x '(not y)
|
||||
(define n-bool (hash 'x '(not y)
|
||||
'y 'x
|
||||
'z '(and y z)
|
||||
't '(or (and (not x) y)
|
||||
(and x (not y))))))
|
||||
(and x (not y)))))
|
||||
(define bool-doms (make-boolean-domains '(x y z t)))
|
||||
(check-equal? (get-interaction-sign n-bool bool-doms 'x 'y) 1)
|
||||
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1)
|
||||
(check-false (get-interaction-sign n-bool bool-doms 'x 'z))
|
||||
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'z) 1)
|
||||
(check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0)
|
||||
(define n-multi (network-form->network
|
||||
(hash 'x '(min (+ y 1) 2)
|
||||
(define n1 (network-form->network (network-form n-bool bool-doms)))
|
||||
(check-equal? (get-interaction-sign n1 'x 'y) 1)
|
||||
(check-equal? (get-interaction-sign n1 'y 'x) -1)
|
||||
(check-false (get-interaction-sign n1 'x 'z))
|
||||
(check-equal? (get-interaction-sign n1 'y 'z) 1)
|
||||
(check-equal? (get-interaction-sign n1 'x 't) 0)
|
||||
(define n-multi (hash 'x '(min (+ y 1) 2)
|
||||
'y '(max (- y 1) 0)
|
||||
'z '(- 2 y)
|
||||
't '(abs (- y 1)))))
|
||||
't '(abs (- y 1))))
|
||||
(define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
|
||||
(check-false (get-interaction-sign n-multi 123-doms 'x 'y))
|
||||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1)
|
||||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1)
|
||||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0)
|
||||
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'y) 1)))
|
||||
(define n2 (network-form->network (network-form n-multi 123-doms)))
|
||||
(check-false (get-interaction-sign n2 'x 'y))
|
||||
(check-equal? (get-interaction-sign n2 'y 'x) 1)
|
||||
(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)))
|
||||
|
||||
;;; 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))
|
||||
(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 doms x y))
|
||||
#: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 form doms)
|
||||
(build-interaction-graph (network-form->network form) doms))
|
||||
(define build-interaction-graph/form
|
||||
(compose build-interaction-graph network-form->network))
|
||||
|
||||
(module+ test
|
||||
(test-case "build-interaction-graph"
|
||||
|
|
@ -533,41 +535,41 @@
|
|||
[skip-expensive-tests?
|
||||
(displayln "Skipping test case build-interaction-graph.")]
|
||||
[else
|
||||
(define n-bool
|
||||
(hash 'x '(not y)
|
||||
(define n-bool (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/form n-bool bool-doms))
|
||||
(define n1 (network-form->network (network-form n-bool bool-doms)))
|
||||
(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)
|
||||
(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)))
|
||||
(check-equal? (graphviz (build-interaction-graph/form n-multi 123-doms))
|
||||
(define n2 (network-form->network (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,
|
||||
;;; in that order, unless this value is #f.
|
||||
(define (build-signed-interaction-graph network doms)
|
||||
(define vars (hash-keys network))
|
||||
(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 doms x y))]
|
||||
[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 form doms)
|
||||
(build-signed-interaction-graph (network-form->network form) doms))
|
||||
(define build-signed-interaction-graph/form
|
||||
(compose build-signed-interaction-graph network-form->network))
|
||||
|
||||
(module+ test
|
||||
(test-case "build-signed-interaction-graph"
|
||||
|
|
@ -575,22 +577,22 @@
|
|||
[skip-expensive-tests?
|
||||
(displayln "Skipping test case build-signed-interaction-graph.")]
|
||||
[else
|
||||
(define n-bool
|
||||
(hash 'x '(not y)
|
||||
(define n-bool (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-signed-interaction-graph/form n-bool bool-doms))
|
||||
(define n1 (network-form->network (network-form n-bool bool-doms)))
|
||||
(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)
|
||||
(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)))
|
||||
(check-equal? (graphviz (build-signed-interaction-graph/form n-multi 123-doms))
|
||||
(define n2 (network-form->network (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")])))
|
||||
|
||||
;;; ====================
|
||||
|
|
|
|||
Loading…
Reference in a new issue