networks: Make get-interaction-sign take a network, not a form.
This commit is contained in:
parent
b38bebb67b
commit
65445e6ba8
2 changed files with 8 additions and 8 deletions
|
@ -85,8 +85,8 @@
|
||||||
[doms (make-boolean-domains '(a b))]
|
[doms (make-boolean-domains '(a b))]
|
||||||
[sig1 (build-signed-interaction-graph n doms)]
|
[sig1 (build-signed-interaction-graph n doms)]
|
||||||
[sig2 (build-boolean-signed-interaction-graph n)])
|
[sig2 (build-boolean-signed-interaction-graph n)])
|
||||||
(check-equal? (get-interaction-sign n doms 'a 'b) '+)
|
(check-equal? (get-interaction-sign (nn n) doms 'a 'b) '+)
|
||||||
(check-equal? (get-interaction-sign n doms 'b 'a) '-)
|
(check-equal? (get-interaction-sign (nn n) doms 'b 'a) '-)
|
||||||
|
|
||||||
(check-true (has-vertex? sig1 'a))
|
(check-true (has-vertex? sig1 'a))
|
||||||
(check-true (has-vertex? sig1 'b))
|
(check-true (has-vertex? sig1 'b))
|
||||||
|
|
12
networks.rkt
12
networks.rkt
|
@ -31,7 +31,7 @@
|
||||||
[make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
|
[make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
|
||||||
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
|
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
|
||||||
[build-all-boolean-states (-> (listof variable?) (listof state?))]
|
[build-all-boolean-states (-> (listof variable?) (listof state?))]
|
||||||
[get-interaction-sign (-> network-form? domain-mapping/c variable? variable? (or/c '+ '- '0))]
|
[get-interaction-sign (-> network? 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?)]
|
[build-boolean-signed-interaction-graph (-> network-form? graph?)]
|
||||||
[make-asyn (-> (listof variable?) mode?)]
|
[make-asyn (-> (listof variable?) mode?)]
|
||||||
|
@ -238,7 +238,7 @@
|
||||||
(define (build-all-boolean-states vars)
|
(define (build-all-boolean-states vars)
|
||||||
(build-all-states (make-boolean-domains vars)))
|
(build-all-states (make-boolean-domains vars)))
|
||||||
|
|
||||||
;;; Given two interacting variables of a network form and the domains
|
;;; Given two interacting variables of a network and the domains
|
||||||
;;; of the variables, returns '+ if the interaction is monotonously
|
;;; of the variables, returns '+ if the interaction is monotonously
|
||||||
;;; increasing, '- if it is monotonously decreasing, and '0 otherwise.
|
;;; increasing, '- if it is monotonously decreasing, and '0 otherwise.
|
||||||
;;;
|
;;;
|
||||||
|
@ -249,10 +249,9 @@
|
||||||
;;; /!\ This function iterates through almost all of the states of the
|
;;; /!\ This function iterates through almost all of the states of the
|
||||||
;;; network, so its performance decreases very quickly with network
|
;;; network, so its performance decreases very quickly with network
|
||||||
;;; size.
|
;;; size.
|
||||||
(define (get-interaction-sign network-form doms x y)
|
(define (get-interaction-sign network doms x y)
|
||||||
(let* ([dom-x (hash-ref doms x)]
|
(let* ([dom-x (hash-ref doms x)]
|
||||||
[dom-y (hash-ref doms y)]
|
[dom-y (hash-ref doms y)]
|
||||||
[network (network-form->network network-form)]
|
|
||||||
;; Replace the domain of x by a dummy singleton.
|
;; Replace the domain of x by a dummy singleton.
|
||||||
[doms-no-x (hash-set doms x '(#f))]
|
[doms-no-x (hash-set doms x '(#f))]
|
||||||
;; Build all the states, but as if x were not there: since I
|
;; Build all the states, but as if x were not there: since I
|
||||||
|
@ -293,11 +292,12 @@
|
||||||
;;; network for every arrow in the unsigned interaction graph, so its
|
;;; network for every arrow in the unsigned interaction graph, so its
|
||||||
;;; performance decreases very quickly with the size of the network.
|
;;; performance decreases very quickly with the size of the network.
|
||||||
(define (build-signed-interaction-graph network-form doms)
|
(define (build-signed-interaction-graph network-form doms)
|
||||||
(let ([ig (build-interaction-graph network-form)])
|
(let ([ig (build-interaction-graph network-form)]
|
||||||
|
[network (network-form->network network-form)])
|
||||||
(weighted-graph/directed
|
(weighted-graph/directed
|
||||||
(for/list ([e (in-edges ig)])
|
(for/list ([e (in-edges ig)])
|
||||||
(match-let ([(list x y) e])
|
(match-let ([(list x y) e])
|
||||||
(list (get-interaction-sign network-form doms x y)
|
(list (get-interaction-sign network doms x y)
|
||||||
x y))))))
|
x y))))))
|
||||||
|
|
||||||
;;; Calls build-signed-interaction-graph with the Boolean domain for
|
;;; Calls build-signed-interaction-graph with the Boolean domain for
|
||||||
|
|
Loading…
Reference in a new issue