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

75
networks.rkt
View file

@ -122,9 +122,7 @@
[struct network-form ([forms variable-mapping?]
[domains domain-mapping/c])])
;; Functions
(contract-out [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?)]
(contract-out [booleanize-state (-> state? state?)]
[update-function-form->update-function (-> update-function-form? update-function/c)]
[network-form->network (-> network-form? network?)]
[make-boolean-network-form (-> variable-mapping? network-form?)]
@ -268,19 +266,6 @@
;;; values in their domains.
(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.
(define (booleanize-state s)
(for/hash ([(x val) s]) (match val [0 (values x #f)] [1 (values x #t)])))
@ -317,7 +302,7 @@
(module+ test
(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)))
(check-equal? (f s) #f)))
@ -335,7 +320,7 @@
'b '(not b))
(hash 'a '(#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)))
;;; Build a Boolean network form from a given mapping assigning forms
@ -437,7 +422,7 @@
[vars (map car var-dom-list)]
[domains (map cdr var-dom-list)])
(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))))))
(module+ test
@ -725,7 +710,7 @@
(module+ test
(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")))
;;; Pretty-prints a state of the network to Boolean values 0 or 1.
@ -735,7 +720,7 @@
(module+ test
(test-case "pretty-print-boolean-state"
(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")))
;;; 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 asyn (make-asyn-dynamics n))
(define syn (make-syn-dynamics n))
(define s (make-state '((a . #t) (b . #f))))
(define ss (set (make-state '((a . #t) (b . #t)))
(make-state '((a . #f) (b . #t)))))
(define s (hash 'a #t 'b #f))
(define ss (set (hash 'a #t 'b #t)
(hash 'a #f 'b #t)))
(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-pp (pretty-print-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-ann (build-full-state-graph-annotated asyn))
(check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f)))
(make-state '((a . #t) (b . #f)))))
(check-equal? (dds-step-one asyn s) (set (hash 'a #f 'b #f)
(hash 'a #t 'b #f)))
(check-equal? (dds-step-one-annotated asyn s)
(set (cons (set 'b) '#hash((a . #t) (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)
(set (make-state '((a . #f) (b . #t)))
(make-state '((a . #t) (b . #t)))))
(set (hash 'a #f 'b #t)
(hash 'a #t 'b #t)))
(check-true (has-vertex? gr1 #hash((a . #t) (b . #f))))
(check-true (has-vertex? gr1 #hash((a . #f) (b . #f))))
(check-false (has-vertex? gr1 #hash((a . #t) (b . #t))))
@ -999,7 +984,7 @@
;; columns.
(define func-lines (lists-transpose outs))
;; 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.
(define funcs (for/list ([out func-lines])
(table->function (for/list ([in st-ins] [o out])
@ -1024,15 +1009,15 @@
(define f1 (hash-ref (network-functions n) 'x1))
(define f2 (hash-ref (network-functions n) 'x2))
(check-false (f1 (make-state '((x1 . #f) (x2 . #f)))))
(check-false (f1 (make-state '((x1 . #f) (x2 . #t)))))
(check-true (f1 (make-state '((x1 . #t) (x2 . #f)))))
(check-true (f1 (make-state '((x1 . #t) (x2 . #t)))))
(check-false (f1 (hash 'x1 #f 'x2 #f)))
(check-false (f1 (hash 'x1 #f 'x2 #t)))
(check-true (f1 (hash 'x1 #t 'x2 #f)))
(check-true (f1 (hash 'x1 #t 'x2 #t)))
(check-false (f2 (make-state '((x1 . #f) (x2 . #f)))))
(check-true (f2 (make-state '((x1 . #f) (x2 . #t)))))
(check-false (f2 (make-state '((x1 . #t) (x2 . #f)))))
(check-true (f2 (make-state '((x1 . #t) (x2 . #t)))))
(check-false (f2 (hash 'x1 #f 'x2 #f)))
(check-true (f2 (hash 'x1 #f 'x2 #t)))
(check-false (f2 (hash 'x1 #t 'x2 #f)))
(check-true (f2 (hash 'x1 #t 'x2 #t)))
(check-equal? (network-domains n)
#hash((x1 . (#f #t)) (x2 . (#f #t))))))
@ -1105,7 +1090,7 @@
(module+ test
(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))
(check-equal? (apply-tbf-to-state f st) 0)))
@ -1163,8 +1148,8 @@
(module+ test
(test-case "apply-tbf/state"
(define st1 (make-state '((a . 1) (b . 0) (c . 1))))
(define st2 (make-state '((a . 1) (b . 1) (c . 0))))
(define st1 (hash 'a 1 'b 0 'c 1))
(define st2 (hash 'a 1 'b 1 'c 0))
(define tbf (make-tbf/state '((a . 2) (b . -2)) 1))
(check-equal? (apply-tbf/state tbf st1) 1)
(check-equal? (apply-tbf/state tbf st2) 0)))
@ -1446,17 +1431,17 @@
(define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1))))
(b . ,(make-tbf/state '((a . -1)) -1)))))
(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))
(make-state '((a . 0) (b . 1))))
(hash 'a 0 'b 1))
(check-equal? (network-domains n) #hash((a . (0 1)) (b . (0 1))))
(define sbn (make-sbn `((a . ,(make-sbf/state '((b . -1))))
(b . ,(make-sbf/state '((a . 1)))))))
(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))
(make-state '((a . 0) (b . 1))))
(hash 'a 0 'b 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