networks: Add print-org-tbfs/state.

example/example.org

@@ -939,6 +939,22 @@ tab
    (list (tbf/state '#hash((a . 1) (b . 1)) 1) (tbf/state '#hash((a . -2) (b . 1)) 0))
    :end:
 
+   You can print a list of TBFs in the following way:
+
+   #+BEGIN_SRC racket :results table drawer :var simple-tbfs/state=munch-sexp(simple-tbfs/state)
+(print-org-tbfs/state (read-org-tbfs/state simple-tbfs/state))
+   #+END_SRC
+
+   #+RESULTS:
+   :results:
+   |  a | b | θ |
+   |  1 | 1 | 1 |
+   | -2 | 1 | 0 |
+   :end:
+
+   All TBFs given to =print-org-tbfs/state= mush have exactly the same
+   inputs.  This function does not check this property.
+
 * Reaction systems
   :PROPERTIES:
   :header-args:racket: :prologue "#lang racket\n(require graph dds/rs dds/utils)"

networks.rkt

@@ -87,7 +87,9 @@
                [lists->tbfs/state (->* ((listof (listof (or/c number? symbol?))))
                                        (#:headers boolean?)
                                        (listof tbf/state?))]
-               [read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))])
+               [read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))]
+               [print-org-tbfs/state (->* ((non-empty-listof tbf/state?)) (#:headers boolean?)
+       (listof (listof (or/c number? symbol?))))])
  ;; Predicates
  (contract-out [variable? (-> any/c boolean?)]
                [state? (-> any/c boolean?)]
@@ -1055,5 +1057,32 @@
                    (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
                    (tbf/state '#hash((x0 . 1) (x1 . 1)) 2)))))
 
+;;; Given a list of tbf/state, produces a sexp that Org-mode can
+;;; interpret as a table.
+;;;
+;;; All tbf/state in the list must have the same inputs.  The function
+;;; does not check this property.
+;;;
+;;; If #:headers is #f, does not print the names of the inputs of the
+;;; TBFs.  If #:headers is #t, the output starts by a list giving the
+;;; names of the variables, as well as the symbol 'θ to represent the
+;;; column giving the thresholds of the TBF.
+(define (print-org-tbfs/state tbfs #:headers [headers #t])
+
+  (define table (for/list ([tbf (in-list tbfs)])
+                  (append (hash-map (tbf/state-w tbf) (λ (_ w) w) #t)
+                          (list (tbf/state-θ tbf)))))
+  (append
+   (if headers
+       (list (append (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t) '(θ)))
+       (empty))
+   table))
+
+(module+ test
+  (test-case "print-org-tbfs/state"
+    (define tbfs (list (make-tbf/state '((a . 1) (b . 2)) 3)
+                       (make-tbf/state '((a . -2) (b . 1)) 1)))
+    (print-org-tbfs/state tbfs)))
+
 ;;; A TBN is a network form mapping TBFs to variables.
 (define tbn? (hash/c variable? tbf?))