diff --git a/networks.rkt b/networks.rkt index c93509e..3304104 100644 --- a/networks.rkt +++ b/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). diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 60a4e47..40c8f32 100644 --- a/scribblings/networks.scrbl +++ b/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}