networks: Add print-org-sbn.

This commit is contained in:
Sergiu Ivanov 2020-11-04 00:06:48 +01:00
parent ed44d3666c
commit 79d3ab1ea6

View File

@ -124,6 +124,8 @@
[compact-tbf (-> tbf/state? tbf/state?)]
[compact-tbn (-> tbn? tbn?)]
[print-org-tbn (->* (tbn?) (#:headers boolean? #:func-names boolean?)
(listof (listof (or/c number? symbol?))))]
[print-org-sbn (->* (sbn?) (#:headers boolean? #:func-names boolean?)
(listof (listof (or/c number? symbol?))))])
;; Predicates
(contract-out [variable? (-> any/c boolean?)]
@ -1599,3 +1601,34 @@
(b . ,(make-tbf/state '((a . -1)) -1)))))
(check-equal? (print-org-tbn tbn)
'((- a b θ) (a 0 1 0) (b -1 0 -1)))))
;;; Given an SBN, produces a sexp containing the description of the
;;; functions of the SBN that Org-mode can interpret as a table.
;;; This function is therefore very similar to print-org-tbn.
;;;
;;; 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.
;;;
;;; 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-sbn sbn
#:headers [headers #t]
#:func-names [func-names #t])
(define tab (print-org-tbn sbn #:headers headers #:func-names func-names))
(define-values (tab-no-θ _) (multi-split-at
tab
(- (length (car tab)) 1)))
tab-no-θ)
(module+ test
(test-case "print-org-sbn"
(define sbn (hash
'a
(tbf/state (hash 'b 2) 0)
'b
(tbf/state (hash 'a 2) 0)))
(print-org-sbn sbn)))