Type make-01-domains and make-01-network.

This commit is contained in:
Sergiu Ivanov 2022-04-30 23:17:15 +02:00
parent 4ea31d8f39
commit 9a2f1ff527
2 changed files with 65 additions and 19 deletions

View file

@ -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)))

View file

@ -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}