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))")
|
||||
]}
|
||||
|
||||
@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))]{
|
||||
|
||||
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
|
||||
|
||||
TBN sbn? tbn->network
|
||||
parse-org-tbn
|
||||
)
|
||||
|
||||
(: 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)
|
||||
(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))))
|
||||
(define (tbfs/state->lists tbfs)
|
||||
(for/list ([tbf (in-list tbfs)])
|
||||
|
|
Loading…
Reference in a new issue