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

network: Add get-interaction-sign.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-11-17 23:38:34 +01:00
parent bfc48ff453
commit ff9654e5c6
1 changed files with 69 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
networks.rkt
View file

@ -32,6 +32,7 @@
[list-syntactic-interactions (-> network-form? variable? (listof variable?))]
[build-syntactic-interaction-graph (-> network-form? graph?)]
[interaction? (-> network? domain-mapping/c variable? variable? boolean?)]
[get-interaction-sign (-> network? domain-mapping/c variable? variable? (or/c #f -1 0 1))]
[build-all-states (-> domain-mapping/c (listof state?))]
[make-same-domains (-> (listof variable?) generic-set? domain-mapping/c)]
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
@ -435,6 +436,74 @@
(check-false (interaction? n-multi 123-doms 'x 'y))
(check-true (interaction? n-multi 123-doms 'y 'x))))
;;; Given two variables x and y of a network f, checks whether they
;;; interact, and if they interact, returns 1 if increasing x leads to
;;; an increase in y, -1 if it leads to a decrease in y, and 0 if it
;;; can lead to both. If x has no impact on y, returns #f.
;;;
;;; Use interaction? if you only need to know whether two variables
;;; interact, because interaction? will be often faster.
(define (get-interaction-sign network doms x y)
(define dom-x (hash-ref doms x))
(define dom-y (hash-ref doms y))
(define y-func (hash-ref network y))
(define (collect-impacts-on-y st)
;; The way in which the values are ordered in the domains gives
;; a total order on these values. This means that considering
;; pairs of consecutive values of x is sufficient for testing the
;; sign of the interaction.
(define x-states (for/list ([x-val (in-list dom-x)])
(hash-set st x x-val)))
(for/list ([st1 (in-list x-states)]
[st2 (in-list (cdr x-states))])
(define y1-idx (index-of dom-y (y-func st1)))
(define y2-idx (index-of dom-y (y-func st2)))
(cond
[(< y1-idx y2-idx) '<]
[(> y1-idx y2-idx) '>]
[else '=])))
(define states-not-x (build-all-states (hash-remove doms x)))
(define interactions
(remove-duplicates
(for/list ([st (in-list states-not-x)])
(define impacts (remove-duplicates (collect-impacts-on-y st)))
(cond
[(and (member '< impacts) (not (member '> impacts))) '<]
[(and (member '> impacts) (not (member '< impacts))) '>]
[(equal? impacts '(=)) '=]
[else 0]))))
(match interactions
[(list '<) 1]
[(list '>) -1]
[(list '=) #f]
[_ 0]))
(module+ test
(test-case "get-interaction-sign"
(define n-bool (network-form->network
(hash 'x '(not y)
'y 'x
'z '(and y z)
't '(or (and (not x) y)
(and x (not y))))))
(define bool-doms (make-boolean-domains '(x y z t)))
(check-equal? (get-interaction-sign n-bool bool-doms 'x 'y) 1)
(check-equal? (get-interaction-sign n-bool bool-doms 'y 'x) -1)
(check-false (get-interaction-sign n-bool bool-doms 'x 'z))
(check-equal? (get-interaction-sign n-bool bool-doms 'x 't) 0)
(check-true (interaction? n-bool bool-doms 'y 'x))
(check-false (interaction? n-bool bool-doms 'x 'z))
(define n-multi (network-form->network
(hash 'x '(min (+ y 1) 2)
'y '(max (- y 1) 0)
'z '(- 2 y)
't '(abs (- y 1)))))
(define 123-doms (make-same-domains '(x y z t) '(0 1 2)))
(check-false (get-interaction-sign n-multi 123-doms 'x 'y))
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'x) 1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 'z) -1)
(check-equal? (get-interaction-sign n-multi 123-doms 'y 't) 0)))
;;; ====================
;;; Dynamics of networks
;;; ====================