From 25411043c10fc0274d4b1c50ed34b4d492461c3a Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Tue, 5 Jul 2022 23:43:41 +0200 Subject: [PATCH] Type build-signed-interaction-graph and build-signed-interaction-graph/form. --- networks.rkt | 100 +++++++++++++++++-------------------- scribblings/networks.scrbl | 23 +++++++++ 2 files changed, 70 insertions(+), 53 deletions(-) diff --git a/networks.rkt b/networks.rkt index 639b79a..83b0b17 100644 --- a/networks.rkt +++ b/networks.rkt @@ -30,7 +30,8 @@ list-syntactic-interactions build-syntactic-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)) @@ -340,10 +341,10 @@ (hash-set st x x-val))) ;; TODO: Replace with for*/first when/if it is fixed. (for*/first/typed : (Option Boolean) - ([st1 : (State a) x-states] - [st2 : (State a) x-states] - #:unless (equal? (hash-ref st1 x) (hash-ref st2 x)) - #:unless (equal? (y-func st1) (y-func st2))) + ([st1 : (State a) x-states] + [st2 : (State a) x-states] + #:unless (equal? (hash-ref st1 x) (hash-ref st2 x)) + #:unless (equal? (y-func st1) (y-func st2))) #t)) ;; TODO: Replace with for/first when/if it is fixed. (for/first/typed : (Option Boolean) @@ -382,8 +383,8 @@ ([x-val (in-list dom-x)]) (hash-set st x x-val))) (for/list : (Listof (U '< '> '=)) - ([st1 (in-list x-states)] - [st2 (in-list (cdr x-states))]) + ([st1 (in-list x-states)] + [st2 (in-list (cdr x-states))]) (define y1-idx (assert-type (index-of dom-y (y-func st1)) Index)) (define y2-idx (assert-type (index-of dom-y (y-func st2)) Index)) (cond @@ -394,7 +395,7 @@ (define interactions (remove-duplicates (for/list : (Listof (U '< '> '= Zero)) - ([st (in-list states-not-x)]) + ([st (in-list states-not-x)]) (define impacts (remove-duplicates (collect-impacts-on-y st))) (cond [(and (member '< impacts) (not (member '> impacts))) '<] @@ -468,6 +469,44 @@ (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")]))) + + (: 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) @@ -622,51 +661,6 @@ (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 ;;; ==================== diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 076b24a..aa26afb 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -482,6 +482,29 @@ converts it a to @racket[(Network a)] first. (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}