networks: Add build-signed-interaction-graph.
This commit is contained in:
parent
798178852c
commit
daf2e079ae
2 changed files with 34 additions and 4 deletions
|
@ -75,7 +75,19 @@
|
|||
(check-equal? (hash->list (make-boolean-domains '(a b)))
|
||||
'((a . (#f #t)) (b . (#f #t))))
|
||||
|
||||
(let ([n #hash((a . (not b)) (b . a))]
|
||||
[doms (make-boolean-domains '(a b))])
|
||||
(let* ([n #hash((a . (not b)) (b . a))]
|
||||
[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 '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
20
networks.rkt
|
@ -27,7 +27,8 @@
|
|||
[build-all-states-same-domain (-> (listof variable?) generic-set? (listof state?))]
|
||||
[make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))]
|
||||
[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
|
||||
(contract-out [variable? (-> any/c boolean?)]
|
||||
[state? (-> any/c boolean?)]
|
||||
|
@ -214,3 +215,20 @@
|
|||
;; Otherwise the interaction is neither increasing nor
|
||||
;; decreasing.
|
||||
[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))))))
|
||||
|
|
Loading…
Reference in a new issue