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

This commit is contained in:
Sergiu Ivanov 2022-07-05 23:43:41 +02:00
parent f2f0564f72
commit 25411043c1
2 changed files with 70 additions and 53 deletions

View file

@ -30,7 +30,8 @@
list-syntactic-interactions build-syntactic-interaction-graph list-syntactic-interactions build-syntactic-interaction-graph
interaction? get-interaction-sign build-interaction-graph interaction? get-interaction-sign build-interaction-graph
build-interaction-graph/form build-interaction-graph/form build-signed-interaction-graph
build-signed-interaction-graph/form
) )
(define-type (State a) (VariableMapping a)) (define-type (State a) (VariableMapping a))
@ -468,6 +469,44 @@
(define n2 (network-form n-multi 123-doms)) (define n2 (network-form n-multi 123-doms))
(check-equal? (graphviz (build-interaction-graph/form n2)) (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")]))) "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")])))
(: build-signed-interaction-graph (All (a) (-> (Network a) Graph)))
(define (build-signed-interaction-graph network)
(define vars (hash-keys (network-functions network)))
(weighted-graph/directed
(for*/list : (Listof (List Integer Any Any))
([x (in-list vars)]
[y (in-list vars)]
[sign (in-value (get-interaction-sign network x y))]
#:unless (eq? sign #f))
(list sign x y))))
(: build-signed-interaction-graph/form (All (a) (-> (NetworkForm a) Graph)))
(define (build-signed-interaction-graph/form nf)
(build-signed-interaction-graph (network-form->network/any nf)))
(module+ test
(test-case "build-signed-interaction-graph"
(cond
[skip-expensive-tests?
(displayln "Skipping test case build-signed-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-signed-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\tnode2 -> node2 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"1\"];\n\t\tnode0 -> node3 [label=\"-1\"];\n\t\tnode3 -> node1 [label=\"0\"];\n\t\tnode3 -> node0 [label=\"1\"];\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-signed-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 [label=\"1\"];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [label=\"0\"];\n\t\tnode0 -> node2 [label=\"-1\"];\n\t\tnode0 -> node3 [label=\"1\"];\n\t}\n}\n")])))
) )
(require 'typed) (require 'typed)
@ -622,51 +661,6 @@
(define update-function-form? any/c) (define update-function-form? any/c)
;;; ============================
;;; Inferring interaction graphs
;;; ============================
;;; 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)
(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 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
(compose build-signed-interaction-graph network-form->network/any))
(module+ test
(test-case "build-signed-interaction-graph"
(cond
[skip-expensive-tests?
(displayln "Skipping test case build-signed-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-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)
'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-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")])))
;;; ==================== ;;; ====================
;;; Dynamics of networks ;;; Dynamics of networks
;;; ==================== ;;; ====================

View file

@ -482,6 +482,29 @@ converts it a to @racket[(Network a)] first.
(b . (not b)))))) (b . (not b))))))
]} ]}
@defproc[(build-signed-interaction-graph [network (Network a)]) Graph]{
Given a network, builds its signed interaction graph. The graph has variables
as nodes and has a directed edge from @italic{x} to @racket{y} labelled by the
value @racket[get-interaction-sign] produces for these variables, in that
order, unless this value is @racket[#f].
@ex[
(dotit (build-signed-interaction-graph
(forms->boolean-network #hash((a . (and a b))
(b . (not b))))))
]}
@defproc[(build-signed-interaction-graph/form [nf (NetworkForm a)]) Graph]{
Like @racket[build-signed-interaction-graph], but takes a network form and
converts it to a network.
@ex[
(dotit (build-signed-interaction-graph/form
(make-boolean-network-form #hash((a . (and a b))
(b . (not b))))))
]}
@section{Tabulating functions and networks} @section{Tabulating functions and networks}