From 0c91e6f6b2bc16214e910650267499000b1f386e Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Thu, 6 Jul 2023 11:44:49 +0200
Subject: [PATCH] Type parse-org-tbn.

---
 scribblings/tbn.scrbl | 34 ++++++++++++++++++++++++++++++++++
 tbn.rkt               | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 73 insertions(+)

diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl
index 52b06d2..19d0a2f 100644
--- a/scribblings/tbn.scrbl
+++ b/scribblings/tbn.scrbl
@@ -217,6 +217,40 @@ is taken to contain the names of the variables, similarly to
 (read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
 ]}
 
+@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
+			[#:headers headers Boolean #t]
+			[#:func-names func-names Boolean #t])
+			TBN]{
+
+Reads a TBN from a list of lists of numbers or symbols, which may
+represent an Org-mode table.  As in @racket[lists->tbfs/state], the
+last element of each list is taken to be the threshold of the TBF, and
+the rest of the elements are taken to be the weights.
+
+If @racket[headers] is @racket[#t], the names of the variables to
+appear as the inputs of the TBF are taken from the first list.
+The last element of this list (corresponding to the column giving the
+threshold) is discarded.  If @racket[headers] is @racket[#f], the
+names of the variables are generated as @tt{xi}, where @tt{i} is
+the index of the variable.
+
+If @racket[func-names] is @racket[#t], the first element in every row
+except the first one are taken to be the name of the variable to which
+the TBF should be associated.  If @racket[func-names] is @racket[#f],
+the functions are assigned to variables in lexicographic order.
+
+@racket[func-names] cannot be @racket[#t] if @racket[headers] is
+@racket[#f].  The function does not check this condition.
+
+This is a helper function for @racket[read-org-tbn] and
+@racket[read-org-sbn].
+
+@ex[
+(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
+(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
+(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
+]}
+
 @defproc[(tbfs/state->lists [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
 
 Given a list of @racket[TBF/State], produces a sexp that Org-mode can
diff --git a/tbn.rkt b/tbn.rkt
index d86aaa4..40c1cfb 100644
--- a/tbn.rkt
+++ b/tbn.rkt
@@ -37,6 +37,7 @@
    group-truth-table-by-nai
 
    TBN sbn? tbn->network
+   parse-org-tbn
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -212,6 +213,44 @@
                     (list (tbf/state '#hash((a . 1) (b . 2)) 3)
                           (tbf/state '#hash((a . 1) (b . 1)) 2)))))
 
+  (: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
+                        (#:headers Boolean
+                         #:func-names Boolean)
+                        TBN))
+  (define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t])
+    (cond [func-names
+           (define-values (vars rows) (multi-split-at tab 1))
+           (define tbfs (lists->tbfs/state/opt-headers rows #:headers headers))
+           (for/hash : TBN
+                     ([tbf (in-list tbfs)]
+                      [var (in-list (cdr vars))])
+             (values (assert-type (car var) Variable) tbf))]
+          [else
+           (define tbfs (lists->tbfs/state/opt-headers tab #:headers headers))
+           (define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
+           (for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)])
+             (values (assert-type var Variable) tbf))]))
+
+  (module+ test
+    (test-case "parse-org-tbn"
+      (check-equal?
+       (parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
+       (hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
+             'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1)))
+      (check-equal?
+       (parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
+       (hash
+        'a
+        (tbf/state '#hash((a . 1) (b . 2)) 3)
+        'b
+        (tbf/state '#hash((a . 3) (b . 2)) 1)))
+      (check-equal?
+       (parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3))
+                      #:headers #t
+                      #:func-names #t)
+       (hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
+             'b (tbf/state '#hash((a . 3) (b . 2)) 1)))))
+
   (: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
   (define (tbfs/state->lists tbfs)
     (for/list ([tbf (in-list tbfs)])