Type read-org-sbn.
This commit is contained in:
parent
8241bc4da5
commit
c523c68037
2 changed files with 51 additions and 1 deletions
|
@ -284,6 +284,19 @@ check this condition.
|
||||||
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
|
(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))]{
|
@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
|
Given a list of @racket[TBF/State], produces a sexp that Org-mode can
|
||||||
|
|
39
tbn.rkt
39
tbn.rkt
|
@ -37,7 +37,7 @@
|
||||||
group-truth-table-by-nai
|
group-truth-table-by-nai
|
||||||
|
|
||||||
TBN sbn? tbn->network
|
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)))
|
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
|
||||||
|
@ -284,6 +284,43 @@
|
||||||
'x1
|
'x1
|
||||||
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
|
(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))))
|
(: tbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real))))
|
||||||
(define (tbfs/state->lists tbfs)
|
(define (tbfs/state->lists tbfs)
|
||||||
(for/list ([tbf (in-list tbfs)])
|
(for/list ([tbf (in-list tbfs)])
|
||||||
|
|
Loading…
Add table
Reference in a new issue