scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

networks: Fix tabulating functions and networks.

This commit is contained in:
Sergiu Ivanov 2020-11-22 21:41:06 +01:00
parent fd651ba4cc
commit 3a2453c92e
1 changed files with 8 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
networks.rkt
View File

@ -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)))))