From abf8d4cf928ece0bc26766285fb9c0e7b57e7dc0 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Thu, 23 Mar 2023 16:16:02 +0100
Subject: [PATCH] Add table+headers->network.

---
 networks.rkt               | 34 +++++++++++++++++++++++++++++++++-
 scribblings/networks.scrbl | 19 +++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/networks.rkt b/networks.rkt
index 7ec0bd9..e8641f3 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -48,7 +48,7 @@
    tabulate-state+headers tabulate-state+headers/boolean
    tabulate-network tabulate-network+headers
 
-   table+vars->network table->network
+   table+vars->network table->network table+headers->network
    )
 
   (define-type (State a) (VariableMapping a))
@@ -1014,6 +1014,38 @@
       (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))))))
+
+  (: table+headers->network (All (a) (-> (Pairof (Listof Symbol) (Listof (Listof a)))
+                                         (Network a))))
+  (define (table+headers->network table)
+    (define headers : (Listof Symbol) (car table))
+    (define var-names : (Listof Variable)
+      (drop-right headers (quotient (length headers) 2)))
+    (table+vars->network var-names (cdr table)))
+
+  (module+ test
+    (test-case "table+headers->network"
+      (define n (table+headers->network
+                 '((x1 x2 f1 f2)
+                   (#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))))))
   )
diff --git a/scribblings/networks.scrbl b/scribblings/networks.scrbl
index e1e88f8..40eb46d 100644
--- a/scribblings/networks.scrbl
+++ b/scribblings/networks.scrbl
@@ -872,6 +872,25 @@ Like @racket[table+vars->network], but generates variable names as
   (network-domains n))
 ]}
 
+@defproc[(table+headers->network [table (Pairof (Listof Symbol) (Listof (Listof a)))])
+				 (Network a)]{
+
+Like @racket[table+vars->network], but the variable names are taken
+from the first line of @racket[table].
+
+The lines of @racket[table] are taken to be of the same length, so it
+is assumed that half of the first line contain variable names, and the
+other half function names.  Function names are discarded.
+
+@ex[
+(let ([n (table+headers->network '((a b fa fb)
+                                   (#f #f #f #f)
+                                   (#f #t #f #t)
+                                   (#t #f #t #f)
+                                   (#t #t #t #t)))])
+  (network-domains n))
+]}
+
 @section{Random functions and networks}
 
 @section{TBF/TBN and SBF/SBN}