From f2f0564f7279e6b5acef1c1a4c39c000bae77909 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Tue, 5 Jul 2022 22:46:02 +0200 Subject: [PATCH] Type build-interaction-graph and build-interaction-graph/form. --- networks.rkt | 85 +++++++++++++++++++------------------- scribblings/networks.scrbl | 25 +++++++++++ 2 files changed, 68 insertions(+), 42 deletions(-) diff --git a/networks.rkt b/networks.rkt index dabe6f8..639b79a 100644 --- a/networks.rkt +++ b/networks.rkt @@ -5,7 +5,10 @@ typed/graph racket/random) (module+ test - (require typed/rackunit)) + (require typed/rackunit) + (define skip-expensive-tests? #f) + (unless skip-expensive-tests? + (displayln "Running the complete test suite..."))) (provide State UpdateFunction Domain DomainMapping @@ -26,7 +29,8 @@ build-all-states build-all-boolean-states build-all-01-states list-syntactic-interactions build-syntactic-interaction-graph - interaction? get-interaction-sign + interaction? get-interaction-sign build-interaction-graph + build-interaction-graph/form ) (define-type (State a) (VariableMapping a)) @@ -427,6 +431,43 @@ (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))) + + (: build-interaction-graph (All (a) (-> (Network a) Graph))) + (define (build-interaction-graph network) + (define vars (hash-keys (network-functions network))) + (unweighted-graph/directed + (for*/list : (Listof (List Any Any)) + ([x (in-list vars)] + [y (in-list vars)] + #:when (interaction? network x y)) + (list x y)))) + + (: build-interaction-graph/form (All (a) (-> (NetworkForm a) Graph))) + (define (build-interaction-graph/form form) + (build-interaction-graph (network-form->network/any form))) + + (module+ test + (test-case "build-interaction-graph" + (cond + [skip-expensive-tests? + (displayln "Skipping test case build-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-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\tnode0 -> node3 [];\n\t\tnode2 -> node2 [];\n\t}\n\tsubgraph D {\n\t\tnode0 -> node1 [];\n\t\tnode0 -> node2 [];\n\t\tnode3 -> node1 [];\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-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")]))) ) (require 'typed) @@ -585,46 +626,6 @@ ;;; Inferring interaction graphs ;;; ============================ - -;;; 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) - (define vars (hash-keys (network-functions network))) - (unweighted-graph/directed - (for*/list ([x (in-list vars)] - [y (in-list vars)] - #: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 - (compose build-interaction-graph network-form->network/any)) - -(module+ test - (test-case "build-interaction-graph" - (cond - [skip-expensive-tests? - (displayln "Skipping test case build-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-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) - '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-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, diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index f6c2557..076b24a 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -458,6 +458,31 @@ between @racket[x] and @racket[y], it is more costly than calling (get-interaction-sign bn 'b 'a) (get-interaction-sign bn 'b 'b))) ]} + +@defproc[(build-interaction-graph [network (Network a)]) Graph]{ + +Given a network, builds its interaction graph. The graph has variables as +nodes and has a directed edge from @italic{x} to @italic{y} if +@racket[interaction?] returns @racket[#t] for these variables, in this order. + +@ex[ +(dotit (build-interaction-graph + (forms->boolean-network #hash((a . (and a b)) + (b . (not b)))))) +]} + +@defproc[(build-interaction-graph/form [nf (NetworkForm a)]) Graph]{ + +Like @racket[build-interaction-graph], but accepts a network form and +converts it a to @racket[(Network a)] first. + +@ex[ +(dotit (build-interaction-graph/form + (make-boolean-network-form #hash((a . (and a b)) + (b . (not b)))))) +]} + + @section{Tabulating functions and networks} @section{Constructing functions and networks}