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

networks: Add get-interaction-sign.

This commit is contained in:
Sergiu Ivanov 2020-02-23 00:04:19 +01:00
parent c2c87d0a7d
commit fbef580a01
2 changed files with 54 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
networks-tests.rkt
View File

@ -71,4 +71,9 @@
'(((a . #t) (b . #t))
((a . #t) (b . #f))
((a . #f) (b . #t))
((a . #f) (b . #f)))))
((a . #f) (b . #f))))
(let ([n #hash((a . (not b)) (b . a))]
[doms (make-immutable-hash (for/list ([var '(a b)]) (cons var '(#f #t))))])
(check-equal? (get-interaction-sign n doms 'a 'b) '+)
(check-equal? (get-interaction-sign n doms 'b 'a) '-)))

49
networks.rkt
View File

@ -24,7 +24,8 @@
[list-interactions (-> network-form? variable? (listof variable?))]
[build-interaction-graph (-> network-form? graph?)]
[build-all-states (-> (listof (cons/c variable? generic-set?)) (listof state?))]
[build-all-states-same-domain (-> (listof variable?) generic-set? (listof state?))])
[build-all-states-same-domain (-> (listof variable?) generic-set? (listof state?))]
[get-interaction-sign (-> network-form? (hash/c variable? generic-set?) variable? variable? (or/c '+ '- '0))])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
[state? (-> any/c boolean?)]
@ -157,3 +158,49 @@
;;; builds the list of all possible states.
(define (build-all-states-same-domain vars domain)
(build-all-states (for/list ([v vars]) (cons v domain))))
;;; Given two interacting variables of a network form and the domains
;;; of the variables, returns '+ if the interaction is monotonously
;;; increasing, '- if it is monotonously decreasing, and '0 otherwise.
;;;
;;; This function does not check whether the two variables indeed
;;; interact. Its behaviour is undefined if the variables do not
;;; interact.
;;;
;;; /!\ This function iterates through almost all of the states of the
;;; network, so its performance decreases very quickly with network
;;; size.
(define (get-interaction-sign network-form doms x y)
(let* ([dom-x (hash-ref doms x)]
[dom-y (hash-ref doms y)]
[network (network-form->network network-form)]
;; Replace the domain of x by a dummy singleton.
[doms-no-x (hash-set doms x '(#f))]
;; Build all the states, but as if x were not there: since I
;; replace its domain by a singleton, all states will contain
;; the same value for x.
[states-no-x (build-all-states (hash->list doms-no-x))]
;; Go through all states, then through all ordered pairs of
;; values of x, generate pairs of states (s1, s2) such that x
;; has a smaller value in s1, and check that updating y in s1
;; yields a smaller value than updating y in s2. I rely on
;; the fact that the domains are ordered.
[x-y-interactions (for*/list ([s states-no-x]
[x1 dom-x] ; ordered pairs of values of x
[x2 (cdr (member x1 dom-x))])
(let* ([s1 (hash-set s x x1)] ; s1(x) < s2(x)
[s2 (hash-set s x x2)]
[y1 ((hash-ref network y) s1)]
[y2 ((hash-ref network y) s2)])
;; y1 <= y2?
(<= (index-of dom-y y1) (index-of dom-y y2))))])
(cond
;; If, in all interactions, y1 <= y2, then we have an
;; increasing/promoting interaction between x and y.
[(andmap (λ (x) (eq? x #t)) x-y-interactions) '+]
;; If, in all interactions, y1 > y2, then we have an
;; decreasing/inhibiting interaction between x and y.
[(andmap (λ (x) (eq? x #f)) x-y-interactions) '-]
;; Otherwise the interaction is neither increasing nor
;; decreasing.
[else '0])))