diff --git a/example/example.org b/example/example.org index d5b2cde..8db76a6 100644 --- a/example/example.org +++ b/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)" diff --git a/networks.rkt b/networks.rkt index c465b72..5a2a797 100644 --- a/networks.rkt +++ b/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?))