Type make-01-domains and make-01-network.
This commit is contained in:
parent
4ea31d8f39
commit
9a2f1ff527
2 changed files with 65 additions and 19 deletions
47
networks.rkt
47
networks.rkt
|
@ -11,7 +11,8 @@
|
||||||
State UpdateFunction Domain DomainMapping
|
State UpdateFunction Domain DomainMapping
|
||||||
(struct-out network) Network
|
(struct-out network) Network
|
||||||
|
|
||||||
make-same-domains make-boolean-domains make-boolean-network)
|
make-same-domains make-boolean-domains make-boolean-network
|
||||||
|
make-01-domains make-01-network)
|
||||||
|
|
||||||
(define-type (State a) (VariableMapping a))
|
(define-type (State a) (VariableMapping a))
|
||||||
(define-type (UpdateFunction a) (-> (State a) a))
|
(define-type (UpdateFunction a) (-> (State a) a))
|
||||||
|
@ -56,6 +57,31 @@
|
||||||
(not (hash-ref s 'x2))))
|
(not (hash-ref s 'x2))))
|
||||||
(define bn (make-boolean-network (hash 'x1 f1 'x2 f2)))
|
(define bn (make-boolean-network (hash 'x1 f1 'x2 f2)))
|
||||||
(check-equal? (network-domains bn) (hash 'x1 '(#f #t) 'x2 '(#f #t)))))
|
(check-equal? (network-domains bn) (hash 'x1 '(#f #t) 'x2 '(#f #t)))))
|
||||||
|
|
||||||
|
(: make-01-domains (-> (Listof Variable) (DomainMapping (U Zero One))))
|
||||||
|
(define (make-01-domains vars)
|
||||||
|
(make-same-domains vars '(0 1)))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "make-01-domains"
|
||||||
|
(check-equal? (make-01-domains '(a b))
|
||||||
|
'#hash((a . (0 1)) (b . (0 1))))))
|
||||||
|
|
||||||
|
(: make-01-network (-> (VariableMapping (UpdateFunction (U Zero One)))
|
||||||
|
(Network (U Zero One))))
|
||||||
|
(define (make-01-network funcs)
|
||||||
|
(network funcs (make-01-domains (hash-keys funcs))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "make-01-network"
|
||||||
|
(define f1 (λ ([s : (State (U Zero One))])
|
||||||
|
(assert-type (max (hash-ref s 'a) (hash-ref s 'b))
|
||||||
|
(U Zero One))))
|
||||||
|
(define f2 (λ ([s : (State (U Zero One))])
|
||||||
|
(assert-type (min (hash-ref s 'a) (hash-ref s 'b))
|
||||||
|
(U Zero One))))
|
||||||
|
(define n (make-01-network (hash 'a f1 'b f2)))
|
||||||
|
(check-equal? (network-domains n) (hash 'a '(0 1) 'b '(0 1)))))
|
||||||
)
|
)
|
||||||
|
|
||||||
(require 'typed)
|
(require 'typed)
|
||||||
|
@ -76,8 +102,7 @@
|
||||||
[struct network-form ([forms variable-mapping?]
|
[struct network-form ([forms variable-mapping?]
|
||||||
[domains domain-mapping/c])])
|
[domains domain-mapping/c])])
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out [make-01-network (-> (hash/c variable? procedure?) network?)]
|
(contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)]
|
||||||
[update (-> network? state? (set/c variable? #:kind 'dont-care) state?)]
|
|
||||||
[make-state (-> (listof (cons/c symbol? any/c)) state?)]
|
[make-state (-> (listof (cons/c symbol? any/c)) state?)]
|
||||||
[make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)]
|
[make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)]
|
||||||
[booleanize-state (-> state? state?)]
|
[booleanize-state (-> state? state?)]
|
||||||
|
@ -94,7 +119,6 @@
|
||||||
[build-signed-interaction-graph (-> network? graph?)]
|
[build-signed-interaction-graph (-> network? graph?)]
|
||||||
[build-signed-interaction-graph/form (-> network-form? graph?)]
|
[build-signed-interaction-graph/form (-> network-form? graph?)]
|
||||||
[build-all-states (-> domain-mapping/c (listof state?))]
|
[build-all-states (-> domain-mapping/c (listof state?))]
|
||||||
[make-01-domains (-> (listof variable?) (hash/c variable? (list/c 0 1)))]
|
|
||||||
[build-all-boolean-states (-> (listof variable?) (listof state?))]
|
[build-all-boolean-states (-> (listof variable?) (listof state?))]
|
||||||
[build-all-01-states (-> (listof variable?) (listof state?))]
|
[build-all-01-states (-> (listof variable?) (listof state?))]
|
||||||
[make-asyn (-> (listof variable?) mode?)]
|
[make-asyn (-> (listof variable?) mode?)]
|
||||||
|
@ -225,11 +249,6 @@
|
||||||
;;; values in their domains.
|
;;; values in their domains.
|
||||||
(define domain-mapping/c (hash/c variable? list?))
|
(define domain-mapping/c (hash/c variable? list?))
|
||||||
|
|
||||||
;;; Build a network from a given hash table assigning functions to
|
|
||||||
;;; variables by attributing the domain {0,1} to every variable.
|
|
||||||
(define (make-01-network funcs)
|
|
||||||
(network funcs (make-01-domains (hash-keys funcs))))
|
|
||||||
|
|
||||||
;;; Given a state s updates all the variables from xs.
|
;;; Given a state s updates all the variables from xs.
|
||||||
(define (update network s xs)
|
(define (update network s xs)
|
||||||
(define funcs (network-functions network))
|
(define funcs (network-functions network))
|
||||||
|
@ -437,16 +456,6 @@
|
||||||
#hash((a . #f) (b . 2))
|
#hash((a . #f) (b . 2))
|
||||||
#hash((a . #f) (b . 3))))))
|
#hash((a . #f) (b . 3))))))
|
||||||
|
|
||||||
;;; Makes a hash set mapping all variables to the Boolean domain,
|
|
||||||
;;; expressed as {0,1}.
|
|
||||||
(define (make-01-domains vars)
|
|
||||||
(make-same-domains vars '(0 1)))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(test-case "make-01-domains"
|
|
||||||
(check-equal? (make-01-domains '(a b))
|
|
||||||
'#hash((a . (0 1)) (b . (0 1))))))
|
|
||||||
|
|
||||||
;;; Builds all boolean states possible over a given set of variables.
|
;;; Builds all boolean states possible over a given set of variables.
|
||||||
(define (build-all-boolean-states vars)
|
(define (build-all-boolean-states vars)
|
||||||
(build-all-states (make-boolean-domains vars)))
|
(build-all-states (make-boolean-domains vars)))
|
||||||
|
|
|
@ -80,6 +80,23 @@ the variables @racket[a] and @racket[b]:
|
||||||
(and (hash-ref s 'a) (hash-ref s 'b)))
|
(and (hash-ref s 'a) (hash-ref s 'b)))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
These are two functions calculating an @italic{AND} and an @italic{OR} between
|
||||||
|
two variables @racket[a] and @racket[b] whose values are in @tt{{0,1}}:
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(require (only-in "utils.rkt" assert-type))
|
||||||
|
|
||||||
|
(: or-func/01 (UpdateFunction (U Zero One)))
|
||||||
|
(define (or-func/01 s)
|
||||||
|
(assert-type (max (hash-ref s 'a) (hash-ref s 'b))
|
||||||
|
(U Zero One)))
|
||||||
|
|
||||||
|
(: and-func/01 (UpdateFunction (U Zero One)))
|
||||||
|
(define (and-func/01 s)
|
||||||
|
(assert-type (min (hash-ref s 'a) (hash-ref s 'b))
|
||||||
|
(U Zero One)))
|
||||||
|
]
|
||||||
|
|
||||||
@section{Networks}
|
@section{Networks}
|
||||||
|
|
||||||
@defstruct*[network ([functions (VariableMapping (UpdateFunction a))]
|
@defstruct*[network ([functions (VariableMapping (UpdateFunction a))]
|
||||||
|
@ -132,6 +149,26 @@ variables by attributing Boolean domains to every variable.
|
||||||
(make-boolean-network (hash 'a or-func 'b and-func))
|
(make-boolean-network (hash 'a or-func 'b and-func))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(make-01-domains [vars (Listof Variable)])
|
||||||
|
(DomainMapping (U Zero One))]{
|
||||||
|
|
||||||
|
Makes a hash set mapping all variables to the Boolean domain, expressed as
|
||||||
|
@tt{{0,1}}.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(make-01-domains '(a b))
|
||||||
|
]}
|
||||||
|
|
||||||
|
@defproc[(make-01-network [funcs (VariableMapping (UpdateFunction (U Zero One)))])
|
||||||
|
(Network (U Zero One))]{
|
||||||
|
|
||||||
|
Build a network from a given hash table assigning functions to variables by
|
||||||
|
attributing the domain @tt{{0,1}} to every variable.
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(make-01-network (hash 'a or-func/01 'b and-func/01))
|
||||||
|
]}
|
||||||
|
|
||||||
@section{Syntactic description of networks}
|
@section{Syntactic description of networks}
|
||||||
|
|
||||||
@section{Inferring interaction graphs}
|
@section{Inferring interaction graphs}
|
||||||
|
|
Loading…
Reference in a new issue