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

networks: Add build-signed-interaction-graph.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-02-23 01:00:09 +01:00
parent 798178852c
commit daf2e079ae
2 changed files with 34 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
networks-tests.rkt
View file

@ -75,7 +75,19 @@
(check-equal? (hash->list (make-boolean-domains '(a b))) (check-equal? (hash->list (make-boolean-domains '(a b)))
'((a . (#f #t)) (b . (#f #t)))) '((a . (#f #t)) (b . (#f #t))))
(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)])
(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? sig 'b))
(check-false (has-vertex? sig 'c))
(check-false (has-edge? sig 'a 'a))
(check-true (has-edge? sig 'b 'a))
(check-false (has-edge? sig 'b 'b))
(check-false (has-edge? sig 'c 'b))
(check-false (has-edge? sig 'c 'a))
(check-equal? (edge-weight sig 'a 'b) 1)
(check-equal? (edge-weight sig 'b 'a) -1)))

20
networks.rkt
View file

@ -27,7 +27,8 @@
[build-all-states-same-domain (-> (listof variable?) generic-set? (listof state?))] [build-all-states-same-domain (-> (listof variable?) generic-set? (listof state?))]
[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? (hash/c variable? generic-set?) variable? variable? (or/c '+ '- '0))]) [get-interaction-sign (-> network-form? (hash/c variable? generic-set?) variable? variable? (or/c '+ '- '0))]
[build-signed-interaction-graph (-> network-form? (hash/c variable? generic-set?) graph?)])
;; Predicates ;; Predicates
(contract-out [variable? (-> any/c boolean?)] (contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)] [state? (-> any/c boolean?)]
@ -214,3 +215,20 @@
;; Otherwise the interaction is neither increasing nor ;; Otherwise the interaction is neither increasing nor
;; decreasing. ;; decreasing.
[else '0]))) [else '0])))
;;; Constructs a signed interaction graph of a given network form,
;;; given the ordered domains of its variables. The order on the
;;; domains determines the signs which will appear on the interaction
;;; graph.
;;;
;;; /!\ This function iterates through almost all states of the
;;; network for every arrow in the unsigned interaction graph, so its
;;; performance decreases very quickly with the size of the network.
(define (build-signed-interaction-graph network-form doms)
(let ([ig (build-interaction-graph network-form)])
(weighted-graph/directed
(for/list ([e (in-edges ig)])
(match-let ([(list x y) e])
(list (match (get-interaction-sign network-form doms x y)
['+ 1] ['- -1] ['0 0])
x y))))))