dds/rs-tests.rkt

86 lines
4 KiB
Racket
Raw Normal View History

#lang racket
2020-03-01 19:05:28 +01:00
;;; Tests for dds/rs.
2020-03-02 18:32:11 +01:00
(require rackunit graph "rs.rkt" "utils.rkt")
2020-03-01 19:05:28 +01:00
(test-case "Basic definitions"
2020-03-01 19:20:24 +01:00
(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)])
(check-true (enabled? r1 s1))
(check-false (enabled? r1 s2))
(check-equal? (list-enabled rs s1) '(a b))
2020-03-01 19:47:38 +01:00
(check-equal? (list-enabled rs s2) '(b))
2020-03-01 19:51:53 +01:00
(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))))
2020-03-01 20:46:06 +01:00
(test-case "Org-mode interaction"
(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))))))
2020-03-02 23:03:10 +01:00
(check-equal? (read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))")
(list (set 'x 'y) (set 'z) (set) (set 't)))
(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")))))
2020-03-02 18:32:11 +01:00
(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)))]
2020-03-02 23:50:32 +01:00
[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)))])
2020-03-02 18:32:11 +01:00
(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-true (has-vertex? sgr (state (set) (list (set 'z) (set) (set 'z)))))
(check-true (has-vertex? sgr (state (set) (list (set) (set 'z)))))
(check-true (has-vertex? sgr (state (set) (list (set 'z)))))
(check-true (has-vertex? sgr (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))))
(check-true (has-vertex? sgr (state (set) '())))
(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))))
2020-03-02 23:50:32 +01:00
(set (set 'a 'b)))
2020-03-03 00:51:53 +01:00
(check-equal? sgr ip)
(check-equal? (build-interactive-process rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))
(list
(list (set 'x) (set))
(list (set 'y) (set 'y 'z))
(list (set 'z) (set))
(list (set) (set))
(list (set 'z) (set))
(list (set) (set))))))