Type tbn->lists.

scribblings/tbn.scrbl

@@ -499,6 +499,33 @@ set to 0.
 (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
 ]}
 
+@defproc[(tbn->lists [tbn TBN]
+		     [#:headers headers Boolean #t]
+		     [#:func-names func-names Boolean #t])
+		     (Listof (Listof (U Symbol Real)))]{
+
+Given a @racket[tbn], produces a list of lists of numbers or symbols,
+containing the description of the functions of the TBN.  This list can
+be read back by @racket[parse-org-tbn], and Org-mode can interpret it
+as a table.
+
+Similarly to @racket[parse-org-tbn], if @racket[#:headers] is
+@racket[#f], this function does not print the names of the inputs of
+the TBFs.  If @racket[#:headers] is @racket[#t], the output starts by
+a list giving the names of the variables, as well as the symbol
+@racket['θ] to represent the column giving the thresholds of the TBF.
+If @racket[#:func-names] is @racket[#t], the first column of the table
+gives the name of the variable which the corresponding TBF updates.
+
+If both @racket[#:func-names] and @racket[#:headers] are @racket[#t],
+the first cell of the first column contains the symbol
+@racket['-].
+
+@ex[
+(tbn->lists (hash 'a (tbf/state (hash 'b 1) 0)
+                  'b (tbf/state (hash 'a -1) -1)))
+]}
+
 @section{Miscellaneous utilities}
 
 @defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])

tbn.rkt

@@ -48,7 +48,7 @@
 
    TBN sbn? tbn->network
    build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
-   parse-org-tbn read-org-tbn read-org-sbn
+   parse-org-tbn read-org-tbn read-org-sbn tbn->lists
    )
 
   (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@@ -604,6 +604,41 @@
                      (tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
                      'x1
                      (tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
+
+  (: tbn->lists (->* (TBN) (#:headers Boolean
+                            #:func-names Boolean)
+                     (Listof (Listof (U Symbol Real)))))
+  (define (tbn->lists tbn
+                      #:headers [headers #t]
+                      #:func-names [func-names #t])
+    (define ntbn (normalize-tbn tbn))
+    (define vars-tbfs (hash-map ntbn (λ ([x : Variable] [tbf : TBF/State])
+                                       (cons x tbf)) #t))
+    (define tbfs (map (inst cdr Variable TBF/State) vars-tbfs))
+    (define tbfs-table ((if headers
+                            tbfs/state->lists+headers
+                            tbfs/state->lists) tbfs))
+    (cond
+      [(eq? func-names #t)
+       (define vars (map (inst car Variable TBF/State) vars-tbfs))
+       (define col-1 (if headers (cons '- vars) vars))
+       (for/list ([var (in-list col-1)] [row (in-list tbfs-table)])
+         (cons var row))]
+      [else
+       tbfs-table]))
+
+  (module+ test
+    (test-case "tbn->lists"
+      (define tbn (hash 'a (tbf/state (hash 'b 1) 0)
+                        'b (tbf/state (hash 'a -1) -1)))
+      (check-equal? (tbn->lists tbn)
+                    '((- a b θ) (a 0 1 0) (b -1 0 -1)))
+      (check-equal? (tbn->lists tbn #:headers #f)
+                    '((a 0 1 0) (b -1 0 -1)))
+      (check-equal? (tbn->lists tbn #:func-names #f)
+                    '((a b θ) (0 1 0) (-1 0 -1)))
+      (check-equal? (tbn->lists tbn #:headers #f #:func-names #f)
+                    '((0 1 0) (-1 0 -1)))))
   )
 
 (module+ test