From 0edda896428a8cb011e81aa6cc1488a63f517097 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 2 Nov 2020 00:08:49 +0100 Subject: [PATCH] networks: Add compact-tbn. --- networks.rkt | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/networks.rkt b/networks.rkt index 07da868..cd19b9f 100644 --- a/networks.rkt +++ b/networks.rkt @@ -121,7 +121,8 @@ [build-tbn-state-graph (-> tbn? graph?)] [normalized-tbn? (-> tbn? boolean?)] [normalize-tbn (-> tbn? normalized-tbn?)] - [compact-tbf (-> tbf/state? tbf/state?)]) + [compact-tbf (-> tbf/state? tbf/state?)] + [compact-tbn (-> tbn? tbn?)]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -1535,3 +1536,27 @@ (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)))) + +;;; Compacts a TBN by removing all inputs which are 0 or which are not +;;; variables of the network. +(define (compact-tbn tbn) + (define (remove-0-non-var tbf) + (tbf/state + (for/hash ([(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 ([(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)))))