dds/networks-tests.rkt

211 lines
9.9 KiB
Racket
Raw Normal View History

#lang racket
2020-02-15 13:57:49 +01:00
;;; Tests for dds/networks.
2020-02-15 13:57:49 +01:00
2020-02-20 15:56:48 +01:00
(require rackunit graph "networks.rkt")
2020-02-15 13:57:49 +01:00
2020-02-15 20:30:46 +01:00
;;; 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)))])
2020-02-15 20:30:46 +01:00
(test-case "States"
(check-equal? (make-state-booleanize '((a . 0) (b . 1)))
(st '((a . #f) (b . #t))))
2020-02-26 21:05:06 +01:00
(check-equal? (stb #hash((a . 0) (b . 1)))
(st '((a . #f) (b . #t))))
(check-equal? (booleanize-state (st '((a . 0) (b . 1))))
(st '((a . #f) (b . #t)))))
(test-case "One-step syncronous update"
(let* ([s (make-state '((x1 . #t) (x2 . #f)))]
[new-s (update bn s '(x2 x1))])
(check-equal? s #hash((x1 . #t) (x2 . #f)))
(check-equal? new-s #hash((x1 . #t) (x2 . #t)))))
2020-02-15 20:30:46 +01:00
(test-case "One-step asynchronous update"
(let* ([s (make-state '((x1 . #f) (x2 . #f)))]
[new-s (update bn s '(x2 x1))])
(check-equal? s #hash((x1 . #f) (x2 . #f)))
(check-equal? new-s #hash((x1 . #f) (x2 . #t)))))))
2020-02-18 11:41:16 +01:00
(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 #hash((a . (and a b))
(b . (not b))))]
2020-02-18 12:39:11 +01:00
[s (st '((a . #t) (b . #t)))])
(check-equal? ((hash-ref bn1 'a) s) #t)
2020-02-18 12:36:26 +01:00
(check-equal? ((hash-ref bn2 'a) s) #t)
(check-equal? ((hash-ref bn3 'a) s) #t)))
2020-02-20 15:17:32 +01:00
(test-case "Inferring interaction graphs"
2020-02-20 15:56:48 +01:00
(let* ([n #hash((a . (+ a b c))
(b . (- b c)))]
[ig (build-interaction-graph n)])
2020-02-20 15:17:32 +01:00
(check-true (set=? (list-interactions n 'a) '(a b)))
2020-02-20 15:56:48 +01:00
(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))
2020-02-22 22:27:40 +01:00
(check-false (has-edge? ig 'c 'a)))
(check-equal? (build-all-states #hash((a . (#t #f)) (b . (1 2 3))))
'(#hash((a . #t) (b . 1))
#hash((a . #t) (b . 2))
#hash((a . #t) (b . 3))
#hash((a . #f) (b . 1))
#hash((a . #f) (b . 2))
#hash((a . #f) (b . 3))))
(check-equal? (make-boolean-domains '(a b))
#hash((a . (#f #t)) (b . (#f #t))))
(check-equal? (build-all-boolean-states '(a b))
'(#hash((a . #f) (b . #f))
#hash((a . #f) (b . #t))
#hash((a . #t) (b . #f))
#hash((a . #t) (b . #t))))
2020-02-23 00:04:19 +01:00
(let* ([n #hash((a . (not b)) (b . a))]
[doms (make-boolean-domains '(a b))]
[sig1 (build-signed-interaction-graph n doms)]
[sig2 (build-boolean-signed-interaction-graph n)])
2020-02-23 00:04:19 +01:00
(check-equal? (get-interaction-sign n doms 'a 'b) '+)
(check-equal? (get-interaction-sign n doms 'b 'a) '-)
(check-true (has-vertex? sig1 'a))
(check-true (has-vertex? sig1 'b))
(check-false (has-vertex? sig1 'c))
(check-false (has-edge? sig1 'a 'a))
(check-true (has-edge? sig1 'b 'a))
(check-false (has-edge? sig1 'b 'b))
(check-false (has-edge? sig1 'c 'b))
(check-false (has-edge? sig1 'c 'a))
(check-equal? (edge-weight sig1 'a 'b) 1)
(check-equal? (edge-weight sig1 'b 'a) -1)
(check-true (has-vertex? sig2 'a))
(check-true (has-vertex? sig2 'b))
(check-false (has-vertex? sig2 'c))
(check-false (has-edge? sig2 'a 'a))
(check-true (has-edge? sig2 'b 'a))
(check-false (has-edge? sig2 'b 'b))
(check-false (has-edge? sig2 'c 'b))
(check-false (has-edge? sig2 'c 'a))
(check-equal? (edge-weight sig2 'a 'b) 1)
(check-equal? (edge-weight sig2 'b 'a) -1)))
2020-02-23 11:25:19 +01:00
(test-case "Dynamics of networks"
(check-equal? (pretty-print-state (st '((a . #f) (b . 3) (c . 4)))) "a:#f b:3 c:4")
(check-equal? (pretty-print-modalities (list (set 'a) (set 'b 'a))) "{a}{a b}")
(check-equal? (pretty-print-boolean-state (st '((a . #f) (b . #t) (c . #t)))) "a:0 b:1 c:1")
2020-02-23 11:25:19 +01:00
(let ([vars '(a b c)])
(check-equal? (make-asyn vars) (set (set 'a) (set 'b) (set 'c)))
(check-equal? (make-syn vars) (set (set 'a 'b 'c))))
(let* ([n (nn #hash((a . (not a)) (b . b)))]
[asyn (make-asyn-dynamics n)]
[syn (make-syn-dynamics n)])
(check-equal? (dynamics-network asyn) n)
(check-equal? (dynamics-mode asyn) (set (set 'a) (set 'b)))
(check-equal? (dynamics-network syn) n)
(check-equal? (dynamics-mode syn) (set (set 'a 'b))))
(let* ([n (nn #hash((a . (not a)) (b . b)))]
[asyn (make-asyn-dynamics n)]
[syn (make-syn-dynamics n)]
[s (st '((a . #t) (b . #f)))]
[ss (set (st '((a . #t) (b . #t)))
(st '((a . #f) (b . #t))))]
[gr1 (dds-build-n-step-state-graph asyn (set s) 1)]
[gr-full (dds-build-state-graph asyn (set s))]
[gr-full-pp (ppsg gr-full)]
[gr-full-ppb (ppsgb gr-full)]
[gr-complete-bool (build-full-boolean-state-graph asyn)]
[gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)])
2020-02-23 12:23:55 +01:00
(check-equal? (dds-step-one asyn s) (set (st '((a . #f) (b . #f)))
2020-02-23 13:28:51 +01:00
(st '((a . #t) (b . #f)))))
(check-equal? (dds-step-one-annotated asyn s)
(set (cons (set 'b) '#hash((a . #t) (b . #f)))
(cons (set 'a) '#hash((a . #f) (b . #f)))))
2020-02-23 13:28:51 +01:00
(check-equal? (dds-step-one syn s) (set (st '((a . #f) (b . #f)))))
(check-equal? (dds-step asyn ss)
2020-02-23 13:28:51 +01:00
(set (st '((a . #f) (b . #t)))
(st '((a . #t) (b . #t)))))
(check-true (has-vertex? gr1 #hash((a . #t) (b . #f))))
(check-true (has-vertex? gr1 #hash((a . #f) (b . #f))))
(check-false (has-vertex? gr1 #hash((a . #t) (b . #t))))
(check-true (has-edge? gr1 #hash((a . #t) (b . #f)) #hash((a . #f) (b . #f))))
(check-true (has-edge? gr1 #hash((a . #t) (b . #f)) #hash((a . #t) (b . #f))))
(check-false (has-edge? gr1 #hash((a . #f) (b . #f)) #hash((a . #t) (b . #f))))
(check-true (has-vertex? gr-full #hash((a . #t) (b . #f))))
(check-true (has-vertex? gr-full #hash((a . #f) (b . #f))))
(check-false (has-vertex? gr-full #hash((a . #t) (b . #t))))
(check-true (has-edge? gr-full #hash((a . #t) (b . #f)) #hash((a . #f) (b . #f))))
(check-true (has-edge? gr-full #hash((a . #t) (b . #f)) #hash((a . #t) (b . #f))))
(check-true (has-edge? gr-full #hash((a . #f) (b . #f)) #hash((a . #t) (b . #f))))
(check-true (has-edge? gr-full #hash((a . #f) (b . #f)) #hash((a . #f) (b . #f))))
(check-true (has-vertex? gr-full-pp "a:#f b:#f"))
(check-true (has-vertex? gr-full-pp "a:#t b:#f"))
(check-true (has-vertex? gr-full-ppb "a:0 b:0"))
(check-true (has-vertex? gr-full-ppb "a:1 b:0"))
(check-equal? (get-edges gr-complete-bool)
'((#hash((a . #f) (b . #f)) #hash((a . #t) (b . #f)))
(#hash((a . #f) (b . #f)) #hash((a . #f) (b . #f)))
(#hash((a . #t) (b . #f)) #hash((a . #t) (b . #f)))
(#hash((a . #t) (b . #f)) #hash((a . #f) (b . #f)))
(#hash((a . #t) (b . #t)) #hash((a . #f) (b . #t)))
(#hash((a . #t) (b . #t)) #hash((a . #t) (b . #t)))
(#hash((a . #f) (b . #t)) #hash((a . #f) (b . #t)))
(#hash((a . #f) (b . #t)) #hash((a . #t) (b . #t)))))
(check-equal? (get-edges gr-complete-bool-ann)
'((#hash((a . #f) (b . #f)) #hash((a . #t) (b . #f)))
(#hash((a . #f) (b . #f)) #hash((a . #f) (b . #f)))
(#hash((a . #t) (b . #f)) #hash((a . #t) (b . #f)))
(#hash((a . #t) (b . #f)) #hash((a . #f) (b . #f)))
(#hash((a . #t) (b . #t)) #hash((a . #f) (b . #t)))
(#hash((a . #t) (b . #t)) #hash((a . #t) (b . #t)))
(#hash((a . #f) (b . #t)) #hash((a . #f) (b . #t)))
(#hash((a . #f) (b . #t)) #hash((a . #t) (b . #t)))))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #f) (b . #f)) #hash((a . #t) (b . #f)))
(set (set 'a)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #f) (b . #f)) #hash((a . #f) (b . #f)))
(set (set 'b)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #t) (b . #f)) #hash((a . #t) (b . #f)))
(set (set 'b)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #t) (b . #f)) #hash((a . #f) (b . #f)))
(set (set 'a)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #t) (b . #t)) #hash((a . #f) (b . #t)))
(set (set 'a)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #t) (b . #t)) #hash((a . #t) (b . #t)))
(set (set 'b)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #f) (b . #t)) #hash((a . #f) (b . #t)))
(set (set 'b)))
(check-equal? (edge-weight gr-complete-bool-ann
#hash((a . #f) (b . #t)) #hash((a . #t) (b . #t)))
(set (set 'a)))))