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

networks: Update the IG-related functions.

Browse source 
IG = interaction graph
This commit is contained in:
Sergiu Ivanov 2020-11-22 21:06:33 +01:00
parent 393f1d2bba
commit 6fd3d41c7e
1 changed files with 81 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

160
networks.rkt
View file

@ -32,12 +32,12 @@
[network-form->network (-> network-form? network?)] [network-form->network (-> network-form? network?)]
[list-syntactic-interactions (-> network-form? variable? (listof variable?))] [list-syntactic-interactions (-> network-form? variable? (listof variable?))]
[build-syntactic-interaction-graph (-> network-form? graph?)] [build-syntactic-interaction-graph (-> network-form? graph?)]
[interaction? (-> network? domain-mapping/c variable? variable? boolean?)] [interaction? (-> network? variable? variable? boolean?)]
[get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))] [get-interaction-sign (-> network? variable? variable? (or/c #f -1 0 1))]
[build-interaction-graph (-> network? domain-mapping/c graph?)] [build-interaction-graph (-> network? graph?)]
[build-interaction-graph/form (-> network-form? domain-mapping/c graph?)] [build-interaction-graph/form (-> network-form? graph?)]
[build-signed-interaction-graph (-> network? domain-mapping/c graph?)] [build-signed-interaction-graph (-> network? graph?)]
[build-signed-interaction-graph/form (-> network-form? domain-mapping/c graph?)] [build-signed-interaction-graph/form (-> network-form? 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)))]
@ -410,10 +410,11 @@
;;; interact, i.e. that there exists such a state s with the property ;;; 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 ;;; 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). ;;; 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 states-not-x (build-all-states (hash-remove doms x)))
(define dom-x (hash-ref 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 (different-ys-exist? st)
(define x-states (for/list ([x-val (in-list dom-x)]) (define x-states (for/list ([x-val (in-list dom-x)])
(hash-set st x x-val))) (hash-set st x x-val)))
@ -428,20 +429,20 @@
(module+ test (module+ test
(test-case "interaction?" (test-case "interaction?"
(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))))
(define bool-doms (make-boolean-domains '(x y z))) (define bool-doms (make-boolean-domains '(x y z)))
(check-true (interaction? n-bool bool-doms 'x 'y)) (define n1 (network-form->network (network-form n-bool bool-doms)))
(check-true (interaction? n-bool bool-doms 'y 'x)) (check-true (interaction? n1 'x 'y))
(check-false (interaction? n-bool bool-doms 'x 'z)) (check-true (interaction? n1 'y 'x))
(define n-multi (network-form->network (check-false (interaction? n1 'x 'z))
(hash 'x '(max (+ y 1) 2) (define n-multi (hash 'x '(max (+ y 1) 2)
'y '(min (- y 1) 0)))) 'y '(min (- y 1) 0)))
(define 123-doms (make-same-domains '(x y) '(0 1 2))) (define 123-doms (make-same-domains '(x y) '(0 1 2)))
(check-false (interaction? n-multi 123-doms 'x 'y)) (define n2 (network-form->network (network-form n-multi 123-doms)))
(check-true (interaction? n-multi 123-doms 'y 'x)))) (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 ;;; 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 ;;; 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 ;;; Use interaction? if you only need to know whether two variables
;;; interact, because interaction? will be often faster. ;;; 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-x (hash-ref doms x))
(define dom-y (hash-ref doms y)) (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) (define (collect-impacts-on-y st)
;; The way in which the values are ordered in the domains gives ;; The way in which the values are ordered in the domains gives
;; a total order on these values. This means that considering ;; a total order on these values. This means that considering
@ -487,45 +489,45 @@
(module+ test (module+ test
(test-case "get-interaction-sign" (test-case "get-interaction-sign"
(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? (get-interaction-sign n-bool bool-doms 'x 'y) 1) (define n1 (network-form->network (network-form n-bool bool-doms)))
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1) (check-equal? (get-interaction-sign n1 'x 'y) 1)
(check-false (get-interaction-sign n-bool bool-doms 'x 'z)) (check-equal? (get-interaction-sign n1 'y 'x) -1)
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'z) 1) (check-false (get-interaction-sign n1 'x 'z))
(check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0) (check-equal? (get-interaction-sign n1 'y 'z) 1)
(define n-multi (network-form->network (check-equal? (get-interaction-sign n1 'x 't) 0)
(hash 'x '(min (+ y 1) 2) (define n-multi (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-false (get-interaction-sign n-multi 123-doms 'x 'y)) (define n2 (network-form->network (network-form n-multi 123-doms)))
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1) (check-false (get-interaction-sign n2 'x 'y))
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1) (check-equal? (get-interaction-sign n2 'y 'x) 1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0) (check-equal? (get-interaction-sign n2 'y 'z) -1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'y) 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 ;;; Given a network, builds its interaction graph. The graph has
;;; variables as nodes and has a directed edge from x to y if ;;; variables as nodes and has a directed edge from x to y if
;;; interaction? returns #t for these variables, in this order. ;;; interaction? returns #t for these variables, in this order.
(define (build-interaction-graph network doms) (define (build-interaction-graph network)
(define vars (hash-keys network)) (define vars (hash-keys (network-functions network)))
(unweighted-graph/directed (unweighted-graph/directed
(for*/list ([x (in-list vars)] (for*/list ([x (in-list vars)]
[y (in-list vars)] [y (in-list vars)]
#:when (interaction? network doms x y)) #:when (interaction? network x y))
(list x y)))) (list x y))))
;;; Like build-interaction-graph, but accepts a network form and ;;; Like build-interaction-graph, but accepts a network form and
;;; converts it a to a network. ;;; converts it a to a network.
(define (build-interaction-graph/form form doms) (define build-interaction-graph/form
(build-interaction-graph (network-form->network form) doms)) (compose build-interaction-graph network-form->network))
(module+ test (module+ test
(test-case "build-interaction-graph" (test-case "build-interaction-graph"
@ -533,41 +535,41 @@
[skip-expensive-tests? [skip-expensive-tests?
(displayln "Skipping test case build-interaction-graph.")] (displayln "Skipping test case build-interaction-graph.")]
[else [else
(define n-bool (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-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") "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 (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-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")]))) "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 ;;; Given a network, builds its signed interaction graph. The graph
;;; has variables as nodes and has a directed edge from x to ;;; has variables as nodes and has a directed edge from x to
;;; y labelled by the value get-interaction-sign for these variables, ;;; y labelled by the value get-interaction-sign for these variables,
;;; in that order, unless this value is #f. ;;; in that order, unless this value is #f.
(define (build-signed-interaction-graph network doms) (define (build-signed-interaction-graph network)
(define vars (hash-keys network)) (define vars (hash-keys (network-functions network)))
(weighted-graph/directed (weighted-graph/directed
(for*/list ([x (in-list vars)] (for*/list ([x (in-list vars)]
[y (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)) #:unless (eq? sign #f))
(list sign x y)))) (list sign x y))))
;;; Like build-signed-interaction-graph, but takes a network form and ;;; Like build-signed-interaction-graph, but takes a network form and
;;; converts it a to a network. ;;; converts it a to a network.
(define (build-signed-interaction-graph/form form doms) (define build-signed-interaction-graph/form
(build-signed-interaction-graph (network-form->network form) doms)) (compose build-signed-interaction-graph network-form->network))
(module+ test (module+ test
(test-case "build-signed-interaction-graph" (test-case "build-signed-interaction-graph"
@ -575,22 +577,22 @@
[skip-expensive-tests? [skip-expensive-tests?
(displayln "Skipping test case build-signed-interaction-graph.")] (displayln "Skipping test case build-signed-interaction-graph.")]
[else [else
(define n-bool (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/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") "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 (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/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")]))) "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")])))
;;; ==================== ;;; ====================