diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index c2ce140..6c7022b 100644 --- a/scribblings/tbn.scrbl +++ b/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))]) diff --git a/tbn.rkt b/tbn.rkt index 5e253de..a0debc6 100644 --- a/tbn.rkt +++ b/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