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

networks: Remove st and stb.

Browse source
This commit is contained in:
Sergiu Ivanov 2020-03-25 00:31:23 +01:00
parent 086f4c4949
commit dfb882d891
3 changed files with 25 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
example/example.org
View file

@ -52,7 +52,7 @@
#+HEADER: :prologue "#lang racket\n(require (file \"~/Candies/prj/racket/dds/networks.rkt\"))" #+HEADER: :prologue "#lang racket\n(require (file \"~/Candies/prj/racket/dds/networks.rkt\"))"
#+BEGIN_SRC racket :results output drawer #+BEGIN_SRC racket :results output drawer
(st '((a . 1))) (make-state '((a . 1)))
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:
@ -123,7 +123,7 @@
more generally): more generally):
#+BEGIN_SRC racket :results table drawer #+BEGIN_SRC racket :results table drawer
(st '((a . 1) (b . #f) (c . "hello"))) (make-state '((a . 1) (b . #f) (c . "hello")))
#+END_SRC #+END_SRC
#+RESULTS: #+RESULTS:

46
networks-tests.rkt
View file

@ -19,11 +19,9 @@
(test-case "States" (test-case "States"
(check-equal? (make-state-booleanize '((a . 0) (b . 1))) (check-equal? (make-state-booleanize '((a . 0) (b . 1)))
(st '((a . #f) (b . #t)))) (make-state '((a . #f) (b . #t))))
(check-equal? (stb #hash((a . 0) (b . 1))) (check-equal? (booleanize-state (make-state '((a . 0) (b . 1))))
(st '((a . #f) (b . #t)))) (make-state '((a . #f) (b . #t)))))
(check-equal? (booleanize-state (st '((a . 0) (b . 1))))
(st '((a . #f) (b . #t)))))
(test-case "One-step syncronous update" (test-case "One-step syncronous update"
(let* ([s (make-state '((x1 . #t) (x2 . #f)))] (let* ([s (make-state '((x1 . #t) (x2 . #f)))]
@ -46,7 +44,7 @@
(b . (not b))))] (b . (not b))))]
[bn3 (nn #hash((a . (and a b)) [bn3 (nn #hash((a . (and a b))
(b . (not b))))] (b . (not b))))]
[s (st '((a . #t) (b . #t)))]) [s (make-state '((a . #t) (b . #t)))])
(check-equal? ((hash-ref bn1 'a) s) #t) (check-equal? ((hash-ref bn1 'a) s) #t)
(check-equal? ((hash-ref bn2 'a) s) #t) (check-equal? ((hash-ref bn2 'a) s) #t)
(check-equal? ((hash-ref bn3 'a) s) #t))) (check-equal? ((hash-ref bn3 'a) s) #t)))
@ -119,8 +117,8 @@
(check-equal? (edge-weight sig3 'b 'a) '-))) (check-equal? (edge-weight sig3 'b 'a) '-)))
(test-case "Dynamics of networks" (test-case "Dynamics of networks"
(check-equal? (pretty-print-state (st '((a . #f) (b . 3) (c . 4)))) "a:#f b:3 c:4") (check-equal? (pretty-print-state (make-state '((a . #f) (b . 3) (c . 4)))) "a:#f b:3 c:4")
(check-equal? (pretty-print-boolean-state (st '((a . #f) (b . #t) (c . #t)))) "a:0 b:1 c:1") (check-equal? (pretty-print-boolean-state (make-state '((a . #f) (b . #t) (c . #t)))) "a:0 b:1 c:1")
(let ([vars '(a b c)]) (let ([vars '(a b c)])
(check-equal? (make-asyn vars) (set (set 'a) (set 'b) (set 'c))) (check-equal? (make-asyn vars) (set (set 'a) (set 'b) (set 'c)))
(check-equal? (make-syn vars) (set (set 'a 'b 'c)))) (check-equal? (make-syn vars) (set (set 'a 'b 'c))))
@ -134,24 +132,24 @@
(let* ([n (nn #hash((a . (not a)) (b . b)))] (let* ([n (nn #hash((a . (not a)) (b . b)))]
[asyn (make-asyn-dynamics n)] [asyn (make-asyn-dynamics n)]
[syn (make-syn-dynamics n)] [syn (make-syn-dynamics n)]
[s (st '((a . #t) (b . #f)))] [s (make-state '((a . #t) (b . #f)))]
[ss (set (st '((a . #t) (b . #t))) [ss (set (make-state '((a . #t) (b . #t)))
(st '((a . #f) (b . #t))))] (make-state '((a . #f) (b . #t))))]
[gr1 (dds-build-n-step-state-graph asyn (set s) 1)] [gr1 (dds-build-n-step-state-graph asyn (set s) 1)]
[gr-full (dds-build-state-graph asyn (set s))] [gr-full (dds-build-state-graph asyn (set s))]
[gr-full-pp (ppsg gr-full)] [gr-full-pp (ppsg gr-full)]
[gr-full-ppb (ppsgb gr-full)] [gr-full-ppb (ppsgb gr-full)]
[gr-complete-bool (build-full-boolean-state-graph asyn)] [gr-complete-bool (build-full-boolean-state-graph asyn)]
[gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)]) [gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)])
(check-equal? (dds-step-one asyn s) (set (st '((a . #f) (b . #f))) (check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f)))
(st '((a . #t) (b . #f))))) (make-state '((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 (st '((a . #f) (b . #f))))) (check-equal? (dds-step-one syn s) (set (make-state '((a . #f) (b . #f)))))
(check-equal? (dds-step asyn ss) (check-equal? (dds-step asyn ss)
(set (st '((a . #f) (b . #t))) (set (make-state '((a . #f) (b . #t)))
(st '((a . #t) (b . #t))))) (make-state '((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))))
@ -245,15 +243,15 @@
(#t #t #t #t)))] (#t #t #t #t)))]
[f1 (hash-ref n 'x1)] [f1 (hash-ref n 'x1)]
[f2 (hash-ref n 'x2)]) [f2 (hash-ref n 'x2)])
(check-false (f1 (st '((x1 . #f) (x2 . #f))))) (check-false (f1 (make-state '((x1 . #f) (x2 . #f)))))
(check-false (f1 (st '((x1 . #f) (x2 . #t))))) (check-false (f1 (make-state '((x1 . #f) (x2 . #t)))))
(check-true (f1 (st '((x1 . #t) (x2 . #f))))) (check-true (f1 (make-state '((x1 . #t) (x2 . #f)))))
(check-true (f1 (st '((x1 . #t) (x2 . #t))))) (check-true (f1 (make-state '((x1 . #t) (x2 . #t)))))
(check-false (f2 (st '((x1 . #f) (x2 . #f))))) (check-false (f2 (make-state '((x1 . #f) (x2 . #f)))))
(check-true (f2 (st '((x1 . #f) (x2 . #t))))) (check-true (f2 (make-state '((x1 . #f) (x2 . #t)))))
(check-false (f2 (st '((x1 . #t) (x2 . #f))))) (check-false (f2 (make-state '((x1 . #t) (x2 . #f)))))
(check-true (f2 (st '((x1 . #t) (x2 . #t)))))) (check-true (f2 (make-state '((x1 . #t) (x2 . #t))))))
(let ([f1 (stream-first (enumerate-boolean-functions 1))] (let ([f1 (stream-first (enumerate-boolean-functions 1))]
[f1/list (stream-first (enumerate-boolean-functions/list 1))]) [f1/list (stream-first (enumerate-boolean-functions/list 1))])
(check-false (f1 #f)) (check-false (f1 #t)) (check-false (f1 #f)) (check-false (f1 #t))

8
networks.rkt
View file

@ -97,7 +97,7 @@
[update-function/c contract?] [update-function/c contract?]
[domain-mapping/c contract?]) [domain-mapping/c contract?])
;; Syntax ;; Syntax
st stb nn ppsg ppsgb unorg-syn unorg-asyn) nn ppsg ppsgb unorg-syn unorg-asyn)
;;; ================= ;;; =================
@ -130,9 +130,6 @@
;;; states (see contract). ;;; states (see contract).
(define (make-state mappings) (make-immutable-hash mappings)) (define (make-state mappings) (make-immutable-hash mappings))
;;; A shortcut for make-state.
(define-syntax-rule (st mappings) (make-state mappings))
;;; Makes a new Boolean states from a state with numerical values 0 ;;; Makes a new Boolean states from a state with numerical values 0
;;; and 1. ;;; and 1.
(define (make-state-booleanize mappings) (define (make-state-booleanize mappings)
@ -145,9 +142,6 @@
(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)])))
;;; A shortcut for make-state-booleanize.
(define-syntax-rule (stb s) (booleanize-state s))
;;; A version of make-immutable-hash restricted to creating networks. ;;; A version of make-immutable-hash restricted to creating networks.
(define (make-network-from-functions funcs) (make-immutable-hash funcs)) (define (make-network-from-functions funcs) (make-immutable-hash funcs))