diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index d590349..51a2c09 100644 --- a/scribblings/tbn.scrbl +++ b/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))]) diff --git a/tbn.rkt b/tbn.rkt index be5a853..6960c35 100644 --- a/tbn.rkt +++ b/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