diff --git a/networks.rkt b/networks.rkt index a7ffd70..bf8bb74 100644 --- a/networks.rkt +++ b/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))))