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

networks: Remove st and stb.

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\"))"
#+BEGIN_SRC racket :results output drawer
(st '((a . 1)))
(make-state '((a . 1)))
#+END_SRC
#+RESULTS:
@ -123,7 +123,7 @@
more generally):
#+BEGIN_SRC racket :results table drawer
(st '((a . 1) (b . #f) (c . "hello")))
(make-state '((a . 1) (b . #f) (c . "hello")))
#+END_SRC
#+RESULTS:

46
networks-tests.rkt
View File

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

8
networks.rkt
View File

@ -97,7 +97,7 @@
[update-function/c contract?]
[domain-mapping/c contract?])
;; Syntax
st stb nn ppsg ppsgb unorg-syn unorg-asyn)
nn ppsg ppsgb unorg-syn unorg-asyn)
;;; =================
@ -130,9 +130,6 @@
;;; states (see contract).
(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
;;; and 1.
(define (make-state-booleanize mappings)
@ -145,9 +142,6 @@
(define (booleanize-state s)
(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.
(define (make-network-from-functions funcs) (make-immutable-hash funcs))