networks: Make table->network infer the domains.
This commit is contained in:
parent
a1085d50b8
commit
5fc4875adf
1 changed files with 12 additions and 4 deletions
16
networks.rkt
16
networks.rkt
|
@ -974,8 +974,9 @@
|
|||
;;; This function relies on table->function, so the same caveats
|
||||
;;; apply.
|
||||
;;;
|
||||
;;; This function sets the domain mappings of the network to the empty
|
||||
;;; hash table.
|
||||
;;; The domains of the network is a mapping assigning to each variable
|
||||
;;; the set of values which can appear in its column in the table.
|
||||
;;; This function does not check whether the table is complete.
|
||||
(define (table->network table #:headers [headers #t])
|
||||
(define n (/ (length (car table)) 2))
|
||||
;; Get the variable names from the table or generate them, if
|
||||
|
@ -997,11 +998,15 @@
|
|||
(define funcs (for/list ([out func-lines])
|
||||
(table->function (for/list ([in st-ins] [o out])
|
||||
(list in o)))))
|
||||
;; Infer the domains.
|
||||
(define domains (for/hash [(dom (in-list (lists-transpose ins)))
|
||||
(x (in-list var-names))]
|
||||
(values x (remove-duplicates dom))))
|
||||
;; Construct the network.
|
||||
(network (for/hash ([x (in-list var-names)]
|
||||
[f (in-list funcs)])
|
||||
(values x f))
|
||||
(hash)))
|
||||
domains))
|
||||
|
||||
(module+ test
|
||||
(test-case "table->network"
|
||||
|
@ -1021,7 +1026,10 @@
|
|||
(check-false (f2 (make-state '((x1 . #f) (x2 . #f)))))
|
||||
(check-true (f2 (make-state '((x1 . #f) (x2 . #t)))))
|
||||
(check-false (f2 (make-state '((x1 . #t) (x2 . #f)))))
|
||||
(check-true (f2 (make-state '((x1 . #t) (x2 . #t)))))))
|
||||
(check-true (f2 (make-state '((x1 . #t) (x2 . #t)))))
|
||||
|
||||
(check-equal? (network-domains n)
|
||||
#hash((x1 . (#f #t)) (x2 . (#f #t))))))
|
||||
|
||||
|
||||
;;; =============================
|
||||
|
|
Loading…
Reference in a new issue