scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Type read-org-sbn.

This commit is contained in:
Sergiu Ivanov 2023-07-07 12:29:36 +02:00
parent 8241bc4da5
commit c523c68037
2 changed files with 51 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scribblings/tbn.scrbl
View File

@ -284,6 +284,19 @@ check this condition.
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
]}
@defproc[(read-org-sbn [str String]
[#:headers headers Boolean #t]
[#:func-names func-names Boolean #t])
TBN]{
Like @racket[read-org-tbn], but reads an SBN from the input string,
i.e. all the numbers are taken to be the weights, and the threshold is
set to 0.
@ex[
(read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
]}
@defproc[(tbfs/state->lists [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{
Given a list of @racket[TBF/State], produces a sexp that Org-mode can

39
tbn.rkt
View File

@ -37,7 +37,7 @@
group-truth-table-by-nai
TBN sbn? tbn->network
parse-org-tbn read-org-tbn
parse-org-tbn read-org-tbn read-org-sbn
)
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@ -284,6 +284,43 @@
'x1
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
(: read-org-sbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
(define (read-org-sbn str
#:headers [headers #t]
#:func-names [func-names #t])
(define sexp (assert-type (read-org-sexp str)
(Listof (Listof (U Symbol Real)))))
;; Inject the 0 thresholds into the rows of the sexp we have just read.
(: inject-0 (-> (Listof (Listof (U Symbol Real))) (Listof (Listof (U Symbol Real)))))
(define (inject-0 rows)
(for/list : (Listof (Listof (U Symbol Real)))
([row (in-list rows)]) (append row '(0))))
(define sexp-ready (if headers
(cons (append (car sexp) '(θ)) (inject-0 (cdr sexp)))
(inject-0 sexp)))
(parse-org-tbn sexp-ready #:headers headers #:func-names func-names))
(module+ test
(test-case "read-org-sbn"
(check-equal? (read-org-sbn "((\"-\" \"x\" \"y\") (\"y\" -1 0) (\"x\" 0 -1))")
(hash
'x
(tbf/state '#hash((x . 0) (y . -1)) 0)
'y
(tbf/state '#hash((x . -1) (y . 0)) 0)))
(check-equal? (read-org-sbn "((\"x\" \"y\") (-1 0) (0 -1))" #:func-names #f)
(hash
'x
(tbf/state '#hash((x . -1) (y . 0)) 0)
'y
(tbf/state '#hash((x . 0) (y . -1)) 0)))
(check-equal? (read-org-sbn "((-1 0) (0 -1))" #:headers #f #:func-names #f)
(hash
'x0
(tbf/state '#hash((x0 . -1) (x1 . 0)) 0)
'x1
(tbf/state '#hash((x0 . 0) (x1 . -1)) 0)))))
(: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
(define (tbfs/state->lists tbfs)
(for/list ([tbf (in-list tbfs)])