scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Remove make-state and make-state-booleanize.

Browse source 
make-state is just a longer word for hash, and I never really use
make-state-booleanize.
This commit is contained in:
Sergiu Ivanov 2022-05-01 00:35:17 +02:00
parent ba30e3dc5e
commit aea472acb2
1 changed files with 31 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
networks.rkt
View file

@ -122,9 +122,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-state (-> (listof (cons/c symbol? any/c)) state?)] (contract-out [booleanize-state (-> state? state?)]
[make-state-booleanize (-> (listof (cons/c symbol? (or/c 0 1))) state?)]
[booleanize-state (-> state? state?)]
[update-function-form->update-function (-> update-function-form? update-function/c)] [update-function-form->update-function (-> update-function-form? update-function/c)]
[network-form->network (-> network-form? network?)] [network-form->network (-> network-form? network?)]
[make-boolean-network-form (-> variable-mapping? network-form?)] [make-boolean-network-form (-> variable-mapping? network-form?)]
@ -268,19 +266,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?))
;;; A version of make-immutable-hash restricted to creating network
;;; states (see contract).
(define (make-state mappings) (make-immutable-hash mappings))
;;; Makes a new Boolean states from a state with numerical values 0
;;; and 1.
(define (make-state-booleanize mappings)
(make-state (for/list ([mp mappings])
(match mp
[(cons var 0) (cons var #f)]
[(cons var 1) (cons var #t)]))))
;;; Booleanizes a given state: replaces 0 with #f and 1 with #t. ;;; Booleanizes a given state: replaces 0 with #f and 1 with #t.
(define (booleanize-state s) (define (booleanize-state s)
(for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)]))) (for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)])))
@ -317,7 +302,7 @@
(module+ test (module+ test
(test-case "update-function-form->update-function" (test-case "update-function-form->update-function"
(define s (make-state '((x . #t) (y . #f)))) (define s (hash 'x #t 'y #f))
(define f (update-function-form->update-function '(and x y))) (define f (update-function-form->update-function '(and x y)))
(check-equal? (f s) #f))) (check-equal? (f s) #f)))
@ -335,7 +320,7 @@
'b '(not b)) 'b '(not b))
(hash 'a '(#f #t) (hash 'a '(#f #t)
'b '(#f #t))))) 'b '(#f #t)))))
(define s (make-state '((a . #t) (b . #t)))) (define s (hash 'a #t 'b #t))
(check-equal? ((hash-ref (network-functions bn) 'a) s) #t))) (check-equal? ((hash-ref (network-functions bn) 'a) s) #t)))
;;; Build a Boolean network form from a given mapping assigning forms ;;; Build a Boolean network form from a given mapping assigning forms
@ -437,8 +422,8 @@
[vars (map car var-dom-list)] [vars (map car var-dom-list)]
[domains (map cdr var-dom-list)]) [domains (map cdr var-dom-list)])
(for/list ([s (apply cartesian-product domains)]) (for/list ([s (apply cartesian-product domains)])
(make-state (for/list ([var vars] [val s]) (make-immutable-hash (for/list ([var vars] [val s])
(cons var val)))))) (cons var val))))))
(module+ test (module+ test
(test-case "build-all-states" (test-case "build-all-states"
@ -725,7 +710,7 @@
(module+ test (module+ test
(test-case "pretty-print-state" (test-case "pretty-print-state"
(check-equal? (pretty-print-state (make-state '((a . #f) (b . 3) (c . 4)))) (check-equal? (pretty-print-state (hash 'a #f 'b 3 'c 4))
"a:#f b:3 c:4"))) "a:#f b:3 c:4")))
;;; Pretty-prints a state of the network to Boolean values 0 or 1. ;;; Pretty-prints a state of the network to Boolean values 0 or 1.
@ -735,7 +720,7 @@
(module+ test (module+ test
(test-case "pretty-print-boolean-state" (test-case "pretty-print-boolean-state"
(check-equal? (check-equal?
(pretty-print-boolean-state (make-state '((a . #f) (b . #t) (c . #t)))) (pretty-print-boolean-state (hash 'a #f 'b #t 'c #t))
"a:0 b:1 c:1"))) "a:0 b:1 c:1")))
;;; Given a state graph and a pretty-printer for states build a new ;;; Given a state graph and a pretty-printer for states build a new
@ -780,24 +765,24 @@
(define n (forms->boolean-network #hash((a . (not a)) (b . b)))) (define n (forms->boolean-network #hash((a . (not a)) (b . b))))
(define asyn (make-asyn-dynamics n)) (define asyn (make-asyn-dynamics n))
(define syn (make-syn-dynamics n)) (define syn (make-syn-dynamics n))
(define s (make-state '((a . #t) (b . #f)))) (define s (hash 'a #t 'b #f))
(define ss (set (make-state '((a . #t) (b . #t))) (define ss (set (hash 'a #t 'b #t)
(make-state '((a . #f) (b . #t))))) (hash 'a #f 'b #t)))
(define gr1 (dds-build-n-step-state-graph asyn (set s) 1)) (define gr1 (dds-build-n-step-state-graph asyn (set s) 1))
(define gr-full (dds-build-state-graph asyn (set s))) (define gr-full (dds-build-state-graph asyn (set s)))
(define gr-full-pp (pretty-print-state-graph gr-full)) (define gr-full-pp (pretty-print-state-graph gr-full))
(define gr-full-ppb (pretty-print-boolean-state-graph gr-full)) (define gr-full-ppb (pretty-print-boolean-state-graph gr-full))
(define gr-complete-bool (build-full-state-graph asyn)) (define gr-complete-bool (build-full-state-graph asyn))
(define gr-complete-bool-ann (build-full-state-graph-annotated asyn)) (define gr-complete-bool-ann (build-full-state-graph-annotated asyn))
(check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f))) (check-equal? (dds-step-one asyn s) (set (hash 'a #f 'b #f)
(make-state '((a . #t) (b . #f))))) (hash 'a #t 'b #f)))
(check-equal? (dds-step-one-annotated asyn s) (check-equal? (dds-step-one-annotated asyn s)
(set (cons (set 'b) '#hash((a . #t) (b . #f))) (set (cons (set 'b) '#hash((a . #t) (b . #f)))
(cons (set 'a) '#hash((a . #f) (b . #f))))) (cons (set 'a) '#hash((a . #f) (b . #f)))))
(check-equal? (dds-step-one syn s) (set (make-state '((a . #f) (b . #f))))) (check-equal? (dds-step-one syn s) (set (hash 'a #f 'b #f)))
(check-equal? (dds-step asyn ss) (check-equal? (dds-step asyn ss)
(set (make-state '((a . #f) (b . #t))) (set (hash 'a #f 'b #t)
(make-state '((a . #t) (b . #t))))) (hash 'a #t 'b #t)))
(check-true (has-vertex? gr1 #hash((a . #t) (b . #f)))) (check-true (has-vertex? gr1 #hash((a . #t) (b . #f))))
(check-true (has-vertex? gr1 #hash((a . #f) (b . #f)))) (check-true (has-vertex? gr1 #hash((a . #f) (b . #f))))
(check-false (has-vertex? gr1 #hash((a . #t) (b . #t)))) (check-false (has-vertex? gr1 #hash((a . #t) (b . #t))))
@ -999,7 +984,7 @@
;; columns. ;; columns.
(define func-lines (lists-transpose outs)) (define func-lines (lists-transpose outs))
;; Make states out of inputs. ;; Make states out of inputs.
(define st-ins (for/list ([in ins]) (make-state (map cons var-names in)))) (define st-ins (for/list ([in ins]) (make-immutable-hash (map cons var-names in))))
;; Construct the functions. ;; Construct the functions.
(define funcs (for/list ([out func-lines]) (define funcs (for/list ([out func-lines])
(table->function (for/list ([in st-ins] [o out]) (table->function (for/list ([in st-ins] [o out])
@ -1024,15 +1009,15 @@
(define f1 (hash-ref (network-functions n) 'x1)) (define f1 (hash-ref (network-functions n) 'x1))
(define f2 (hash-ref (network-functions n) 'x2)) (define f2 (hash-ref (network-functions n) 'x2))
(check-false (f1 (make-state '((x1 . #f) (x2 . #f))))) (check-false (f1 (hash 'x1 #f 'x2 #f)))
(check-false (f1 (make-state '((x1 . #f) (x2 . #t))))) (check-false (f1 (hash 'x1 #f 'x2 #t)))
(check-true (f1 (make-state '((x1 . #t) (x2 . #f))))) (check-true (f1 (hash 'x1 #t 'x2 #f)))
(check-true (f1 (make-state '((x1 . #t) (x2 . #t))))) (check-true (f1 (hash 'x1 #t 'x2 #t)))
(check-false (f2 (make-state '((x1 . #f) (x2 . #f))))) (check-false (f2 (hash 'x1 #f 'x2 #f)))
(check-true (f2 (make-state '((x1 . #f) (x2 . #t))))) (check-true (f2 (hash 'x1 #f 'x2 #t)))
(check-false (f2 (make-state '((x1 . #t) (x2 . #f))))) (check-false (f2 (hash 'x1 #t 'x2 #f)))
(check-true (f2 (make-state '((x1 . #t) (x2 . #t))))) (check-true (f2 (hash 'x1 #t 'x2 #t)))
(check-equal? (network-domains n) (check-equal? (network-domains n)
#hash((x1 . (#f #t)) (x2 . (#f #t)))))) #hash((x1 . (#f #t)) (x2 . (#f #t))))))
@ -1105,7 +1090,7 @@
(module+ test (module+ test
(test-case "apply-tbf-to-state" (test-case "apply-tbf-to-state"
(define st (make-state '((x1 . 0) (x2 . 1)))) (define st (hash 'x1 0 'x2 1))
(define f (tbf #(1 1) 1)) (define f (tbf #(1 1) 1))
(check-equal? (apply-tbf-to-state f st) 0))) (check-equal? (apply-tbf-to-state f st) 0)))
@ -1163,8 +1148,8 @@
(module+ test (module+ test
(test-case "apply-tbf/state" (test-case "apply-tbf/state"
(define st1 (make-state '((a . 1) (b . 0) (c . 1)))) (define st1 (hash 'a 1 'b 0 'c 1))
(define st2 (make-state '((a . 1) (b . 1) (c . 0)))) (define st2 (hash 'a 1 'b 1 'c 0))
(define tbf (make-tbf/state '((a . 2) (b . -2)) 1)) (define tbf (make-tbf/state '((a . 2) (b . -2)) 1))
(check-equal? (apply-tbf/state tbf st1) 1) (check-equal? (apply-tbf/state tbf st1) 1)
(check-equal? (apply-tbf/state tbf st2) 0))) (check-equal? (apply-tbf/state tbf st2) 0)))
@ -1446,17 +1431,17 @@
(define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1)))) (define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1))))
(b . ,(make-tbf/state '((a . -1)) -1))))) (b . ,(make-tbf/state '((a . -1)) -1)))))
(define n (tbn->network tbn)) (define n (tbn->network tbn))
(define s1 (make-state '((a . 0) (b . 0)))) (define s1 (hash 'a 0 'b 0))
(check-equal? (update n s1 '(a b)) (check-equal? (update n s1 '(a b))
(make-state '((a . 0) (b . 1)))) (hash 'a 0 'b 1))
(check-equal? (network-domains n) #hash((a . (0 1)) (b . (0 1)))) (check-equal? (network-domains n) #hash((a . (0 1)) (b . (0 1))))
(define sbn (make-sbn `((a . ,(make-sbf/state '((b . -1)))) (define sbn (make-sbn `((a . ,(make-sbf/state '((b . -1))))
(b . ,(make-sbf/state '((a . 1))))))) (b . ,(make-sbf/state '((a . 1)))))))
(define sn (tbn->network sbn)) (define sn (tbn->network sbn))
(define s2 (make-state '((a . 1) (b . 1)))) (define s2 (hash 'a 1 'b 1))
(check-equal? (update sn s2 '(a b)) (check-equal? (update sn s2 '(a b))
(make-state '((a . 0) (b . 1)))) (hash 'a 0 'b 1))
(check-equal? (network-domains sn) #hash((a . (0 1)) (b . (0 1)))))) (check-equal? (network-domains sn) #hash((a . (0 1)) (b . (0 1))))))
;;; A helper function for read-org-tbn and read-org-sbn. It reads a ;;; A helper function for read-org-tbn and read-org-sbn. It reads a