Add tabulate-state, tabulate-state/boolean, tabulate-state+headers, tabulate-state+headers/boolean.
This commit is contained in:
Sergiu Ivanov
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
|
(module typed typed/racket
|
||||||
(require "utils.rkt" "functions.rkt" "dynamics.rkt"
|
(require "utils.rkt" "functions.rkt" "dynamics.rkt"
|
||||||
typed/graph racket/random)
|
typed/graph racket/random
|
||||||
|
syntax/parse/define)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require typed/rackunit)
|
(require typed/rackunit)
|
||||||
|
|
@ -41,6 +42,8 @@
|
||||||
|
|
||||||
tabulate-state* tabulate-state*/boolean
|
tabulate-state* tabulate-state*/boolean
|
||||||
tabulate-state*+headers tabulate-state*+headers/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))
|
(define-type (State a) (VariableMapping a))
|
||||||
|
|
@ -813,6 +816,69 @@
|
||||||
(#f #t #f #t)
|
(#f #t #f #t)
|
||||||
(#t #f #f #t)
|
(#t #f #f #t)
|
||||||
(#t #t #t #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)
|
(require 'typed)
|
||||||
|
|
|
||||||
|
|
@ -775,6 +775,41 @@ states, like @racket[tabulate-state*].
|
||||||
'(a b))
|
'(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{Constructing functions and networks}
|
||||||
|
|
||||||
@section{Random functions and networks}
|
@section{Random functions and networks}
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue