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

networks: Add normalize-tbn.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-10-24 23:51:56 +02:00
parent 11ecbf84dc
commit 208dc12060
1 changed files with 30 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
networks.rkt
View file

@ -10,7 +10,8 @@
;;; This model can generalise Boolean networks, TBANs, multivalued ;;; This model can generalise Boolean networks, TBANs, multivalued
;;; networks, etc. ;;; networks, etc.
(require "utils.rkt" "generic.rkt" "functions.rkt" graph racket/random) (require "utils.rkt" "generic.rkt" "functions.rkt"
graph racket/random racket/hash)
(provide (provide
;; Structures ;; Structures
@ -118,7 +119,8 @@
(#: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?)]) [normalized-tbn? (-> tbn? boolean?)]
[normalize-tbn (-> tbn? normalized-tbn?)])
;; Predicates ;; Predicates
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
@ -1492,3 +1494,29 @@
(check-true (normalized-tbn? (check-true (normalized-tbn?
(make-tbn `((a . ,(make-sbf/state '((a . 1) (b . -1)))) (make-tbn `((a . ,(make-sbf/state '((a . 1) (b . -1))))
(b . ,(make-tbf/state '((a . -1) (b . 1)) -1)))))))) (b . ,(make-tbf/state '((a . -1) (b . 1)) -1))))))))
;;; Normalizes a TBN.
;;;
;;; For every TBF, removes the inputs that are not in the variables of
;;; the TBN, and adds missing inputs with 0 weight.
(define (normalize-tbn tbn)
(define vars-0 (for/hash ([(x _) (in-hash tbn)]) (values x 0)))
(define (normalize-tbf tbf)
;; Only keep the inputs which are also the variables of tbn.
(define w-pruned (hash-intersect tbn (tbf/state-w tbf)
#:combine (λ (_ w) w)))
;; Put in the missing inputs with weight 0.
(define w-complete (hash-union vars-0 w-pruned #:combine (λ (_ w) w)))
(tbf/state w-complete (tbf/state-θ tbf)))
(for/hash ([(x tbf) (in-hash tbn)]) (values x (normalize-tbf tbf))))
(module+ test
(test-case "normalize-tbn"
(check-equal? (normalize-tbn
(hash 'a (make-sbf/state '((b . 1) (c . 3)))
'b (make-tbf/state '((a . -1)) -1)))
(hash
'a
(tbf/state '#hash((a . 0) (b . 1)) 0)
'b
(tbf/state '#hash((a . -1) (b . 0)) -1)))))