From b98d00320cb6f9e19fe78a16c0f3c38207a8dd16 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Wed, 27 May 2020 23:39:38 +0200 Subject: [PATCH] networks: Use test-case and define instead of let. --- networks.rkt | 264 +++++++++++++++++++++++++++++---------------------- 1 file changed, 151 insertions(+), 113 deletions(-) diff --git a/networks.rkt b/networks.rkt index 1706bdd..a61e080 100644 --- a/networks.rkt +++ b/networks.rkt @@ -98,8 +98,7 @@ [domain-mapping/c contract?])) (module+ test - (require rackunit) - (random-seed 0)) + (require rackunit)) ;;; ================= @@ -129,16 +128,18 @@ (hash-set new-s x (f s))))) (module+ test - (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)))] - [s1 (make-state '((x1 . #t) (x2 . #f)))] - [new-s1 (update bn s1 '(x2 x1))] - [s2 (make-state '((x1 . #f) (x2 . #f)))] - [new-s2 (update bn s2 '(x2))]) + (test-case "basic definitions" + (define f1 (λ (s) (let ([x1 (hash-ref s 'x1)] + [x2 (hash-ref s 'x2)]) + (and x1 (not x2))))) + (define f2 (λ (s) (let ([x2 (hash-ref s 'x2)]) + (not x2)))) + (define bn (make-network-from-functions `((x1 . ,f1) (x2 . ,f2)))) + (define s1 (make-state '((x1 . #t) (x2 . #f)))) + (define new-s1 (update bn s1 '(x2 x1))) + (define s2 (make-state '((x1 . #f) (x2 . #f)))) + (define new-s2 (update bn s2 '(x2))) + (check-equal? s1 #hash((x1 . #t) (x2 . #f))) (check-equal? new-s1 #hash((x1 . #t) (x2 . #t))) (check-equal? s2 #hash((x1 . #f) (x2 . #f))) @@ -157,10 +158,11 @@ [(cons var 1) (cons var #t)])))) (module+ test - (check-equal? (make-state-booleanize '((a . 0) (b . 1))) - (make-state '((a . #f) (b . #t)))) - (check-equal? (booleanize-state (make-state '((a . 0) (b . 1)))) - (make-state '((a . #f) (b . #t))))) + (test-case "make-state, make-state-booleanize, booleanize-state" + (check-equal? (make-state-booleanize '((a . 0) (b . 1))) + (make-state '((a . #f) (b . #t)))) + (check-equal? (booleanize-state (make-state '((a . 0) (b . 1)))) + (make-state '((a . #f) (b . #t)))))) ;;; Booleanizes a given state: replaces 0 with #f and 1 with #t. (define (booleanize-state s) @@ -188,8 +190,9 @@ (λ (s) (eval-with s form))) (module+ test - (let ([s (make-state '((x . #t) (y . #f)))] - [f (update-function-form->update-function '(and x y))]) + (test-case "update-function-form->update-function" + (define s (make-state '((x . #t) (y . #f)))) + (define f (update-function-form->update-function '(and x y))) (check-equal? (f s) #f))) ;;; Build a network from a network form. @@ -198,9 +201,10 @@ (values x (update-function-form->update-function form)))) (module+ test - (let ([bn (network-form->network - (make-hash '((a . (and a b)) (b . (not b)))))] - [s (make-state '((a . #t) (b . #t)))]) + (test-case "network-form->network" + (define bn (network-form->network + (make-hash '((a . (and a b)) (b . (not b)))))) + (define s (make-state '((a . #t) (b . #t)))) (check-equal? ((hash-ref bn 'a) s) #t))) ;;; Build a network from a list of pairs of forms of update functions. @@ -208,9 +212,10 @@ (network-form->network (make-immutable-hash forms))) (module+ test - (let ([bn (make-network-from-forms '((a . (and a b)) - (b . (not b))))] - [s (make-state '((a . #t) (b . #t)))]) + (test-case "make-network-from-forms" + (define bn (make-network-from-forms '((a . (and a b)) + (b . (not b))))) + (define s (make-state '((a . #t) (b . #t)))) (check-equal? ((hash-ref bn 'a) s) #t))) @@ -240,8 +245,9 @@ (hash-keys nf))) (module+ test - (let* ([n #hash((a . (+ a b c)) - (b . (- b c)))]) + (test-case "list-interactions" + (define n #hash((a . (+ a b c)) + (b . (- b c)))) (check-true (set=? (list-interactions n 'a) '(a b))) (check-true (set=? (list-interactions n 'b) '(b))))) @@ -254,9 +260,10 @@ (for/list ([(var _) n]) (cons var (list-interactions n var)))))) (module+ test - (let* ([n #hash((a . (+ a b c)) - (b . (- b c)))] - [ig (build-interaction-graph n)]) + (test-case "build-interaction-graph" + (define n #hash((a . (+ a b c)) + (b . (- b c)))) + (define ig (build-interaction-graph n)) (check-true (has-vertex? ig 'a)) (check-true (has-vertex? ig 'b)) (check-false (has-vertex? ig 'c)) @@ -281,13 +288,14 @@ (cons var val)))))) (module+ test - (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))))) + (test-case "build-all-states" + (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)))))) ;;; Makes a hash set mapping all variables to a single domain. (define (make-same-domains vars domain) @@ -298,19 +306,21 @@ (make-same-domains vars '(#f #t))) (module+ test - (check-equal? (make-boolean-domains '(a b)) - #hash((a . (#f #t)) (b . (#f #t))))) + (test-case "make-same-domains, make-boolean-domains" + (check-equal? (make-boolean-domains '(a b)) + #hash((a . (#f #t)) (b . (#f #t)))))) ;;; Builds all boolean states possible over a given set of variables. (define (build-all-boolean-states vars) (build-all-states (make-boolean-domains vars))) (module+ test - (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))))) + (test-case "build-all-boolean-states" + (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)))))) ;;; Given two interacting variables of a network and the domains ;;; of the variables, returns '+ if the interaction is monotonously @@ -358,8 +368,9 @@ [else '0]))) (module+ test - (let* ([n #hash((a . (not b)) (b . a))] - [doms (make-boolean-domains '(a b))]) + (test-case "get-interaction-sign" + (define n #hash((a . (not b)) (b . a))) + (define doms (make-boolean-domains '(a b))) (check-equal? (get-interaction-sign (network-form->network n) doms 'a 'b) '+) (check-equal? (get-interaction-sign (network-form->network n) doms 'b 'a) '-))) @@ -388,9 +399,10 @@ sig)) (module+ test - (let* ([n #hash((a . (not b)) (b . a))] - [doms (make-boolean-domains '(a b))] - [sig1 (build-signed-interaction-graph/form n doms)]) + (test-case "build-signed-interaction-graph/form" + (define n #hash((a . (not b)) (b . a))) + (define doms (make-boolean-domains '(a b))) + (define sig1 (build-signed-interaction-graph/form n doms)) (check-true (has-vertex? sig1 'a)) (check-true (has-vertex? sig1 'b)) (check-false (has-vertex? sig1 'c)) @@ -413,8 +425,9 @@ (make-boolean-domains (hash-keys network-form)))) (module+ test - (let* ([n #hash((a . (not b)) (b . a))] - [sig2 (build-boolean-signed-interaction-graph/form n)]) + (test-case "build-boolean-signed-interaction-graph/form" + (define n #hash((a . (not b)) (b . a))) + (define sig2 (build-boolean-signed-interaction-graph/form n)) (check-true (has-vertex? sig2 'a)) (check-true (has-vertex? sig2 'b)) (check-false (has-vertex? sig2 'c)) @@ -466,8 +479,9 @@ (build-signed-interaction-graph network (make-boolean-domains (hash-keys network)))) (module+ test - (let* ([n #hash((a . (not b)) (b . a))] - [sig3 (build-boolean-signed-interaction-graph (network-form->network n))]) + (test-case "build-signed-interaction-graph, build-boolean-signed-interaction-graph" + (define n #hash((a . (not b)) (b . a))) + (define sig3 (build-boolean-signed-interaction-graph (network-form->network n))) (check-true (has-vertex? sig3 'a)) (check-true (has-vertex? sig3 'b)) (check-equal? (edge-weight sig3 'a 'a) '+) @@ -476,12 +490,13 @@ (check-equal? (edge-weight sig3 'b 'a) '-))) ;;; Interaction graphs for networks without interactions must still -;;; contain all networks. +;;; contain all nodes. (module+ test - (let* ([n #hash((a . #t) (b . #t))] - [ig (build-interaction-graph n)] - [sig-nf (build-boolean-signed-interaction-graph/form n)] - [sig (build-boolean-signed-interaction-graph (network-form->network n))]) + (test-case "Interaction must graphs always contain all nodes." + (define n #hash((a . #t) (b . #t))) + (define ig (build-interaction-graph n)) + (define sig-nf (build-boolean-signed-interaction-graph/form n)) + (define sig (build-boolean-signed-interaction-graph (network-form->network n))) (check-equal? (get-vertices ig) '(b a)) (check-true (empty? (get-edges ig))) (check-equal? (get-vertices sig-nf) '(b a)) @@ -520,7 +535,8 @@ (define (make-syn vars) (set (list->set vars))) (module+ test - (let ([vars '(a b c)]) + (test-case "make-asyn, make-syn" + (define 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))))) @@ -538,9 +554,10 @@ (make-dynamics-from-func network make-syn)) (module+ test - (let* ([n (network-form->network #hash((a . (not a)) (b . b)))] - [asyn (make-asyn-dynamics n)] - [syn (make-syn-dynamics n)]) + (test-case "make-asyn-dynamics, make-syn-dynamics" + (define n (network-form->network #hash((a . (not a)) (b . b)))) + (define asyn (make-asyn-dynamics n)) + (define 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) @@ -559,8 +576,9 @@ (string-join (hash-map s (λ (key val) (format "~a:~a" key val)) #t))) (module+ test - (check-equal? (pretty-print-state (make-state '((a . #f) (b . 3) (c . 4)))) - "a:#f b:3 c:4")) + (test-case "pretty-print-state" + (check-equal? (pretty-print-state (make-state '((a . #f) (b . 3) (c . 4)))) + "a:#f b:3 c:4"))) ;;; Converts any non-#f value to 1 and #f to 0. (define (any->boolean x) (if x 1 0)) @@ -570,9 +588,10 @@ (string-join (hash-map s (λ (key val) (format "~a:~a" key (any->boolean val))) #t))) (module+ test - (check-equal? - (pretty-print-boolean-state (make-state '((a . #f) (b . #t) (c . #t)))) - "a:0 b:1 c:1")) + (test-case "pretty-print-boolean-state" + (check-equal? + (pretty-print-boolean-state (make-state '((a . #f) (b . #t) (c . #t)))) + "a:0 b:1 c:1"))) ;;; Given a state graph and a pretty-printer for states build a new ;;; state graph with pretty-printed vertices and edges. @@ -606,18 +625,19 @@ (list->set (build-all-boolean-states (hash-keys (dynamics-network dyn)))))) (module+ test - (let* ([n (network-form->network #hash((a . (not a)) (b . b)))] - [asyn (make-asyn-dynamics n)] - [syn (make-syn-dynamics n)] - [s (make-state '((a . #t) (b . #f)))] - [ss (set (make-state '((a . #t) (b . #t))) - (make-state '((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 (pretty-print-state-graph gr-full)] - [gr-full-ppb (pretty-print-boolean-state-graph gr-full)] - [gr-complete-bool (build-full-boolean-state-graph asyn)] - [gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)]) + (test-case "Dynamics of networks" + (define n (network-form->network #hash((a . (not a)) (b . b)))) + (define asyn (make-asyn-dynamics n)) + (define syn (make-syn-dynamics n)) + (define s (make-state '((a . #t) (b . #f)))) + (define ss (set (make-state '((a . #t) (b . #t))) + (make-state '((a . #f) (b . #t))))) + (define gr1 (dds-build-n-step-state-graph asyn (set s) 1)) + (define gr-full (dds-build-state-graph asyn (set s))) + (define gr-full-pp (pretty-print-state-graph gr-full)) + (define gr-full-ppb (pretty-print-boolean-state-graph gr-full)) + (define gr-complete-bool (build-full-boolean-state-graph asyn)) + (define gr-complete-bool-ann (build-full-boolean-state-graph-annotated asyn)) (check-equal? (dds-step-one asyn s) (set (make-state '((a . #f) (b . #f))) (make-state '((a . #t) (b . #f))))) (check-equal? (dds-step-one-annotated asyn s) @@ -706,15 +726,17 @@ (append xs (list (apply func xs))))) (module+ test - (check-equal? (tabulate/domain-list (λ (x y) (and x y)) '((#f #t) (#f #t))) - '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))) + (test-case "tabulate/domain-list" + (check-equal? (tabulate/domain-list (λ (x y) (and x y)) '((#f #t) (#f #t))) + '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))) ;;; Like tabulate, but the domains are given as a rest argument. (define (tabulate func . doms) (tabulate/domain-list func doms)) (module+ test - (check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t)) - '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))) + (test-case "tabulate" + (check-equal? (tabulate (λ (x y) (and x y)) '(#f #t) '(#f #t)) + '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))) ;;; Like tabulate, but assumes the domains of all variables of the ;;; function are Boolean. func must have a fixed arity. It is an @@ -723,8 +745,9 @@ (tabulate/domain-list func (make-list (procedure-arity func) '(#f #t)))) (module+ test - (check-equal? (tabulate/boolean (lambda (x y) (and x y))) - '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))) + (test-case "tabulate/boolean" + (check-equal? (tabulate/boolean (lambda (x y) (and x y))) + '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))) ;;; Like tabulate, but supposes that the function works on states. ;;; @@ -749,7 +772,8 @@ (tabulate-state func (make-boolean-domains args) #:headers headers)) (module+ test - (let ([func (λ (st) (not (hash-ref st 'a)))]) + (test-case "tabulate-state/boolean" + (define func (λ (st) (not (hash-ref st 'a)))) (check-equal? (tabulate-state/boolean func '(a)) '((a f) (#f #t) (#t #f))))) ;;; Tabulates a given network. @@ -779,7 +803,8 @@ #:headers headers)) (module+ test - (let ([bn (network-form->network #hash((a . (not a)) (b . b)))]) + (test-case "tabulate-boolean-network" + (define bn (network-form->network #hash((a . (not a)) (b . b)))) (check-equal? (tabulate-boolean-network bn) '((a b f-a f-b) (#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t))) (check-equal? (tabulate-boolean-network bn #:headers #f) @@ -807,7 +832,8 @@ (λ args (func args)))) (module+ test - (let ([negation (table->function '((#t #f) (#f #t)))]) + (test-case "table->function" + (define negation (table->function '((#t #f) (#f #t)))) (check-true (negation #f)) (check-false (negation #t)))) @@ -820,7 +846,8 @@ (values x (car fx)))))) (module+ test - (let ([negation/list (table->function/list '((#t #f) (#f #t)))]) + (test-case "table->function/list" + (define negation/list (table->function/list '((#t #f) (#f #t)))) (check-true (negation/list '(#f))) (check-false (negation/list '(#t))))) @@ -862,13 +889,15 @@ (make-network-from-functions (map cons var-names funcs))) (module+ test - (let* ([n (table->network '((x1 x2 f1 f2) - (#f #f #f #f) - (#f #t #f #t) - (#t #f #t #f) - (#t #t #t #t)))] - [f1 (hash-ref n 'x1)] - [f2 (hash-ref n 'x2)]) + (test-case "table->network" + (define n (table->network '((x1 x2 f1 f2) + (#f #f #f #f) + (#f #t #f #t) + (#t #f #t #f) + (#t #t #t #t)))) + (define f1 (hash-ref n 'x1)) + (define f2 (hash-ref n 'x2)) + (check-false (f1 (make-state '((x1 . #f) (x2 . #f))))) (check-false (f1 (make-state '((x1 . #f) (x2 . #t))))) (check-true (f1 (make-state '((x1 . #t) (x2 . #f))))) @@ -883,14 +912,16 @@ (define (boolean-power n) (apply cartesian-product (make-list n '(#f #t)))) (module+ test - (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t)))) + (test-case "boolean-power" + (check-equal? (boolean-power 2) '((#f #f) (#f #t) (#t #f) (#t #t))))) ;;; Like boolean-power, but returns a stream whose elements the ;;; elements of the Cartesian power. (define (boolean-power/stream n) (apply cartesian-product/stream (make-list n '(#f #t)))) (module+ test - (check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t)))) + (test-case "boolean-power/stream" + (check-equal? (stream->list (boolean-power/stream 2)) '((#f #f) (#f #t) (#t #f) (#t #t))))) ;;; Returns the stream of the truth tables of all Boolean functions of ;;; a given arity. @@ -910,7 +941,8 @@ (stream-map table->function (enumerate-boolean-tables n))) (module+ test - (let ([f1 (stream-first (enumerate-boolean-functions 1))]) + (test-case "enumerate-boolean-tables" + (define f1 (stream-first (enumerate-boolean-functions 1))) (check-false (f1 #f)) (check-false (f1 #t)))) @@ -924,7 +956,8 @@ (stream-map table->function/list (enumerate-boolean-tables n))) (module+ test - (let ([f1/list (stream-first (enumerate-boolean-functions/list 1))]) + (test-case "enumerate-boolean-functions/list" + (define f1/list (stream-first (enumerate-boolean-functions/list 1))) (check-false (f1/list '(#f))) (check-false (f1/list '(#t))))) @@ -942,13 +975,16 @@ (append i (list (num->bool o))))) (module+ test - (check-equal? (random-boolean-table 2) '((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f)))) + (test-case "random-boolean-table" + (random-seed 0) + (check-equal? (random-boolean-table 2) '((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f))))) ;;; Generates a random Boolean function of arity n. (define random-boolean-function (compose table->function random-boolean-table)) (module+ test - (let ([f (random-boolean-function 2)]) + (test-case "random-boolean-function" + (define f (random-boolean-function 2)) (check-true (f #f #f)) (check-false (f #f #t)) (check-true (f #t #f)) (check-false (f #t #t)))) @@ -957,7 +993,8 @@ (define random-boolean-function/list (compose table->function/list random-boolean-table)) (module+ test - (let ([f (random-boolean-function/list 2)]) + (test-case "random-boolean-function/list" + (define f (random-boolean-function/list 2)) (check-false (f '(#f #f))) (check-true (f '(#f #t))) (check-true (f '(#t #f))) (check-false (f '(#t #t))))) @@ -974,23 +1011,24 @@ (random-function/state (make-boolean-domains args) '(#f #t))) (module+ test - (test-begin + (test-case "random-boolean-function/state" + (random-seed 0) (define f (random-boolean-function/state '(x1 x2))) (check-equal? (tabulate-state/boolean f '(x1 x2)) - '((x1 x2 f) (#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f))) + '((x1 x2 f) (#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))) (check-equal? (tabulate-state/boolean f '(x1 x2) #:headers #f) - '((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f))) + '((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))) (define bn (random-boolean-network/vars 3)) (check-equal? (tabulate-boolean-network bn) '((x0 x1 x2 f-x0 f-x1 f-x2) - (#f #f #f #t #f #f) - (#f #f #t #t #t #f) - (#f #t #f #f #t #f) - (#f #t #t #t #f #t) - (#t #f #f #t #f #f) - (#t #f #t #f #t #t) - (#t #t #f #t #f #f) - (#t #t #t #f #t #t))))) + (#f #f #f #f #t #f) + (#f #f #t #t #f #f) + (#f #t #f #f #t #t) + (#f #t #t #t #f #f) + (#t #f #f #t #f #t) + (#t #f #t #f #f #t) + (#t #t #f #f #f #f) + (#t #t #t #t #t #t))))) ;;; Generates a random network from the given domain mapping. (define (random-network domains)