diff --git a/networks.rkt b/networks.rkt index 82b053f..26cd3c5 100644 --- a/networks.rkt +++ b/networks.rkt @@ -2,7 +2,8 @@ (module typed typed/racket (require "utils.rkt" "functions.rkt" "dynamics.rkt" - typed/graph racket/random) + typed/graph racket/random + syntax/parse/define) (module+ test (require typed/rackunit) @@ -41,6 +42,8 @@ tabulate-state* tabulate-state*/boolean tabulate-state*+headers tabulate-state*+headers/boolean + tabulate-state tabulate-state/boolean + tabulate-state+headers tabulate-state+headers/boolean ) (define-type (State a) (VariableMapping a)) @@ -813,6 +816,69 @@ (#f #t #f #t) (#t #f #f #t) (#t #t #t #t))))) + + (define-syntax-parse-rule (make-tabulate-no-star name star-name) + (define (name func domains) + (star-name `(,func) domains))) + + (: tabulate-state (All (a) (-> (-> (State a) a) (DomainMapping a) + (Listof (Listof a))))) + (make-tabulate-no-star tabulate-state tabulate-state*) + + (module+ test + (test-case "tabulate-state" + (check-equal? (tabulate-state (λ/: (State Integer) (+ :a :b)) + (hash 'a '(1 2) 'b '(2 3))) + '((1 2 3) + (1 3 4) + (2 2 4) + (2 3 5))))) + + (: tabulate-state+headers (All (a) (-> (-> (State a) a) (DomainMapping a) + (Pairof (Listof Symbol) + (Listof (Listof a)))))) + (make-tabulate-no-star tabulate-state+headers tabulate-state*+headers) + + (module+ test + (test-case "tabulate-state+headers" + (check-equal? (tabulate-state+headers + (λ/: (State Integer) (+ :a :b)) + (hash 'a '(1 2) 'b '(2 3))) + '((a b f1) + (1 2 3) + (1 3 4) + (2 2 4) + (2 3 5))))) + + (: tabulate-state/boolean + (-> (-> (State Boolean) Boolean) + (Listof Variable) + (Listof (Listof Boolean)))) + (make-tabulate-no-star tabulate-state/boolean tabulate-state*/boolean) + + (module+ test + (test-case "tabulate-state/boolean" + (check-equal? (tabulate-state/boolean (λ/: (State Boolean) (and :a :b)) '(a b)) + '((#f #f #f) + (#f #t #f) + (#t #f #f) + (#t #t #t))))) + + (: tabulate-state+headers/boolean + (-> (-> (State Boolean) Boolean) + (Listof Variable) + (Pairof (Listof Symbol) (Listof (Listof Boolean))))) + (make-tabulate-no-star tabulate-state+headers/boolean tabulate-state*+headers/boolean) + + (module+ test + (test-case "tabulate-state+headers/boolean" + (check-equal? (tabulate-state+headers/boolean + (λ/: (State Boolean) (and :a :b)) '(a b)) + '((a b f1) + (#f #f #f) + (#f #t #f) + (#t #f #f) + (#t #t #t))))) ) (require 'typed) diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 4f970eb..ca6b753 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -775,6 +775,41 @@ states, like @racket[tabulate-state*]. '(a b)) ]} +@deftogether[(@defproc[(tabulate-state [func (-> (State a) a)] + [domains (DomainMapping a)]) + (Listof (Listof a))] + @defproc[(tabulate-state+headers + [func (-> (State a) a)] + [domains (DomainMapping a)]) + (Pairof (Listof Symbol) (Listof (Listof a)))] + @defproc[(tabulate-state/boolean [func (-> (State Boolean) Boolean)] + [args (Listof Variable)]) + (Listof (Listof Boolean))] + @defproc[(tabulate-state+headers/boolean + [func (-> (State Boolean) Boolean)] + [args (Listof Variable)]) + (Pairof (Listof Symbol) (Listof (Listof Boolean)))])]{ + +Like the starred versions @racket[tabulate-state*], +@racket[tabulate-state*+headers], @racket[tabulate-state/boolean], and +@racket[tabulate-state+headers/boolean], but only tabulate one +function instead of a list. + +@ex[ +(tabulate-state + (λ/: (State Boolean) (and :a :b)) + (hash 'a '(#f #t) 'b '(#f #t))) +(tabulate-state+headers + (λ/: (State Boolean) (and :a :b)) + (hash 'a '(#f #t) 'b '(#f #t))) +(tabulate-state/boolean + (λ/: (State Boolean) (and :a :b)) + '(a b)) +(tabulate-state+headers/boolean + (λ/: (State Boolean) (and :a :b)) + '(a b)) +]} + @section{Constructing functions and networks} @section{Random functions and networks}