diff --git a/networks-tests.rkt b/networks-tests.rkt index d2b1f00..17d9205 100644 --- a/networks-tests.rkt +++ b/networks-tests.rkt @@ -17,6 +17,12 @@ (not x2)))] [bn (make-network-from-functions `((x1 . ,f1) (x2 . ,f2)))]) + (test-case "States" + (check-equal? (make-state-booleanize '((a . 0) (b . 1))) + (st '((a . #f) (b . #t)))) + (check-equal? (stb '((a . 0) (b . 1))) + (st '((a . #f) (b . #t))))) + (test-case "One-step syncronous update" (let* ([s (make-state '((x1 . #t) (x2 . #f)))] [new-s (update bn s '(x2 x1))]) diff --git a/networks.rkt b/networks.rkt index cf0a25e..b1765a1 100644 --- a/networks.rkt +++ b/networks.rkt @@ -18,6 +18,7 @@ ;; Functions (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?)] [make-network-from-functions (-> (listof (cons/c symbol? update-function/c)) network?)] [update-function-form->update-function (-> update-function-form? update-function/c)] [network-form->network (-> network-form? network?)] @@ -62,7 +63,7 @@ [update-function/c contract?] [domain-mapping/c contract?]) ;; Syntax - st nn ppsg ppsgb) + st stb nn ppsg ppsgb) ;;; ================= @@ -99,6 +100,17 @@ ;;; A shortcut for make-state. (define-syntax-rule (st mappings) (make-state mappings)) +;;; Makes a new Boolean states from a state with numerical values 0 +;;; and 1. +(define (make-state-booleanize mappings) + (make-state (for/list ([mp mappings]) + (match mp + [(cons var 0) (cons var #f)] + [(cons var 1) (cons var #t)])))) + +;;; A shortcut for make-state-booleanize. +(define-syntax-rule (stb mappings) (make-state-booleanize mappings)) + ;;; A version of make-immutable-hash restricted to creating networks. (define (make-network-from-functions funcs) (make-immutable-hash funcs))