Type read-org-tbn.

This commit is contained in:
Sergiu Ivanov 2023-07-07 11:44:06 +02:00
parent 0c91e6f6b2
commit 8241bc4da5
2 changed files with 67 additions and 1 deletions

View file

@ -251,6 +251,39 @@ This is a helper function for @racket[read-org-tbn] and
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t) (parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
]} ]}
@defproc[(read-org-tbn [str String]
[#:headers headers Boolean #t]
[#:func-names func-names Boolean #t])
TBN]{
Reads a TBN from an string containing a sexp, containing a list of
lists of numbers and possibly symbols. This string may be produced by
Org-mode.
As in @racket[lists->tbfs/state], the last element of each list is
taken to be the threshold of the TBFs, and the rest of the elements
are taken to be the weights.
As in @racket[parse-org-tbn], if @racket[headers] is @racket[#t], the
names of the variables to appear as the inputs of the TBF are taken
from the first list. The last element of this list is discarded.
If @racket[headers] is @racket[#f], the names of the variables are
generated as @tt{xi}, where @tt{i} is the index of the variable.
If @racket[func-names] is @racket[#t], the first element in every row
except the first one, are taken to be the name of the variable to
which the TBF should be associated. If @racket[func-names] is
@racket[#f], the functions are assigned to variables in
alphabetical order.
As in @racket[parse-org-tbn], @racket[func-names] cannot be
@racket[#t] if @racket[headers] is @racket[#f]. The function does not
check this condition.
@ex[
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -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

35
tbn.rkt
View file

@ -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 parse-org-tbn read-org-tbn
) )
(: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One))) (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One)))
@ -251,6 +251,39 @@
(hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3) (hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
'b (tbf/state '#hash((a . 3) (b . 2)) 1))))) 'b (tbf/state '#hash((a . 3) (b . 2)) 1)))))
(: read-org-tbn (->* (String) (#:headers Boolean #:func-names Boolean) TBN))
(define (read-org-tbn str
#:headers [headers #t]
#:func-names [func-names #t])
(parse-org-tbn (assert-type (read-org-sexp str)
(Listof (Listof (U Symbol Real))))
#:headers headers
#:func-names func-names))
(module+ test
(test-case "read-org-tbn"
(check-equal?
(read-org-tbn "((\"-\" \"x\" \"y\" \"θ\") (\"y\" -1 0 -1) (\"x\" 0 -1 -1))")
(hash
'x
(tbf/state '#hash((x . 0) (y . -1)) -1)
'y
(tbf/state '#hash((x . -1) (y . 0)) -1)))
(check-equal?
(read-org-tbn "((\"x\" \"y\" \"θ\") (-1 0 -1) (0 -1 -1))" #:func-names #f)
(hash
'x
(tbf/state '#hash((x . -1) (y . 0)) -1)
'y
(tbf/state '#hash((x . 0) (y . -1)) -1)))
(check-equal?
(read-org-tbn "((-1 0 -1) (0 -1 -1))" #:headers #f #:func-names #f)
(hash
'x0
(tbf/state '#hash((x0 . -1) (x1 . 0)) -1)
'x1
(tbf/state '#hash((x0 . 0) (x1 . -1)) -1)))))
(: 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)])