networks: Rewrite tabulate-network to use tabulate-state*/boolean.

This commit is contained in:
Sergiu Ivanov 2020-06-02 23:34:19 +02:00
parent 9a1477ad42
commit 7f58bf5623

View file

@ -779,15 +779,20 @@
;;; update functions (f-x, where x is the name of the corresponding ;;; update functions (f-x, where x is the name of the corresponding
;;; variable) to the result. ;;; variable) to the result.
(define (tabulate-network network domains #:headers [headers #t]) (define (tabulate-network network domains #:headers [headers #t])
(define funcs (hash-map network (λ (x y) y) #t)) ;; I use hash-map with try-order? set to #t to ask the hash table to
(define tab (for/list ([st (build-all-states domains)]) ;; sort the keys for me.
(append (hash-map st (λ (x y) y) #t) (define-values (vars funcs) (for/lists (l1 L2)
(for/list ([f funcs]) (f st))))) ([pair (hash-map network cons #t)])
(values (car pair) (cdr pair))))
(define tab (tabulate-state* funcs domains #:headers headers))
(cond (cond
[headers [headers
(define var-names (hash-map network (λ (x y) x) #t)) ;; Replace the names of the functions tabulate-state* gave us by
(define func-names (for/list ([x var-names]) (string->symbol (format "f-~a" x)))) ;; what we promise in the comment.
(cons (append var-names func-names) tab)] (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])) [else tab]))
;;; Like tabulate-network, but assumes all the variables are Boolean. ;;; Like tabulate-network, but assumes all the variables are Boolean.