Type parse-org-tbn.

This commit is contained in:
Sergiu Ivanov 2023-07-06 11:44:49 +02:00
parent afbc5426ce
commit 0c91e6f6b2
2 changed files with 73 additions and 0 deletions

View File

@ -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
View File

@ -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)])