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
|
;;; 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.
|
||||||
|
|
Loading…
Reference in a new issue