Type compact-tbf.

scribblings/tbn.scrbl

@@ -115,6 +115,14 @@ input values.
                  (hash 'a 1 'b 0 'c 1))
 ]}
 
+@defproc[(compact-tbf [tbf TBF/State]) TBF/State]{
+
+Compacts (and denormalizes) a TBF by removing all inputs which are 0.
+
+@ex[
+(compact-tbf (tbf/state (hash 'a 0 'b 1 'c 2 'd 0) 2))
+]}
+
 @section{Reading and printing TBFs and SBFs}
 
 @defproc[(lists+vars->tbfs/state [vars (Listof Variable)]

tbn.rkt

@@ -33,7 +33,7 @@
    apply-tbf-to-state
 
    (struct-out tbf/state) TBF/State tbf/state-w tbf/state-θ make-tbf/state
-   sbf/state? apply-tbf/state
+   sbf/state? apply-tbf/state compact-tbf
 
    lists+vars->tbfs/state lists+headers->tbfs/state lists->tbfs/state
    lists+vars->sbfs/state lists+headers->sbfs/state lists->sbfs/state
@@ -101,6 +101,20 @@
       (check-equal? (apply-tbf/state tbf st1) 1)
       (check-equal? (apply-tbf/state tbf st2) 0)))
 
+  (: compact-tbf (-> TBF/State TBF/State))
+  (define (compact-tbf tbf)
+    (tbf/state
+     (for/hash : (VariableMapping Real)
+               ([(k v) (in-hash (tbf/state-w tbf))]
+                #:unless (zero? v))
+       (values k v))
+     (tbf/state-θ tbf)))
+
+  (module+ test
+    (test-case "compact-tbf"
+      (check-equal? (compact-tbf (tbf/state (hash 'a 0 'b 1 'c 2 'd 0) 2))
+                    (tbf/state '#hash((b . 1) (c . 2)) 2))))
+
   (: lists+vars->tbfs/state (-> (Listof Variable) (Listof (Listof Real))
                                 (Listof TBF/State)))
   (define (lists+vars->tbfs/state vars lsts)