Type compact-tbn.

scribblings/tbn.scrbl

@@ -487,6 +487,16 @@ inputs with 0 weight.
                      '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))])

tbn.rkt

@@ -48,7 +48,7 @@
 
    TBN sbn? tbn->network
    parse-org-tbn read-org-tbn read-org-sbn
-   build-tbn-state-graph normalized-tbn? normalize-tbn
+   build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -580,6 +580,30 @@
                                          '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