dds/networks-tests.rkt

#lang racket

;;; Tests for dds/networks.

(require rackunit graph "networks.rkt")

;;; This test case sets up the following Boolean network:
;;; x1 = x1 AND NOT x2
;;; x2 = NOT x2
(test-case "Basic definitions"
  (let* ([f1 (λ (s)
               (let ([x1 (hash-ref s 'x1)]
                     [x2 (hash-ref s 'x2)])
                 (and x1 (not x2))))]
         [f2 (λ (s)
               (let ([x2 (hash-ref s 'x2)])
                 (not x2)))]
         [bn (make-network-from-functions `((x1 . ,f1) (x2 . ,f2)))])

    (test-case "One-step syncronous update"
      (let* ([s (make-state '((x1 . #t) (x2 . #f)))]
             [new-s (update bn s '(x2 x1))])
        (check-equal? (hash-ref new-s 'x1) #t)
        (check-equal? (hash-ref new-s 'x2) #t)
        (check-equal? (length (hash-keys new-s)) 2)))

    (test-case "One-step asynchronous update"
      (let* ([s (make-state '((x1 . #f) (x2 . #f)))]
             [new-s (update bn s '(x2 x1))])
        (check-equal? (hash-ref new-s 'x1) #f)
        (check-equal? (hash-ref new-s 'x2) #t)
        (check-equal? (length (hash-keys new-s)) 2)))))

(test-case "Syntactic description of Boolean networks"
  (let ([s (make-state '((x . #t) (y . #f)))]
        [f (update-function-form->update-function '(and x y))])
    (check-equal? (f s) #f))
  (let ([bn1 (network-form->network (make-hash '((a . (and a b)) (b . (not b)))))]
        [bn2 (make-network-from-forms '((a . (and a b))
                                        (b . (not b))))]
        [bn3 (nn '((a . (and a b))
                   (b . (not b))))]
        [s (st '((a . #t) (b . #t)))])
    (check-equal? ((hash-ref bn1 'a) s) #t)
    (check-equal? ((hash-ref bn2 'a) s) #t)
    (check-equal? ((hash-ref bn3 'a) s) #t)))

(test-case "Inferring interaction graphs"
  (let* ([n #hash((a . (+ a b c))
                  (b . (- b c)))]
         [ig (build-interaction-graph n)])
    (check-true (set=? (list-interactions n 'a) '(a b)))
    (check-true (set=? (list-interactions n 'b) '(b)))
    (check-true (has-vertex? ig 'a))
    (check-true (has-vertex? ig 'b))
    (check-false (has-vertex? ig 'c))
    (check-true (has-edge? ig 'a 'a))
    (check-true (has-edge? ig 'b 'a))
    (check-true (has-edge? ig 'b 'b))
    (check-false (has-edge? ig 'c 'b))
    (check-false (has-edge? ig 'c 'a)))

  (check-equal? (map hash->list (build-all-states '((a . (#t #f)) (b . (1 2 3)))))
                '(((a . #t) (b . 1))
                  ((a . #t) (b . 2))
                  ((a . #t) (b . 3))
                  ((a . #f) (b . 1))
                  ((a . #f) (b . 2))
                  ((a . #f) (b . 3))))
  (check-equal? (map hash->list (build-all-states-same-domain '(a b) '(#t #f)))
                '(((a . #t) (b . #t))
                  ((a . #t) (b . #f))
                  ((a . #f) (b . #t))
                  ((a . #f) (b . #f))))
  (check-equal? (hash->list (make-boolean-domains '(a b)))
                '((a . (#f #t)) (b . (#f #t))))

  (let* ([n #hash((a . (not b)) (b . a))]
         [doms (make-boolean-domains '(a b))]
         [sig (build-signed-interaction-graph n doms)])
    (check-equal? (get-interaction-sign n doms 'a 'b) '+)
    (check-equal? (get-interaction-sign n doms 'b 'a) '-)

    (check-true (has-vertex? sig 'a))
    (check-true (has-vertex? sig 'b))
    (check-false (has-vertex? sig 'c))
    (check-false (has-edge? sig 'a 'a))
    (check-true (has-edge? sig 'b 'a))
    (check-false (has-edge? sig 'b 'b))
    (check-false (has-edge? sig 'c 'b))
    (check-false (has-edge? sig 'c 'a))
    (check-equal? (edge-weight sig 'a 'b) 1)
    (check-equal? (edge-weight sig 'b 'a) -1)))