Add table->network.

networks.rkt

@@ -47,6 +47,8 @@
    tabulate-state tabulate-state/boolean
    tabulate-state+headers tabulate-state+headers/boolean
    tabulate-network tabulate-network+headers
+
+   table->network
    )
 
   (define-type (State a) (VariableMapping a))
@@ -928,7 +930,66 @@
                       (#f #t #t #t)
                       (#t #f #f #f)
                       (#t #t #f #t)))))
-    )
+
+  (: table->network (All (a) (-> (Listof (Listof a)) (Network a))))
+  (define (table->network table)
+    (define n : Integer (quotient (length (car table)) 2))
+    ;; Get the variable names from the table or generate them, if
+    ;; necessary.
+    (define var-names : (Listof Variable)
+      (for/list : (Listof Variable)
+                ([i (in-range 1 (add1 n))])
+        (format-symbol "x~a" i)))
+    ;; Split the table into the inputs and the outputs of the functions.
+    (define-values (ins outs) (multi-split-at table n))
+    ;; Transpose outs to have functions define by lines instead of by
+    ;; columns.
+    (define func-lines : (Listof (Listof a)) (lists-transpose outs))
+    ;; Make states out of inputs.
+    (define st-ins : (Listof (State a))
+      (for/list ([in ins]) (make-immutable-hash
+                            (map (inst cons Variable a) var-names in))))
+    ;; Construct the functions.
+    (define funcs : (Listof (UpdateFunction a))
+      (for/list ([out func-lines])
+        (table->unary-function
+         (for/list : (Listof (List (State a) a))
+                   ([in st-ins] [o out])
+           (list in o)))))
+    ;; Infer the domains.
+    (define domains : (DomainMapping a)
+      (make-immutable-hash
+       (map (inst cons Variable (Domain a))
+            var-names
+            (map (inst remove-duplicates a) (lists-transpose ins)))))
+    ;; Construct the network.
+    (network (make-immutable-hash
+              (map (inst cons Variable (UpdateFunction a))
+                   var-names funcs))
+             domains))
+
+  (module+ test
+    (test-case "table->network"
+      (define n (table->network '((#f #f #f #f)
+                                  (#f #t #f #t)
+                                  (#t #f #t #f)
+                                  (#t #t #t #t))))
+      (define f1 (hash-ref (network-functions n) 'x1))
+      (define f2 (hash-ref (network-functions n) 'x2))
+
+      (check-false (f1 (hash 'x1 #f 'x2 #f)))
+      (check-false (f1 (hash 'x1 #f 'x2 #t)))
+      (check-true (f1 (hash 'x1 #t 'x2 #f)))
+      (check-true (f1 (hash 'x1 #t 'x2 #t)))
+
+      (check-false (f2 (hash 'x1 #f 'x2 #f)))
+      (check-true (f2 (hash 'x1 #f 'x2 #t)))
+      (check-false (f2 (hash 'x1 #t 'x2 #f)))
+      (check-true (f2 (hash 'x1 #t 'x2 #t)))
+
+      (check-equal? (network-domains n)
+                    #hash((x1 . (#f #t)) (x2 . (#f #t))))))
+  )
 
 (require 'typed)
 

scribblings/networks.scrbl

@@ -832,6 +832,31 @@ function names in the corresponding column headers are of the form
 
 @section{Constructing functions and networks}
 
+@defproc[(table->network [table (Listof (Listof a))])
+			 (Network a)]{
+
+Given a table like the one produced by @racket[tabulate-network],
+constructs a network having this behaviour.
+
+Variable names are generated as @tt{xi}, where 1 ≤ @tt{i} ≤ number of
+variables.  The columns defining the functions are taken to be in the
+same order as the columns defining the variables.  The domains of the
+network are a mapping assigning to each variable the set of values
+which can appear in the corresponding column in the table.
+
+This function relies on @racket[table->unary-function], so the same
+performance caveats apply.
+
+This function does not check whether the table is complete.
+
+@ex[
+(let ([n (table->network '((#f #f #f #f)
+                           (#f #t #f #t)
+                           (#t #f #t #f)
+                           (#t #t #t #t)))])
+  (tabulate-network n))
+]}
+
 @section{Random functions and networks}
 
 @section{TBF/TBN and SBF/SBN}