networks: Rewrite tabulate-network to use tabulate-state*/boolean.
This commit is contained in:
parent
9a1477ad42
commit
7f58bf5623
1 changed files with 12 additions and 7 deletions
19
networks.rkt
19
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.
|
||||
|
|
Loading…
Reference in a new issue