From 2dd38fa4dc0be4a33c66f47ae13bd0177294755f Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Thu, 22 Oct 2020 00:59:58 +0200
Subject: [PATCH] networks: Add read-org-sbn.

---
 networks.rkt | 51 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 41 insertions(+), 10 deletions(-)

diff --git a/networks.rkt b/networks.rkt
index 5bafb46..b3243dd 100644
--- a/networks.rkt
+++ b/networks.rkt
@@ -112,6 +112,9 @@
                                    (#:headers boolean? #:func-names boolean?)
                                    tbn?)]
                [read-org-tbn (->* (string?)
+                                  (#:headers boolean? #:func-names boolean?)
+                                  tbn?)]
+               [read-org-sbn (->* (string?)
                                   (#:headers boolean? #:func-names boolean?)
                                   tbn?)])
  ;; Predicates
@@ -1415,23 +1418,51 @@
                    (tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
                    'x1
                    (tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
+
+;;; Like read-org-tbn, but reads an SBN from an Org-mode string
+;;; containing a sexp, containing a list of lists of numbers.
+;;;
+;;; As in read-org-sbfs/state, if headers is #t, the names of the
+;;; variables to appear as the inputs of the SBF are taken from the
+;;; first list.  The last element of this list is discarded.
+;;; If headers is #f, the names of the variables are generated as xi,
+;;; where i is the index of the variable.
+;;;
+;;; If func-names is #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 func-names is #f, the functions are
+;;; assigned to variables in alphabetical order.
+;;;
+;;; func-names cannot be #t if headers is #f.  The function does not
+;;; check this condition.
+(define (read-org-sbn str
+                      #:headers [headers #t]
+                      #:func-names [func-names #t])
+  (define sexp (read-org-sexp str))
+  ;; Inject the 0 thresholds into the rows of the sexp we have just read.
+  (define (inject-0 rows) (for/list ([row (in-list rows)]) (append row '(0))))
+  (define sexp-ready (if headers
+                         (cons (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-tbn"
-    (check-equal? (read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
+  (test-case "read-org-sbn, parse-org-tbn"
+    (check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
                   (hash
                    'x
-                   (tbf/state '#hash((x . 0) (y . -1)) -1)
+                   (tbf/state '#hash((x . 0) (y . -1)) 0)
                    'y
-                   (tbf/state '#hash((x . -1) (y . 0)) -1)))
-    (check-equal? (read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f)
+                   (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)) -1)
+                   (tbf/state '#hash((x . -1) (y . 0)) 0)
                    'y
-                   (tbf/state '#hash((x . 0) (y . -1)) -1)))
-    (check-equal? (read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f)
+                   (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)) -1)
+                   (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
                    'x1
-                   (tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
+                   (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))