networks: Add make-boolean-network.

networks.rkt

@@ -24,7 +24,8 @@
                [struct network-form ([forms variable-mapping?]
                                      [domains domain-mapping/c])])
  ;; Functions
- (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)]
+ (contract-out [make-boolean-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?)]
                [booleanize-state (-> state? state?)]
@@ -183,6 +184,21 @@
 ;;; their domains.
 (struct network (functions domains))
 
+;;; 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))))
+
+(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? (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))
@@ -196,7 +212,7 @@
                         (and x1 (not x2)))))
     (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)])
                         (not x2))))
-    (define bn (hash 'x1 f1 'x2 f2))
+    (define bn (make-boolean-network (hash 'x1 f1 'x2 f2)))
     (define s1 (make-state '((x1 . #t) (x2 . #f))))
     (define new-s1 (update bn s1 '(x2 x1)))
     (define s2 (make-state '((x1 . #f) (x2 . #f))))