From 9a2f1ff527c41876f44a3a94e3798b008daada38 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 30 Apr 2022 23:17:15 +0200 Subject: [PATCH] Type make-01-domains and make-01-network. --- networks.rkt | 47 +++++++++++++++++++++++--------------- scribblings/networks.scrbl | 37 ++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 19 deletions(-) diff --git a/networks.rkt b/networks.rkt index 441e2d5..c93509e 100644 --- a/networks.rkt +++ b/networks.rkt @@ -11,7 +11,8 @@ State UpdateFunction Domain DomainMapping (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 (UpdateFunction a) (-> (State a) a)) @@ -56,6 +57,31 @@ (not (hash-ref s 'x2)))) (define bn (make-boolean-network (hash 'x1 f1 'x2 f2))) (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) @@ -76,8 +102,7 @@ [struct network-form ([forms variable-mapping?] [domains domain-mapping/c])]) ;; Functions - (contract-out [make-01-network (-> (hash/c variable? procedure?) network?)] - [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] + (contract-out [update (-> network? state? (set/c variable? #:kind 'dont-care) state?)] [make-state (-> (listof (cons/c symbol? any/c)) state?)] [make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)] [booleanize-state (-> state? state?)] @@ -94,7 +119,6 @@ [build-signed-interaction-graph (-> network? graph?)] [build-signed-interaction-graph/form (-> network-form? graph?)] [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-01-states (-> (listof variable?) (listof state?))] [make-asyn (-> (listof variable?) mode?)] @@ -225,11 +249,6 @@ ;;; values in their domains. (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. (define (update network s xs) (define funcs (network-functions network)) @@ -437,16 +456,6 @@ #hash((a . #f) (b . 2)) #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. (define (build-all-boolean-states vars) (build-all-states (make-boolean-domains vars))) diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl index 592fc93..60a4e47 100644 --- a/scribblings/networks.scrbl +++ b/scribblings/networks.scrbl @@ -80,6 +80,23 @@ the variables @racket[a] and @racket[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} @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)) ]} +@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{Inferring interaction graphs}