Start the section Reading and printing TBNs and SBNs.
… and move some functions around without modifying them.
This commit is contained in:
Sergiu Ivanov
parent
d9641e7b5b
commit
927877b02f
2 changed files with 135 additions and 133 deletions
|
|
@ -366,6 +366,59 @@ Constructs a @racket[Network] out of the given @racket[tbn].
|
||||||
(update tbn s '(a b)))
|
(update tbn s '(a b)))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(build-tbn-state-graph [tbn TBN]) Graph]{
|
||||||
|
|
||||||
|
Builds the state graph of a @racket[TBN].
|
||||||
|
|
||||||
|
This function constructs a @racket[(Network (U Zero One))] from
|
||||||
|
@racket[tbn], then builds the state graph of its synchronous dynamics,
|
||||||
|
and pretty-prints the node labels.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(require (only-in "utils.rkt" dotit))
|
||||||
|
(dotit (build-tbn-state-graph
|
||||||
|
(hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) 1))))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(normalized-tbn? [tbn TBN]) Boolean]{
|
||||||
|
|
||||||
|
Checks whether @racket[tbn] is normalized: whether all of the
|
||||||
|
functions have the same inputs, and whether these inputs are exactly
|
||||||
|
the variables of @racket[tbn].
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(normalized-tbn?
|
||||||
|
(hash 'x (tbf/state (hash 'x 0 'y -1) -1)
|
||||||
|
'y (tbf/state (hash 'x -1 'y 0) -1)))
|
||||||
|
(normalized-tbn?
|
||||||
|
(hash 'x (tbf/state (hash 'x 0 ) -1)
|
||||||
|
'y (tbf/state (hash 'y 0) -1)))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(normalize-tbn (tbn TBF)) TBN]{
|
||||||
|
|
||||||
|
Normalizes @racket[tbn]: for every @racket[TBF/State], removes the
|
||||||
|
inputs that are not in the variables of @racket[tbn], and adds missing
|
||||||
|
inputs with 0 weight.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
|
||||||
|
'y (tbf/state (hash 'y 3) 1)))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(compact-tbn [tbn TBN]) TBN]{
|
||||||
|
|
||||||
|
Compacts the @racket[tbn] by removing all inputs which are 0 or which
|
||||||
|
are not variables of the network.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) -1)))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@section{Reading and printing TBNs and SBNs}
|
||||||
|
|
||||||
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
|
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
|
||||||
[#:headers headers Boolean #t]
|
[#:headers headers Boolean #t]
|
||||||
[#:func-names func-names Boolean #t])
|
[#:func-names func-names Boolean #t])
|
||||||
|
|
@ -446,57 +499,6 @@ set to 0.
|
||||||
(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
|
||||||
]}
|
]}
|
||||||
|
|
||||||
@defproc[(build-tbn-state-graph [tbn TBN]) Graph]{
|
|
||||||
|
|
||||||
Builds the state graph of a @racket[TBN].
|
|
||||||
|
|
||||||
This function constructs a @racket[(Network (U Zero One))] from
|
|
||||||
@racket[tbn], then builds the state graph of its synchronous dynamics,
|
|
||||||
and pretty-prints the node labels.
|
|
||||||
|
|
||||||
@ex[
|
|
||||||
(require (only-in "utils.rkt" dotit))
|
|
||||||
(dotit (build-tbn-state-graph
|
|
||||||
(hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
|
||||||
'b (tbf/state (hash 'a -1 'b 1) 1))))
|
|
||||||
]}
|
|
||||||
|
|
||||||
@defproc[(normalized-tbn? [tbn TBN]) Boolean]{
|
|
||||||
|
|
||||||
Checks whether @racket[tbn] is normalized: whether all of the
|
|
||||||
functions have the same inputs, and whether these inputs are exactly
|
|
||||||
the variables of @racket[tbn].
|
|
||||||
|
|
||||||
@ex[
|
|
||||||
(normalized-tbn?
|
|
||||||
(hash 'x (tbf/state (hash 'x 0 'y -1) -1)
|
|
||||||
'y (tbf/state (hash 'x -1 'y 0) -1)))
|
|
||||||
(normalized-tbn?
|
|
||||||
(hash 'x (tbf/state (hash 'x 0 ) -1)
|
|
||||||
'y (tbf/state (hash 'y 0) -1)))
|
|
||||||
]}
|
|
||||||
|
|
||||||
@defproc[(normalize-tbn (tbn TBF)) TBN]{
|
|
||||||
|
|
||||||
Normalizes @racket[tbn]: for every @racket[TBF/State], removes the
|
|
||||||
inputs that are not in the variables of @racket[tbn], and adds missing
|
|
||||||
inputs with 0 weight.
|
|
||||||
|
|
||||||
@ex[
|
|
||||||
(normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
|
|
||||||
'y (tbf/state (hash 'y 3) 1)))
|
|
||||||
]}
|
|
||||||
|
|
||||||
@defproc[(compact-tbn [tbn TBN]) TBN]{
|
|
||||||
|
|
||||||
Compacts the @racket[tbn] by removing all inputs which are 0 or which
|
|
||||||
are not variables of the network.
|
|
||||||
|
|
||||||
@ex[
|
|
||||||
(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
|
|
||||||
'b (tbf/state (hash 'a -1 'b 1) -1)))
|
|
||||||
]}
|
|
||||||
|
|
||||||
@section{Miscellaneous utilities}
|
@section{Miscellaneous utilities}
|
||||||
|
|
||||||
@defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])
|
@defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])
|
||||||
|
|
|
||||||
164
tbn.rkt
164
tbn.rkt
|
|
@ -47,8 +47,8 @@
|
||||||
group-truth-table-by-nai
|
group-truth-table-by-nai
|
||||||
|
|
||||||
TBN sbn? tbn->network
|
TBN sbn? tbn->network
|
||||||
parse-org-tbn read-org-tbn read-org-sbn
|
|
||||||
build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
|
build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
|
||||||
|
parse-org-tbn read-org-tbn read-org-sbn
|
||||||
)
|
)
|
||||||
|
|
||||||
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
|
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
|
||||||
|
|
@ -416,6 +416,87 @@
|
||||||
(check-equal? (network-domains tbn)
|
(check-equal? (network-domains tbn)
|
||||||
#hash((a . (0 1)) (b . (0 1))))))
|
#hash((a . (0 1)) (b . (0 1))))))
|
||||||
|
|
||||||
|
(: build-tbn-state-graph (-> TBN Graph))
|
||||||
|
(define (build-tbn-state-graph tbn)
|
||||||
|
(pretty-print-state-graph
|
||||||
|
((inst build-full-state-graph (U Zero One))
|
||||||
|
((inst make-syn-dynamics (U Zero One))
|
||||||
|
(tbn->network tbn)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "build-tbn-state-graph"
|
||||||
|
(check-equal? (graphviz
|
||||||
|
(build-tbn-state-graph
|
||||||
|
(hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) 1))))
|
||||||
|
"digraph G {\n\tnode0 [label=\"a:0 b:0\"];\n\tnode1 [label=\"a:1 b:1\"];\n\tnode2 [label=\"a:0 b:1\"];\n\tnode3 [label=\"a:1 b:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0 [];\n\t\tnode2 -> node3 [];\n\t\tnode3 -> node0 [];\n\t}\n}\n")))
|
||||||
|
|
||||||
|
(: normalized-tbn? (-> TBN Boolean))
|
||||||
|
(define (normalized-tbn? tbn)
|
||||||
|
(define tbn-vars (hash-keys tbn))
|
||||||
|
(for/and ([tbf (in-list (hash-values tbn))])
|
||||||
|
(set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "normalized-tbn?"
|
||||||
|
(check-true (normalized-tbn?
|
||||||
|
(hash 'x (tbf/state (hash 'x 0 'y -1) -1)
|
||||||
|
'y (tbf/state (hash 'x -1 'y 0) -1))))
|
||||||
|
(check-false (normalized-tbn?
|
||||||
|
(hash 'x (tbf/state (hash 'x 0 ) -1)
|
||||||
|
'y (tbf/state (hash 'y 0) -1))))))
|
||||||
|
|
||||||
|
(: normalize-tbn (-> TBN TBN))
|
||||||
|
(define (normalize-tbn tbn)
|
||||||
|
(define vars-0 (for/hash : (VariableMapping Real)
|
||||||
|
([(x _) (in-hash tbn)])
|
||||||
|
(values x 0)))
|
||||||
|
(: normalize-tbf (-> TBF/State TBF/State))
|
||||||
|
(define (normalize-tbf tbf)
|
||||||
|
;; Only keep the inputs which are also the variables of tbn.
|
||||||
|
(define w-pruned (hash-intersect/tbn-tbf
|
||||||
|
tbn
|
||||||
|
(tbf/state-w tbf)
|
||||||
|
#:combine (λ (_ w) w)))
|
||||||
|
;; Put in the missing inputs with weight 0.
|
||||||
|
(define w-complete
|
||||||
|
(assert-type (hash-union vars-0 w-pruned #:combine (λ (_ w) w))
|
||||||
|
(VariableMapping Real)))
|
||||||
|
(tbf/state w-complete (tbf/state-θ tbf)))
|
||||||
|
(for/hash : TBN ([(x tbf) (in-hash tbn)])
|
||||||
|
(values x (normalize-tbf tbf))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "normalize-tbn"
|
||||||
|
(check-equal? (normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
|
||||||
|
'y (tbf/state (hash 'y 3) 1)))
|
||||||
|
(hash 'x (tbf/state (hash 'x 2 'y 0) -1)
|
||||||
|
'y (tbf/state (hash 'x 0 'y 3) 1)))))
|
||||||
|
|
||||||
|
(: compact-tbn (-> TBN TBN))
|
||||||
|
(define (compact-tbn tbn)
|
||||||
|
(: remove-0-non-var (-> TBF/State TBF/State))
|
||||||
|
(define (remove-0-non-var tbf)
|
||||||
|
(tbf/state (for/hash : (VariableMapping Real)
|
||||||
|
([(x w) (in-hash (tbf/state-w tbf))]
|
||||||
|
#:when (hash-has-key? tbn x)
|
||||||
|
#:unless (zero? w))
|
||||||
|
(values x w))
|
||||||
|
(tbf/state-θ tbf)))
|
||||||
|
(for/hash : TBN ([(x tbf) (in-hash tbn)])
|
||||||
|
(values x (remove-0-non-var tbf))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "compact-tbn"
|
||||||
|
(check-equal?
|
||||||
|
(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
|
||||||
|
'b (tbf/state (hash 'a -1 'b 1) -1)))
|
||||||
|
(hash
|
||||||
|
'a
|
||||||
|
(tbf/state '#hash((b . 1)) 0)
|
||||||
|
'b
|
||||||
|
(tbf/state '#hash((a . -1) (b . 1)) -1)))))
|
||||||
|
|
||||||
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
|
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
|
||||||
(#:headers Boolean
|
(#:headers Boolean
|
||||||
#:func-names Boolean)
|
#:func-names Boolean)
|
||||||
|
|
@ -523,87 +604,6 @@
|
||||||
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
|
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
|
||||||
'x1
|
'x1
|
||||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
|
(tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
|
||||||
|
|
||||||
(: build-tbn-state-graph (-> TBN Graph))
|
|
||||||
(define (build-tbn-state-graph tbn)
|
|
||||||
(pretty-print-state-graph
|
|
||||||
((inst build-full-state-graph (U Zero One))
|
|
||||||
((inst make-syn-dynamics (U Zero One))
|
|
||||||
(tbn->network tbn)))))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "build-tbn-state-graph"
|
|
||||||
(check-equal? (graphviz
|
|
||||||
(build-tbn-state-graph
|
|
||||||
(hash 'a (tbf/state (hash 'a -1 'b 1) 0)
|
|
||||||
'b (tbf/state (hash 'a -1 'b 1) 1))))
|
|
||||||
"digraph G {\n\tnode0 [label=\"a:0 b:0\"];\n\tnode1 [label=\"a:1 b:1\"];\n\tnode2 [label=\"a:0 b:1\"];\n\tnode3 [label=\"a:1 b:0\"];\n\tsubgraph U {\n\t\tedge [dir=none];\n\t\tnode0 -> node0 [];\n\t}\n\tsubgraph D {\n\t\tnode1 -> node0 [];\n\t\tnode2 -> node3 [];\n\t\tnode3 -> node0 [];\n\t}\n}\n")))
|
|
||||||
|
|
||||||
(: normalized-tbn? (-> TBN Boolean))
|
|
||||||
(define (normalized-tbn? tbn)
|
|
||||||
(define tbn-vars (hash-keys tbn))
|
|
||||||
(for/and ([tbf (in-list (hash-values tbn))])
|
|
||||||
(set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "normalized-tbn?"
|
|
||||||
(check-true (normalized-tbn?
|
|
||||||
(hash 'x (tbf/state (hash 'x 0 'y -1) -1)
|
|
||||||
'y (tbf/state (hash 'x -1 'y 0) -1))))
|
|
||||||
(check-false (normalized-tbn?
|
|
||||||
(hash 'x (tbf/state (hash 'x 0 ) -1)
|
|
||||||
'y (tbf/state (hash 'y 0) -1))))))
|
|
||||||
|
|
||||||
(: normalize-tbn (-> TBN TBN))
|
|
||||||
(define (normalize-tbn tbn)
|
|
||||||
(define vars-0 (for/hash : (VariableMapping Real)
|
|
||||||
([(x _) (in-hash tbn)])
|
|
||||||
(values x 0)))
|
|
||||||
(: normalize-tbf (-> TBF/State TBF/State))
|
|
||||||
(define (normalize-tbf tbf)
|
|
||||||
;; Only keep the inputs which are also the variables of tbn.
|
|
||||||
(define w-pruned (hash-intersect/tbn-tbf
|
|
||||||
tbn
|
|
||||||
(tbf/state-w tbf)
|
|
||||||
#:combine (λ (_ w) w)))
|
|
||||||
;; Put in the missing inputs with weight 0.
|
|
||||||
(define w-complete
|
|
||||||
(assert-type (hash-union vars-0 w-pruned #:combine (λ (_ w) w))
|
|
||||||
(VariableMapping Real)))
|
|
||||||
(tbf/state w-complete (tbf/state-θ tbf)))
|
|
||||||
(for/hash : TBN ([(x tbf) (in-hash tbn)])
|
|
||||||
(values x (normalize-tbf tbf))))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "normalize-tbn"
|
|
||||||
(check-equal? (normalize-tbn (hash 'x (tbf/state (hash 'x 2) -1)
|
|
||||||
'y (tbf/state (hash 'y 3) 1)))
|
|
||||||
(hash 'x (tbf/state (hash 'x 2 'y 0) -1)
|
|
||||||
'y (tbf/state (hash 'x 0 'y 3) 1)))))
|
|
||||||
|
|
||||||
(: compact-tbn (-> TBN TBN))
|
|
||||||
(define (compact-tbn tbn)
|
|
||||||
(: remove-0-non-var (-> TBF/State TBF/State))
|
|
||||||
(define (remove-0-non-var tbf)
|
|
||||||
(tbf/state (for/hash : (VariableMapping Real)
|
|
||||||
([(x w) (in-hash (tbf/state-w tbf))]
|
|
||||||
#:when (hash-has-key? tbn x)
|
|
||||||
#:unless (zero? w))
|
|
||||||
(values x w))
|
|
||||||
(tbf/state-θ tbf)))
|
|
||||||
(for/hash : TBN ([(x tbf) (in-hash tbn)])
|
|
||||||
(values x (remove-0-non-var tbf))))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "compact-tbn"
|
|
||||||
(check-equal?
|
|
||||||
(compact-tbn (hash 'a (tbf/state (hash 'a 0 'b 1 'c 3 'd 0) 0)
|
|
||||||
'b (tbf/state (hash 'a -1 'b 1) -1)))
|
|
||||||
(hash
|
|
||||||
'a
|
|
||||||
(tbf/state '#hash((b . 1)) 0)
|
|
||||||
'b
|
|
||||||
(tbf/state '#hash((a . -1) (b . 1)) -1)))))
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue