Type tbn->network.

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))])

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