dds/rs-tests.rkt

85 lines
4 KiB
Racket

#lang racket
;;; Tests for dds/rs.
(require rackunit graph "rs.rkt" "utils.rkt")
(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)])
(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))))
(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))))))
(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")))))
(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)))])
(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))))
(set (set 'a 'b)))
(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))))))