networks: Make get-interaction-sign take a network, not a form.

This commit is contained in:
Sergiu Ivanov 2020-03-22 20:43:14 +01:00
parent b38bebb67b
commit 65445e6ba8
2 changed files with 8 additions and 8 deletions

View file

@ -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))

View file

@ -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