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

rs/test: Use test-case and define instead of let.

This commit is contained in:
Sergiu Ivanov 2020-05-27 23:48:22 +02:00
parent b98d00320c
commit b6f6e4e7c4
1 changed files with 83 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
rs.rkt
View File

@ -87,18 +87,18 @@
(module+ test
(test-case "Basic definitions"
(let* ([r1 (reaction (set 'x) (set 'y) (set 'z))]
[r2 (reaction (set 'x) (set) (set 'y))]
[rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))]
[s1 (set 'x 'z)]
[s2 (set 'x 'y)])
(define r1 (reaction (set 'x) (set 'y) (set 'z)))
(define r2 (reaction (set 'x) (set) (set 'y)))
(define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2))))
(define s1 (set 'x 'z))
(define s2 (set 'x 'y))
(check-true (enabled? r1 s1))
(check-false (enabled? r1 s2))
(check-equal? (list-enabled rs s1) '(a b))
(check-equal? (list-enabled rs s2) '(b))
(check-equal? (union-products rs '(a b)) (set 'y 'z))
(check-equal? (apply-rs rs s1) (set 'y 'z))
(check-equal? (apply-rs rs s2) (set 'y)))))
(check-equal? (apply-rs rs s2) (set 'y))))
;;; ====================
@ -122,28 +122,31 @@
(values a (str-triple->reaction triple))))
(module+ test
(test-case "ht-str-triples->rs"
(check-equal?
(ht-str-triples->rs #hash((a . ("x t" "y" "z"))))
(make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z)))))))
(make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))))
;;; Reads a reaction system from an Org-mode style string.
(define read-org-rs (compose ht-str-triples->rs read-org-variable-mapping))
(module+ test
(test-case "read-org-rs"
(check-equal? (read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))")
(hash
'a
(reaction (set 'x 't) (set 'y) (set 'z))
'b
(reaction (set 'x) (set 'q) (set 'z)))))
(reaction (set 'x) (set 'q) (set 'z))))))
;;; Reads a context sequence from an Org sexp corresponding to a list.
(define (read-context-sequence str)
(map (compose list->set read-symbol-list) (flatten (string->any str))))
(module+ test
(test-case "read-context-sequence"
(check-equal? (read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))")
(list (set 'x 'y) (set 'z) (set) (set 't))))
(list (set 'x 'y) (set 'z) (set) (set 't)))))
;;; Converts a reaction to a triple of strings.
(define/match (reaction->str-triple r)
@ -158,9 +161,10 @@
(values a (reaction->str-triple r))))
(module+ test
(test-case "rs->ht-str-triples"
(check-equal?
(rs->ht-str-triples (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))
#hash((a . ("t x" "y" "z")))))
#hash((a . ("t x" "y" "z"))))))
;;; ============================
@ -242,13 +246,14 @@
(module+ test
(test-case "Dynamics of reaction systems"
(let* ([r1 (reaction (set 'x) (set 'y) (set 'z))]
[r2 (reaction (set 'x) (set) (set 'y))]
[rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))]
[dyn (dynamics rs)]
[state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))]
[sgr (dds-build-state-graph-annotated dyn (set state1))]
[ip (build-interactive-process-graph rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))])
(define r1 (reaction (set 'x) (set 'y) (set 'z)))
(define r2 (reaction (set 'x) (set) (set 'y)))
(define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2))))
(define dyn (dynamics rs))
(define state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))
(define sgr (dds-build-state-graph-annotated dyn (set state1)))
(define ip (build-interactive-process-graph rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))
(check-equal? (dds-step-one-annotated dyn state1)
(set (cons
(set 'a 'b)
@ -297,4 +302,4 @@
(list (set 'z) (set))
(list (set) (set))
(list (set 'z) (set))
(list (set) (set)))))))
(list (set) (set))))))