diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index 4474b59..21ff8c6 100644 --- a/scribblings/tbn.scrbl +++ b/scribblings/tbn.scrbl @@ -301,6 +301,19 @@ in the network. This function does not check this condition. (sbn? (hash 'a f1 'b f2)))) ]} +@defproc[(tbn->network [tbn TBN]) (Network (U Zero One))]{ + +Constructs a @racket[Network] out of the given @racket[tbn]. + +@ex[ +(require (only-in "networks.rkt" update)) +(let* ([tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0) + 'b (tbf/state (hash 'a -1 'b 1) 1))] + [tbn (tbn->network tbn-form)] + [s (hash 'a 0 'b 1)]) + (update tbn s '(a b))) +]} + @section{Miscellaneous utilities} @defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))]) diff --git a/tbn.rkt b/tbn.rkt index ceb4120..52fa27e 100644 --- a/tbn.rkt +++ b/tbn.rkt @@ -35,7 +35,7 @@ group-truth-table-by-nai - TBN sbn? + TBN sbn? tbn->network ) (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One))) @@ -332,6 +332,25 @@ (check-true (sbn? (hash 'a f1 'b f1))) (check-false (sbn? (hash 'a f1 'b f2)))) ) + + (: tbn->network (-> TBN (Network (U Zero One)))) + (define (tbn->network tbn) + (make-01-network + (for/hash : (VariableMapping (UpdateFunction (U Zero One))) + ([(x tbfx) (in-hash tbn)]) + (values x (λ ([s : (State (U Zero One))]) + (apply-tbf/state tbfx s)))))) + + (module+ test + (test-case "tbn->network" + (define tbn-form (hash 'a (tbf/state (hash 'a -1 'b 1) 0) + 'b (tbf/state (hash 'a -1 'b 1) 1))) + (define tbn (tbn->network tbn-form)) + (define s (hash 'a 0 'b 1)) + (check-equal? (update tbn s '(a b)) + #hash((a . 1) (b . 0))) + (check-equal? (network-domains tbn) + #hash((a . (0 1)) (b . (0 1)))))) ) (module+ test