networks: Add print-org-sbn.
This commit is contained in:
parent
ed44d3666c
commit
79d3ab1ea6
1 changed files with 33 additions and 0 deletions
33
networks.rkt
33
networks.rkt
|
@ -124,6 +124,8 @@
|
||||||
[compact-tbf (-> tbf/state? tbf/state?)]
|
[compact-tbf (-> tbf/state? tbf/state?)]
|
||||||
[compact-tbn (-> tbn? tbn?)]
|
[compact-tbn (-> tbn? tbn?)]
|
||||||
[print-org-tbn (->* (tbn?) (#:headers boolean? #:func-names boolean?)
|
[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?))))])
|
(listof (listof (or/c number? symbol?))))])
|
||||||
;; Predicates
|
;; Predicates
|
||||||
(contract-out [variable? (-> any/c boolean?)]
|
(contract-out [variable? (-> any/c boolean?)]
|
||||||
|
@ -1599,3 +1601,34 @@
|
||||||
(b . ,(make-tbf/state '((a . -1)) -1)))))
|
(b . ,(make-tbf/state '((a . -1)) -1)))))
|
||||||
(check-equal? (print-org-tbn tbn)
|
(check-equal? (print-org-tbn tbn)
|
||||||
'((- a b θ) (a 0 1 0) (b -1 0 -1)))))
|
'((- 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)))
|
||||||
|
|
Loading…
Reference in a new issue