Type parse-org-tbn.
This commit is contained in:
parent
afbc5426ce
commit
0c91e6f6b2
2 changed files with 73 additions and 0 deletions
|
@ -217,6 +217,40 @@ is taken to contain the names of the variables, similarly to
|
||||||
(read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
|
(read-org-tbfs/state+headers "((a b f) (1 2 3) (1 1 2))")
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(parse-org-tbn [tab (Listof (Listof (U Symbol Real)))]
|
||||||
|
[#:headers headers Boolean #t]
|
||||||
|
[#:func-names func-names Boolean #t])
|
||||||
|
TBN]{
|
||||||
|
|
||||||
|
Reads a TBN from a list of lists of numbers or symbols, which may
|
||||||
|
represent an Org-mode table. As in @racket[lists->tbfs/state], the
|
||||||
|
last element of each list is taken to be the threshold of the TBF, and
|
||||||
|
the rest of the elements are taken to be the weights.
|
||||||
|
|
||||||
|
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 (corresponding to the column giving the
|
||||||
|
threshold) 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 lexicographic order.
|
||||||
|
|
||||||
|
@racket[func-names] cannot be @racket[#t] if @racket[headers] is
|
||||||
|
@racket[#f]. The function does not check this condition.
|
||||||
|
|
||||||
|
This is a helper function for @racket[read-org-tbn] and
|
||||||
|
@racket[read-org-sbn].
|
||||||
|
|
||||||
|
@ex[
|
||||||
|
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||||
|
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||||
|
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3)) #:headers #t #:func-names #t)
|
||||||
|
]}
|
||||||
|
|
||||||
@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,6 +37,7 @@
|
||||||
group-truth-table-by-nai
|
group-truth-table-by-nai
|
||||||
|
|
||||||
TBN sbn? tbn->network
|
TBN sbn? tbn->network
|
||||||
|
parse-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)))
|
||||||
|
@ -212,6 +213,44 @@
|
||||||
(list (tbf/state '#hash((a . 1) (b . 2)) 3)
|
(list (tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||||
(tbf/state '#hash((a . 1) (b . 1)) 2)))))
|
(tbf/state '#hash((a . 1) (b . 1)) 2)))))
|
||||||
|
|
||||||
|
(: parse-org-tbn (->* ((Listof (Listof (U Symbol Real))))
|
||||||
|
(#:headers Boolean
|
||||||
|
#:func-names Boolean)
|
||||||
|
TBN))
|
||||||
|
(define (parse-org-tbn tab #:headers [headers #t] #:func-names [func-names #t])
|
||||||
|
(cond [func-names
|
||||||
|
(define-values (vars rows) (multi-split-at tab 1))
|
||||||
|
(define tbfs (lists->tbfs/state/opt-headers rows #:headers headers))
|
||||||
|
(for/hash : TBN
|
||||||
|
([tbf (in-list tbfs)]
|
||||||
|
[var (in-list (cdr vars))])
|
||||||
|
(values (assert-type (car var) Variable) tbf))]
|
||||||
|
[else
|
||||||
|
(define tbfs (lists->tbfs/state/opt-headers tab #:headers headers))
|
||||||
|
(define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
|
||||||
|
(for/hash : TBN ([tbf (in-list tbfs)] [var (in-list vars)])
|
||||||
|
(values (assert-type var Variable) tbf))]))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test-case "parse-org-tbn"
|
||||||
|
(check-equal?
|
||||||
|
(parse-org-tbn '((1 2 3) (3 2 1)) #:headers #f #:func-names #f)
|
||||||
|
(hash 'x0 (tbf/state '#hash((x0 . 1) (x1 . 2)) 3)
|
||||||
|
'x1 (tbf/state '#hash((x0 . 3) (x1 . 2)) 1)))
|
||||||
|
(check-equal?
|
||||||
|
(parse-org-tbn '((a b θ) (1 2 3) (3 2 1)) #:headers #t #:func-names #f)
|
||||||
|
(hash
|
||||||
|
'a
|
||||||
|
(tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||||
|
'b
|
||||||
|
(tbf/state '#hash((a . 3) (b . 2)) 1)))
|
||||||
|
(check-equal?
|
||||||
|
(parse-org-tbn '((dummy a b θ) (b 3 2 1) (a 1 2 3))
|
||||||
|
#:headers #t
|
||||||
|
#:func-names #t)
|
||||||
|
(hash 'a (tbf/state '#hash((a . 1) (b . 2)) 3)
|
||||||
|
'b (tbf/state '#hash((a . 3) (b . 2)) 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)])
|
||||||
|
|
Loading…
Reference in a new issue