From c523c680379457e17105d30796511fdd26f93905 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Fri, 7 Jul 2023 12:29:36 +0200
Subject: [PATCH] Type read-org-sbn.

---
 scribblings/tbn.scrbl | 13 +++++++++++++
 tbn.rkt               | 39 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl
index 62bfa06..2bb3c74 100644
--- a/scribblings/tbn.scrbl
+++ b/scribblings/tbn.scrbl
@@ -284,6 +284,19 @@ check this condition.
 (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
 ]}
 
+@defproc[(read-org-sbn [str String]
+		       [#:headers headers Boolean #t]
+		       [#:func-names func-names Boolean #t])
+		       TBN]{
+
+Like @racket[read-org-tbn], but reads an SBN from the input string,
+i.e. all the numbers are taken to be the weights, and the threshold is
+set to 0.
+
+@ex[
+(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
+]}
+
 @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 dea9da9..a18ae8a 100644
--- a/tbn.rkt
+++ b/tbn.rkt
@@ -37,7 +37,7 @@
    group-truth-table-by-nai
 
    TBN sbn? tbn->network
-   parse-org-tbn read-org-tbn
+   parse-org-tbn read-org-tbn read-org-sbn
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -284,6 +284,43 @@
         'x1
         (tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
 
+  (: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
+  (define (read-org-sbn str
+                        #:headers [headers #t]
+                        #:func-names [func-names #t])
+    (define sexp (assert-type (read-org-sexp str)
+                              (Listof (Listof (U Symbol Real)))))
+    ;; Inject the 0 thresholds into the rows of the sexp we have just read.
+    (: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real)))))
+    (define (inject-0 rows)
+      (for/list : (Listof (Listof (U Symbol Real)))
+                ([row (in-list rows)]) (append row '(0))))
+    (define sexp-ready (if headers
+                           (cons (append (car sexp) '(θ)) (inject-0 (cdr sexp)))
+                           (inject-0 sexp)))
+    (parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
+
+  (module+ test
+    (test-case "read-org-sbn"
+      (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
+                    (hash
+                     'x
+                     (tbf/state '#hash((x . 0) (y . -1)) 0)
+                     'y
+                     (tbf/state '#hash((x . -1) (y . 0)) 0)))
+      (check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
+                    (hash
+                     'x
+                     (tbf/state '#hash((x . -1) (y . 0)) 0)
+                     'y
+                     (tbf/state '#hash((x . 0) (y . -1)) 0)))
+      (check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
+                    (hash
+                     'x0
+                     (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
+                     'x1
+                     (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
+
   (: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
   (define (tbfs/state->lists tbfs)
     (for/list ([tbf (in-list tbfs)])