Type make-same-domains, make-boolean-domains, make-boolean-network.

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)

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}