From 7f58bf56231598ef1d0f5e1f09714a3b769bc994 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Tue, 2 Jun 2020 23:34:19 +0200 Subject: [PATCH] networks: Rewrite tabulate-network to use tabulate-state*/boolean. --- networks.rkt | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/networks.rkt b/networks.rkt index a590a63..78b50e5 100644 --- a/networks.rkt +++ b/networks.rkt @@ -779,15 +779,20 @@ ;;; 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 funcs (hash-map network (λ (x y) y) #t)) - (define tab (for/list ([st (build-all-states domains)]) - (append (hash-map st (λ (x y) y) #t) - (for/list ([f funcs]) (f st))))) + ;; 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)]) + (values (car pair) (cdr pair)))) + (define tab (tabulate-state* funcs domains #:headers headers)) (cond [headers - (define var-names (hash-map network (λ (x y) x) #t)) - (define func-names (for/list ([x var-names]) (string->symbol (format "f-~a" x)))) - (cons (append var-names func-names) tab)] + ;; Replace the names of the functions tabulate-state* gave us by + ;; what we promise in the comment. + (define fnames (for/list ([x (in-list vars)]) + (string->symbol (format "f-~a" x)))) + (match tab [(cons hdrs vals) + (cons (append (take hdrs (length vars)) fnames) vals)])] [else tab])) ;;; Like tabulate-network, but assumes all the variables are Boolean.