networks: Make table->network infer the domains.

This commit is contained in:
Sergiu Ivanov 2020-11-28 22:46:43 +01:00
parent a1085d50b8
commit 5fc4875adf
1 changed files with 12 additions and 4 deletions

View File

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