Add sbn->lists.

This commit is contained in:
Sergiu Ivanov 2023-08-07 20:06:30 +02:00
parent 704221185b
commit aca3fb7868
2 changed files with 38 additions and 1 deletions

View file

@ -526,6 +526,19 @@ the first cell of the first column contains the symbol
'b (tbf/state (hash 'a -1) -1))) 'b (tbf/state (hash 'a -1) -1)))
]} ]}
@defproc[(sbn->lists [sbn TBN]
[#:headers headers Boolean #t]
[#:func-names func-names Boolean #t])
(Listof (Listof (U Symbol Real)))]{
Like @racket[tbn->lists], but does not show the thresholds—an
adaptation for printing SBNs.
@ex[
(sbn->lists (hash 'a (tbf/state (hash 'b 1) 0)
'b (tbf/state (hash 'a -1) 0)))
]}
@section{Miscellaneous utilities} @section{Miscellaneous utilities}
@defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))]) @defproc[(group-truth-table-by-nai [tt (Listof (Listof Integer))])

26
tbn.rkt
View file

@ -48,7 +48,7 @@
TBN sbn? tbn->network TBN sbn? tbn->network
build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn build-tbn-state-graph normalized-tbn? normalize-tbn compact-tbn
parse-org-tbn read-org-tbn read-org-sbn tbn->lists parse-org-tbn read-org-tbn read-org-sbn tbn->lists sbn->lists
) )
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One))) (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@ -639,6 +639,30 @@
'((a b θ) (0 1 0) (-1 0 -1))) '((a b θ) (0 1 0) (-1 0 -1)))
(check-equal? (tbn->lists tbn #:headers #f #:func-names #f) (check-equal? (tbn->lists tbn #:headers #f #:func-names #f)
'((0 1 0) (-1 0 -1))))) '((0 1 0) (-1 0 -1)))))
(: sbn->lists (->* (TBN) (#:headers Boolean
#:func-names Boolean)
(Listof (Listof (U Symbol Real)))))
(define (sbn->lists sbn
#:headers [headers #t]
#:func-names [func-names #t])
(define tab (tbn->lists sbn #:headers headers #:func-names func-names))
(define-values (tab-no-θ _)
(multi-split-at tab (sub1 (length (car tab)))))
tab-no-θ)
(module+ test
(test-case "sbn->lists"
(define sbn (hash 'a (tbf/state (hash 'b 2) 0)
'b (tbf/state (hash 'a 2) 0)))
(check-equal? (sbn->lists sbn)
'((- a b) (a 0 2) (b 2 0)))
(check-equal? (sbn->lists sbn #:headers #f)
'((a 0 2) (b 2 0)))
(check-equal? (sbn->lists sbn #:func-names #f)
'((a b) (0 2) (2 0)))
(check-equal? (sbn->lists sbn #:headers #f #:func-names #f)
'((0 2) (2 0)))))
) )
(module+ test (module+ test