scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

networks: Add compact-tbn.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-11-02 00:08:49 +01:00
parent 722b45d098
commit 0edda89642
1 changed files with 26 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
networks.rkt
View file

@ -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)))))