diff --git a/networks.rkt b/networks.rkt index cd19b9f..7a29777 100644 --- a/networks.rkt +++ b/networks.rkt @@ -122,7 +122,9 @@ [normalized-tbn? (-> tbn? boolean?)] [normalize-tbn (-> tbn? normalized-tbn?)] [compact-tbf (-> tbf/state? tbf/state?)] - [compact-tbn (-> tbn? tbn?)]) + [compact-tbn (-> tbn? tbn?)] + [print-org-tbn (->* (tbn?) (#:headers boolean? #:func-names boolean?) + (listof (listof (or/c number? symbol?))))]) ;; Predicates (contract-out [variable? (-> any/c boolean?)] [state? (-> any/c boolean?)] @@ -1560,3 +1562,39 @@ (tbf/state '#hash((b . 1)) 0) 'b (tbf/state '#hash((a . -1) (b . 1)) -1))))) + +;;; Given TBN, produces a sexp containing the description of the +;;; functions of the TBN that Org-mode can interpret as a table. +;;; +;;; Like print-org-tbfs/state, 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. +;;; +;;; If #:func-names is #t, the first column of the table gives the +;;; variable which the corresponding TBF updates. +;;; +;;; If both #:func-names and #:headers are #t, the first cell of the +;;; first column contains the symbol '-. +(define (print-org-tbn tbn + #:headers [headers #t] + #:func-names [func-names #t]) + (define ntbn (normalize-tbn tbn)) + (define vars-tbfs (hash-map ntbn (λ (x tbf) (cons x tbf)) #t)) + (define tbfs (map cdr vars-tbfs)) + (define tbfs-table (print-org-tbfs/state tbfs #:headers headers)) + (cond + [(eq? func-names #t) + (define vars (map car 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 "print-org-tbn" + (define tbn (make-tbn `((a . ,(make-sbf/state '((b . 1)))) + (b . ,(make-tbf/state '((a . -1)) -1))))) + (print-org-tbn tbn)))