diff --git a/networks.rkt b/networks.rkt index 860ff86..8f1bf78 100644 --- a/networks.rkt +++ b/networks.rkt @@ -9,7 +9,9 @@ (provide State UpdateFunction DomainMapping - (struct-out network) Network) + (struct-out network) Network + + make-same-domains make-boolean-domains make-boolean-network) (define-type (State a) (VariableMapping a)) (define-type (UpdateFunction a) (-> (State a) a)) @@ -19,6 +21,40 @@ [domains : (DomainMapping a)]) #:transparent #:type-name Network) + + (: make-same-domains (All (a) (-> (Listof Variable) (Listof a) + (DomainMapping a)))) + (define (make-same-domains vars domain) + (for/hash ([var vars]) : (DomainMapping a) + (values var domain))) + + (module+ test + (test-case "make-same-domains" + (check-equal? (make-same-domains '(a b) '(1 2)) + #hash((a . (1 2)) (b . (1 2)))))) + + (: make-boolean-domains (-> (Listof Variable) (DomainMapping Boolean))) + (define (make-boolean-domains vars) + (make-same-domains vars '(#f #t))) + + (module+ test + (test-case "make-boolean-domains" + (check-equal? (make-boolean-domains '(a b)) + #hash((a . (#f #t)) (b . (#f #t)))))) + + (: make-boolean-network (-> (VariableMapping (UpdateFunction Boolean)) + (Network Boolean))) + (define (make-boolean-network funcs) + (network funcs (make-boolean-domains (hash-keys funcs)))) + + (module+ test + (test-case "make-boolean-network" + (define f1 (λ ([s : (State Boolean)]) + (and (hash-ref s 'x1) (not (hash-ref s 'x2))))) + (define f2 (λ ([s : (State Boolean)]) + (not (hash-ref s 'x2)))) + (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) + (check-equal? (network-domains bn) (hash 'x1 '(#f #t) 'x2 '(#f #t))))) ) (require 'typed) @@ -39,8 +75,7 @@ [struct network-form ([forms variable-mapping?] [domains domain-mapping/c])]) ;; Functions - (contract-out [make-boolean-network (-> (hash/c variable? procedure?) network?)] - [make-01-network (-> (hash/c variable? procedure?) network?)] + (contract-out [make-01-network (-> (hash/c variable? procedure?) network?)] [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] @@ -58,8 +93,6 @@ [build-signed-interaction-graph (-> network? graph?)] [build-signed-interaction-graph/form (-> network-form? graph?)] [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)))] [make-01-domains (-> (listof variable?) (hash/c variable? (list/c 0 1)))] [build-all-boolean-states (-> (listof variable?) (listof state?))] [build-all-01-states (-> (listof variable?) (listof state?))] @@ -191,26 +224,11 @@ ;;; values in their domains. (define domain-mapping/c (hash/c variable? list?)) -;;; Builds a network from a given hash table assigning functions to -;;; variables by attributing Boolean domains to every variable. -(define (make-boolean-network funcs) - (network funcs (make-boolean-domains (hash-keys funcs)))) - ;;; Build a network from a given hash table assigning functions to ;;; variables by attributing the domain {0,1} to every variable. (define (make-01-network funcs) (network funcs (make-01-domains (hash-keys funcs)))) -(module+ test - (test-case "make-boolean-network" - (define f1 (λ (s) (let ([x1 (hash-ref s 'x1)] - [x2 (hash-ref s 'x2)]) - (and x1 (not x2))))) - (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) - (not x2)))) - (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) - (check-equal? (network-domains bn) (hash 'x1 '(#f #t) 'x2 '(#f #t))))) - ;;; Given a state s updates all the variables from xs. (define (update network s xs) (define funcs (network-functions network)) @@ -418,19 +436,6 @@ #hash((a . #f) (b . 2)) #hash((a . #f) (b . 3)))))) -;;; Makes a hash set mapping all variables to a single domain. -(define (make-same-domains vars domain) - (for/hash ([var vars]) (values var domain))) - -;;; Makes a hash set mapping all variables to the Boolean domain. -(define (make-boolean-domains vars) - (make-same-domains vars '(#f #t))) - -(module+ test - (test-case "make-same-domains, make-boolean-domains" - (check-equal? (make-boolean-domains '(a b)) - #hash((a . (#f #t)) (b . (#f #t)))))) - ;;; Makes a hash set mapping all variables to the Boolean domain, ;;; expressed as {0,1}. (define (make-01-domains vars) diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index f873757..74d6656 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -77,6 +77,45 @@ The type of the instances of @racket[Network]. 'b '(#f #t))) ]} +@section{Constructing networks} + +@defproc[(make-same-domains [vars (Listof Variable)] + [domain (Listof a)]) + (DomainMapping a)]{ + +Makes a hash set mapping all variables to a single domain. + +@ex[ +(make-same-domains '(a b) '(1 2)) +]} + +@defproc[(make-boolean-domains [vars (Listof Variable)]) + (DomainMapping Boolean)]{ + +Makes a hash set mapping all variables to the Boolean domain. + +@ex[ +(make-boolean-domains '(a b)) +]} + +@defproc[(make-boolean-network [vars (VariableMapping (UpdateFunction Boolean))]) + (Network Boolean)]{ + +Builds a Boolean network from a given hash table assigning functions to +variables by attributing Boolean domains to every variable. + +@ex[ +(: or-func (UpdateFunction Boolean)) +(define (or-func s) + (or (hash-ref s 'a) (hash-ref s 'b))) + +(: and-func (UpdateFunction Boolean)) +(define (and-func s) + (and (hash-ref s 'a) (hash-ref s 'b))) + +(make-boolean-network (hash 'a or-func 'b and-func)) +]} + @section{Syntactic description of networks} @section{Inferring interaction graphs}