From 3a2453c92e5ae3398447e7bd6a0cbb0721c1fe8f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sun, 22 Nov 2020 21:41:06 +0100 Subject: [PATCH] networks: Fix tabulating functions and networks. --- networks.rkt | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/networks.rkt b/networks.rkt index cf2bd50..e4d4f32 100644 --- a/networks.rkt +++ b/networks.rkt @@ -78,10 +78,8 @@ (listof (listof any/c)))] [tabulate-state*/boolean (->* ((non-empty-listof procedure?) (listof variable?)) (#:headers boolean?) (listof (listof any/c)))] - [tabulate-network (->* (network? domain-mapping/c) (#:headers boolean?) + [tabulate-network (->* (network?) (#:headers boolean?) (listof (listof any/c)))] - [tabulate-boolean-network (->* (network?) (#:headers boolean?) - (listof (listof any/c)))] [table->network (->* ((listof (*list/c any/c any/c))) (#:headers boolean?) network?)] [random-function/state (domain-mapping/c generic-set? . -> . procedure?)] [random-boolean-function/state ((listof variable?) . -> . procedure?)] @@ -921,13 +919,13 @@ ;;; network. If headers is #t, prepends a list of variable names and ;;; update functions (f-x, where x is the name of the corresponding ;;; variable) to the result. -(define (tabulate-network network domains #:headers [headers #t]) +(define (tabulate-network network #:headers [headers #t]) ;; I use hash-map with try-order? set to #t to ask the hash table to ;; sort the keys for me. (define-values (vars funcs) (for/lists (l1 l2) - ([pair (hash-map network cons #t)]) + ([pair (hash-map (network-functions network) cons #t)]) (values (car pair) (cdr pair)))) - (define tab (tabulate-state* funcs domains #:headers headers)) + (define tab (tabulate-state* funcs (network-domains network) #:headers headers)) (cond [headers ;; Replace the names of the functions tabulate-state* gave us by @@ -938,17 +936,12 @@ (cons (append (take hdrs (length vars)) fnames) vals)])] [else tab])) -;;; Like tabulate-network, but assumes all the variables are Boolean. -(define (tabulate-boolean-network bn #:headers [headers #t]) - (tabulate-network bn (make-boolean-domains (hash-map bn (λ (x y) x) #t)) - #:headers headers)) - (module+ test - (test-case "tabulate-boolean-network" - (define bn (network-form->network #hash((a . (not a)) (b . b)))) - (check-equal? (tabulate-boolean-network bn) + (test-case "tabulate-network" + (define bn (forms->boolean-network #hash((a . (not a)) (b . b)))) + (check-equal? (tabulate-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) + (check-equal? (tabulate-network bn #:headers #f) '((#f #f #t #f) (#f #t #t #t) (#t #f #f #f) (#t #t #f #t)))))