Type update.

networks.rkt

@@ -12,7 +12,7 @@
    (struct-out network) Network
 
    make-same-domains make-boolean-domains make-boolean-network
-   make-01-domains make-01-network)
+   make-01-domains make-01-network update)
 
   (define-type (State a) (VariableMapping a))
   (define-type (UpdateFunction a) (-> (State a) a))
@@ -82,6 +82,26 @@
                                 (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)))))
+
+  (: update (All (a) (-> (Network a) (State a) (Listof Variable) (State a))))
+  (define (update network s xs)
+    (define funcs (network-functions network))
+    (for/fold ([new-s : (State a) s])
+              ([x xs])
+      (define fx (hash-ref funcs x))
+      (hash-set new-s x (fx s))))
+
+  (module+ test
+    (test-case "update"
+      (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? (update bn (hash 'x1 #f 'x2 #f) '(x1))
+                    #hash((x1 . #f) (x2 . #f)))
+      (check-equal? (update bn (hash 'x1 #f 'x2 #f) '(x1 x2))
+                    #hash((x1 . #f) (x2 . #t)))))
   )
 
 (require 'typed)
@@ -102,8 +122,7 @@
                [struct network-form ([forms variable-mapping?]
                                      [domains domain-mapping/c])])
  ;; Functions
- (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)]
-               [make-state (-> (listof (cons/c symbol? any/c)) state?)]
+ (contract-out [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?)]
                [update-function-form->update-function (-> update-function-form? update-function/c)]
@@ -249,31 +268,6 @@
 ;;; values in their domains.
 (define domain-mapping/c (hash/c variable? list?))
 
-;;; Given a state s updates all the variables from xs.
-(define (update network s xs)
-  (define funcs (network-functions network))
-  (for/fold ([new-s s])
-            ([x xs])
-    (define fx (hash-ref funcs x))
-    (hash-set new-s x (fx s))))
-
-(module+ test
-  (test-case "basic definitions"
-    (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)))
-    (define s1 (make-state '((x1 . #t) (x2 . #f))))
-    (define new-s1 (update bn s1 '(x2 x1)))
-    (define s2 (make-state '((x1 . #f) (x2 . #f))))
-    (define new-s2 (update bn s2 '(x2)))
-
-    (check-equal? s1 #hash((x1 . #t) (x2 . #f)))
-    (check-equal? new-s1 #hash((x1 . #t) (x2 . #t)))
-    (check-equal? s2 #hash((x1 . #f) (x2 . #f)))
-    (check-equal? new-s2 #hash((x1 . #f) (x2 . #t)))))
 
 ;;; A version of make-immutable-hash restricted to creating network
 ;;; states (see contract).

scribblings/networks.scrbl

@@ -169,6 +169,18 @@ attributing the domain @tt{{0,1}} to every variable.
 (make-01-network (hash 'a or-func/01 'b and-func/01))
 ]}
 
+@defproc[(update [network (Network a)] [s (State a)] [xs (Listof Variable)])
+		 (State a)]{
+
+Given a state @racket[s] updates all the variables of @racket[network] from
+@racket[xs].
+
+@ex[
+(update (make-boolean-network (hash 'a or-func 'b and-func))
+        (hash 'a #f 'b #t)
+	'(a))
+]}
+
 @section{Syntactic description of networks}
 
 @section{Inferring interaction graphs}