Add tabulate-state, tabulate-state/boolean, tabulate-state+headers, tabulate-state+headers/boolean.
This commit is contained in:
parent
dd23de304f
commit
0e5334f5e1
2 changed files with 102 additions and 1 deletions
68
networks.rkt
68
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)
|
||||
|
|
|
@ -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}
|
||||
|
|
Loading…
Reference in a new issue