networks: Add build-all-states.
This commit is contained in:
parent
511aa60c31
commit
da3f25922a
2 changed files with 20 additions and 2 deletions
|
@ -58,4 +58,12 @@
|
||||||
(check-true (has-edge? ig 'b 'a))
|
(check-true (has-edge? ig 'b 'a))
|
||||||
(check-true (has-edge? ig 'b 'b))
|
(check-true (has-edge? ig 'b 'b))
|
||||||
(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)))))
|
||||||
|
'(((a . #t) (b . 1))
|
||||||
|
((a . #t) (b . 2))
|
||||||
|
((a . #t) (b . 3))
|
||||||
|
((a . #f) (b . 1))
|
||||||
|
((a . #f) (b . 2))
|
||||||
|
((a . #f) (b . 3)))))
|
||||||
|
|
12
networks.rkt
12
networks.rkt
|
@ -22,7 +22,8 @@
|
||||||
[make-network-from-forms (-> (listof (cons/c symbol? update-function-form?))
|
[make-network-from-forms (-> (listof (cons/c symbol? update-function-form?))
|
||||||
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?))])
|
||||||
;; Predicates
|
;; Predicates
|
||||||
(contract-out [variable? (-> any/c boolean?)]
|
(contract-out [variable? (-> any/c boolean?)]
|
||||||
[state? (-> any/c boolean?)]
|
[state? (-> any/c boolean?)]
|
||||||
|
@ -141,3 +142,12 @@
|
||||||
(unweighted-graph/adj
|
(unweighted-graph/adj
|
||||||
(hash-map n (λ (var _)
|
(hash-map n (λ (var _)
|
||||||
(cons var (list-interactions n var)))))))
|
(cons var (list-interactions n var)))))))
|
||||||
|
|
||||||
|
;;; Given a list of pairs mapping variables to generic sets of their
|
||||||
|
;;; possible values, constructs the list of all possible states.
|
||||||
|
(define (build-all-states vars-domains)
|
||||||
|
(let ([vars (map car vars-domains)]
|
||||||
|
[domains (map cdr vars-domains)])
|
||||||
|
(for/list ([s (apply cartesian-product domains)])
|
||||||
|
(make-state (for/list ([var vars] [val s])
|
||||||
|
(cons var val))))))
|
||||||
|
|
Loading…
Reference in a new issue