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

161
rs.rkt
View File

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