networks: Make build-all-state take a hash as the domain mapping.
It used to take a list of pairs.
This commit is contained in:
parent
5a27469dce
commit
bdbbae6eb6
2 changed files with 8 additions and 6 deletions
|
@ -60,7 +60,7 @@
|
||||||
(check-false (has-edge? ig 'c 'b))
|
(check-false (has-edge? ig 'c 'b))
|
||||||
(check-false (has-edge? ig 'c 'a)))
|
(check-false (has-edge? ig 'c 'a)))
|
||||||
|
|
||||||
(check-equal? (map hash->list (build-all-states '((a . (#t #f)) (b . (1 2 3)))))
|
(check-equal? (map hash->list (build-all-states #hash((a . (#t #f)) (b . (1 2 3)))))
|
||||||
'(((a . #t) (b . 1))
|
'(((a . #t) (b . 1))
|
||||||
((a . #t) (b . 2))
|
((a . #t) (b . 2))
|
||||||
((a . #t) (b . 3))
|
((a . #t) (b . 3))
|
||||||
|
|
12
networks.rkt
12
networks.rkt
|
@ -23,7 +23,7 @@
|
||||||
network?)]
|
network?)]
|
||||||
[list-interactions (-> network-form? variable? (listof variable?))]
|
[list-interactions (-> network-form? variable? (listof variable?))]
|
||||||
[build-interaction-graph (-> network-form? graph?)]
|
[build-interaction-graph (-> network-form? graph?)]
|
||||||
[build-all-states (-> (listof (cons/c variable? generic-set?)) (listof state?))]
|
[build-all-states (-> (hash/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?))]
|
||||||
[make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))]
|
[make-same-domains (-> (listof variable?) generic-set? (hash/c variable? generic-set?))]
|
||||||
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
|
[make-boolean-domains (-> (listof variable?) (hash/c variable? (list/c #f #t)))]
|
||||||
|
@ -147,10 +147,12 @@
|
||||||
(for/list ([(var _) n]) (cons var (list-interactions n var))))))
|
(for/list ([(var _) n]) (cons var (list-interactions n var))))))
|
||||||
|
|
||||||
;;; Given a list of pairs mapping variables to generic sets of their
|
;;; Given a list of pairs mapping variables to generic sets of their
|
||||||
|
;;; Given a hash-set mapping variables to generic sets of their
|
||||||
;;; possible values, constructs the list of all possible states.
|
;;; possible values, constructs the list of all possible states.
|
||||||
(define (build-all-states vars-domains)
|
(define (build-all-states vars-domains)
|
||||||
(let ([vars (map car vars-domains)]
|
(let* ([var-dom-list (hash->list vars-domains)]
|
||||||
[domains (map cdr vars-domains)])
|
[vars (map car var-dom-list)]
|
||||||
|
[domains (map cdr var-dom-list)])
|
||||||
(for/list ([s (apply cartesian-product domains)])
|
(for/list ([s (apply cartesian-product domains)])
|
||||||
(make-state (for/list ([var vars] [val s])
|
(make-state (for/list ([var vars] [val s])
|
||||||
(cons var val))))))
|
(cons var val))))))
|
||||||
|
@ -158,7 +160,7 @@
|
||||||
;;; Given a list of variables and a domain common to all of them,
|
;;; Given a list of variables and a domain common to all of them,
|
||||||
;;; builds the list of all possible states.
|
;;; builds the list of all possible states.
|
||||||
(define (build-all-states-same-domain vars domain)
|
(define (build-all-states-same-domain vars domain)
|
||||||
(build-all-states (for/list ([v vars]) (cons v domain))))
|
(build-all-states (for/hash ([v vars]) (values v domain))))
|
||||||
|
|
||||||
;;; Makes a hash set mapping all variables to a single domain.
|
;;; Makes a hash set mapping all variables to a single domain.
|
||||||
(define (make-same-domains vars domain)
|
(define (make-same-domains vars domain)
|
||||||
|
@ -188,7 +190,7 @@
|
||||||
;; 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
|
||||||
;; replace its domain by a singleton, all states will contain
|
;; replace its domain by a singleton, all states will contain
|
||||||
;; the same value for x.
|
;; the same value for x.
|
||||||
[states-no-x (build-all-states (hash->list doms-no-x))]
|
[states-no-x (build-all-states doms-no-x)]
|
||||||
;; Go through all states, then through all ordered pairs of
|
;; Go through all states, then through all ordered pairs of
|
||||||
;; values of x, generate pairs of states (s1, s2) such that x
|
;; 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
|
;; has a smaller value in s1, and check that updating y in s1
|
||||||
|
|
Loading…
Reference in a new issue