networks: Add normalized-tbn?.

This commit is contained in:
Sergiu Ivanov 2020-10-24 23:15:13 +02:00
parent e79fef9118
commit 11ecbf84dc

View file

@ -117,7 +117,8 @@
[read-org-sbn (->* (string?) [read-org-sbn (->* (string?)
(#:headers boolean? #:func-names boolean?) (#:headers boolean? #:func-names boolean?)
tbn?)] tbn?)]
[build-tbn-state-graph (-> tbn? graph?)]) [build-tbn-state-graph (-> tbn? graph?)]
[normalized-tbn? (-> tbn? boolean?)])
;; Predicates ;; Predicates
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
@ -1474,3 +1475,20 @@
build-full-01-state-graph build-full-01-state-graph
make-syn-dynamics make-syn-dynamics
tbn->network)) tbn->network))
;;; Checks whether a TBN is normalized: whether all of the functions
;;; have the same inputs, and whether these inputs are exactly the
;;; variables of the TBN.
(define (normalized-tbn? tbn)
(define tbn-vars (hash-keys tbn))
(for/and ([tbf (in-list (hash-values tbn))])
(set=? tbn-vars (hash-keys (tbf/state-w tbf)))))
(module+ test
(test-case "normalized-tbn?"
(check-false (normalized-tbn?
(make-tbn `((a . ,(make-sbf/state '((b . 1))))
(b . ,(make-tbf/state '((a . -1)) -1))))))
(check-true (normalized-tbn?
(make-tbn `((a . ,(make-sbf/state '((a . 1) (b . -1))))
(b . ,(make-tbf/state '((a . -1) (b . 1)) -1))))))))