61 lines
2.3 KiB
Racket
61 lines
2.3 KiB
Racket
#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))))
|