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)))
|
||||
]}
|
||||
|
||||
@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)))]
|
||||
[#:headers headers 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))")
|
||||
]}
|
||||
|
||||
@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}
|
||||
|
||||
@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
|
||||
|
||||
TBN sbn? tbn->network
|
||||
parse-org-tbn read-org-tbn read-org-sbn
|
||||
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)))
|
||||
|
|
@ -416,6 +416,87 @@
|
|||
(check-equal? (network-domains tbn)
|
||||
#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))))
|
||||
(#:headers Boolean
|
||||
#:func-names Boolean)
|
||||
|
|
@ -523,87 +604,6 @@
|
|||
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
|
||||
'x1
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in a new issue