Type make-01-domains and make-01-network.

networks.rkt

@@ -11,7 +11,8 @@
    State UpdateFunction Domain DomainMapping
    (struct-out network) Network
 
-   make-same-domains make-boolean-domains make-boolean-network)
+   make-same-domains make-boolean-domains make-boolean-network
+   make-01-domains make-01-network)
 
   (define-type (State a) (VariableMapping a))
   (define-type (UpdateFunction a) (-> (State a) a))
@@ -56,6 +57,31 @@
                    (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)))))
+
+  (: make-01-domains (-> (Listof Variable) (DomainMapping (U Zero One))))
+  (define (make-01-domains vars)
+    (make-same-domains vars '(0 1)))
+
+  (module+ test
+    (test-case "make-01-domains"
+      (check-equal? (make-01-domains '(a b))
+                    '#hash((a . (0 1)) (b . (0 1))))))
+
+  (: make-01-network (-> (VariableMapping (UpdateFunction (U Zero One)))
+                         (Network (U Zero One))))
+  (define (make-01-network funcs)
+    (network funcs (make-01-domains (hash-keys funcs))))
+
+  (module+ test
+    (test-case "make-01-network"
+      (define f1 (λ ([s : (State (U Zero One))])
+                   (assert-type (max (hash-ref s 'a) (hash-ref s 'b))
+                                (U Zero One))))
+      (define f2 (λ ([s : (State (U Zero One))])
+                   (assert-type (min (hash-ref s 'a) (hash-ref s 'b))
+                                (U Zero One))))
+      (define n (make-01-network (hash 'a f1 'b f2)))
+      (check-equal? (network-domains n) (hash 'a '(0 1) 'b '(0 1)))))
   )
 
 (require 'typed)
@@ -76,8 +102,7 @@
                [struct network-form ([forms variable-mapping?]
                                      [domains domain-mapping/c])])
  ;; Functions
- (contract-out [make-01-network (-> (hash/c variable? procedure?) network?)]
-               [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)]
+ (contract-out [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?)]
                [booleanize-state (-> state? state?)]
@@ -94,7 +119,6 @@
                [build-signed-interaction-graph (-> network? graph?)]
                [build-signed-interaction-graph/form (-> network-form? graph?)]
                [build-all-states (-> domain-mapping/c (listof state?))]
-               [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?))]
                [make-asyn (-> (listof variable?) mode?)]
@@ -225,11 +249,6 @@
 ;;; values in their domains.
 (define domain-mapping/c (hash/c variable? list?))
 
-;;; 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))))
-
 ;;; Given a state s updates all the variables from xs.
 (define (update network s xs)
   (define funcs (network-functions network))
@@ -437,16 +456,6 @@
                     #hash((a . #f) (b . 2))
                     #hash((a . #f) (b . 3))))))
 
-;;; Makes a hash set mapping all variables to the Boolean domain,
-;;; expressed as {0,1}.
-(define (make-01-domains vars)
-  (make-same-domains vars '(0 1)))
-
-(module+ test
-  (test-case "make-01-domains"
-    (check-equal? (make-01-domains '(a b))
-                  '#hash((a . (0 1)) (b . (0 1))))))
-
 ;;; Builds all boolean states possible over a given set of variables.
 (define (build-all-boolean-states vars)
   (build-all-states (make-boolean-domains vars)))

scribblings/networks.scrbl

@@ -80,6 +80,23 @@ the variables @racket[a] and @racket[b]:
   (and (hash-ref s 'a) (hash-ref s 'b)))
 ]
 
+These are two functions calculating an @italic{AND} and an @italic{OR} between
+two variables @racket[a] and @racket[b] whose values are in @tt{{0,1}}:
+
+@ex[
+(require (only-in "utils.rkt" assert-type))
+
+(: or-func/01 (UpdateFunction (U Zero One)))
+(define (or-func/01 s)
+  (assert-type (max (hash-ref s 'a) (hash-ref s 'b))
+               (U Zero One)))
+
+(: and-func/01 (UpdateFunction (U Zero One)))
+(define (and-func/01 s)
+  (assert-type (min (hash-ref s 'a) (hash-ref s 'b))
+               (U Zero One)))
+]
+
 @section{Networks}
 
 @defstruct*[network ([functions (VariableMapping (UpdateFunction a))]
@@ -132,6 +149,26 @@ variables by attributing Boolean domains to every variable.
 (make-boolean-network (hash 'a or-func 'b and-func))
 ]}
 
+@defproc[(make-01-domains [vars (Listof Variable)])
+			  (DomainMapping (U Zero One))]{
+
+Makes a hash set mapping all variables to the Boolean domain, expressed as
+@tt{{0,1}}.
+
+@ex[
+(make-01-domains '(a b))
+]}
+
+@defproc[(make-01-network [funcs (VariableMapping (UpdateFunction (U Zero One)))])
+			  (Network (U Zero One))]{
+
+Build a network from a given hash table assigning functions to variables by
+attributing the domain @tt{{0,1}} to every variable.
+
+@ex[
+(make-01-network (hash 'a or-func/01 'b and-func/01))
+]}
+
 @section{Syntactic description of networks}
 
 @section{Inferring interaction graphs}