From f7e44df117c5050e457e258ab531caf2e36a866b Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 31 Oct 2020 00:48:00 +0100 Subject: [PATCH] networks: Add compact-tbf. --- networks.rkt | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 9c3038c..f16c72c 100644 --- a/networks.rkt +++ b/networks.rkt @@ -120,7 +120,8 @@ tbn?)] [build-tbn-state-graph (-> tbn? graph?)] [normalized-tbn? (-> tbn? boolean?)] - [normalize-tbn (-> tbn? normalized-tbn?)]) + [normalize-tbn (-> tbn? normalized-tbn?)] + [compact-tbf (-> tbf/state? tbf/state?)]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -1520,3 +1521,15 @@ (tbf/state '#hash((a . 0) (b . 1)) 0) 'b (tbf/state '#hash((a . -1) (b . 0)) -1))))) + +;;; Compacts (and denormalizes) a TBF by removing all inputs which +;;; are 0. +(define (compact-tbf tbf) + (tbf/state + (hash-filter (tbf/state-w tbf) #:predicate (compose not zero?)) + (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))))