dds/rs-tests.rkt

#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))))))