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

networks: Add build-boolean-signed-interaction-graph.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-02-23 10:00:48 +01:00
parent b04d897c67
commit 2d0e688425
2 changed files with 34 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
networks-tests.rkt
View file

@ -70,17 +70,29 @@
(let* ([n #hash((a . (not b)) (b . a))] (let* ([n #hash((a . (not b)) (b . a))]
[doms (make-boolean-domains '(a b))] [doms (make-boolean-domains '(a b))]
[sig (build-signed-interaction-graph n doms)]) [sig1 (build-signed-interaction-graph n doms)]
[sig2 (build-boolean-signed-interaction-graph n)])
(check-equal? (get-interaction-sign n doms 'a 'b) '+) (check-equal? (get-interaction-sign n doms 'a 'b) '+)
(check-equal? (get-interaction-sign n doms 'b 'a) '-) (check-equal? (get-interaction-sign n doms 'b 'a) '-)
(check-true (has-vertex? sig 'a)) (check-true (has-vertex? sig1 'a))
(check-true (has-vertex? sig 'b)) (check-true (has-vertex? sig1 'b))
(check-false (has-vertex? sig 'c)) (check-false (has-vertex? sig1 'c))
(check-false (has-edge? sig 'a 'a)) (check-false (has-edge? sig1 'a 'a))
(check-true (has-edge? sig 'b 'a)) (check-true (has-edge? sig1 'b 'a))
(check-false (has-edge? sig 'b 'b)) (check-false (has-edge? sig1 'b 'b))
(check-false (has-edge? sig 'c 'b)) (check-false (has-edge? sig1 'c 'b))
(check-false (has-edge? sig 'c 'a)) (check-false (has-edge? sig1 'c 'a))
(check-equal? (edge-weight sig 'a 'b) 1) (check-equal? (edge-weight sig1 'a 'b) 1)
(check-equal? (edge-weight sig 'b 'a) -1))) (check-equal? (edge-weight sig1 'b 'a) -1)
(check-true (has-vertex? sig2 'a))
(check-true (has-vertex? sig2 'b))
(check-false (has-vertex? sig2 'c))
(check-false (has-edge? sig2 'a 'a))
(check-true (has-edge? sig2 'b 'a))
(check-false (has-edge? sig2 'b 'b))
(check-false (has-edge? sig2 'c 'b))
(check-false (has-edge? sig2 'c 'a))
(check-equal? (edge-weight sig2 'a 'b) 1)
(check-equal? (edge-weight sig2 'b 'a) -1)))

12
networks.rkt
View file

@ -27,7 +27,8 @@
[make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))] [make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))]
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))] [make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
[get-interaction-sign (-> network-form? domain-mapping/c variable? variable? (or/c '+ '- '0))] [get-interaction-sign (-> network-form? domain-mapping/c variable? variable? (or/c '+ '- '0))]
[build-signed-interaction-graph (-> network-form? domain-mapping/c graph?)]) [build-signed-interaction-graph (-> network-form? domain-mapping/c graph?)]
[build-boolean-signed-interaction-graph (-> network-form? graph?)])
;; Predicates ;; Predicates
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
@ -227,3 +228,12 @@
(list (match (get-interaction-sign network-form doms x y) (list (match (get-interaction-sign network-form doms x y)
['+ 1] ['- -1] ['0 0]) ['+ 1] ['- -1] ['0 0])
x y)))))) x y))))))
;;; Calls build-signed-interaction-graph with the Boolean domain for
;;; all variable.
;;;
;;; /!\ The same performance warning applies as for
;;; build-signed-interaction-graph.
(define (build-boolean-signed-interaction-graph network-form)
(build-signed-interaction-graph network-form
(make-boolean-domains (hash-keys network-form))))