diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index 52b06d2..19d0a2f 100644 --- a/scribblings/tbn.scrbl +++ b/scribblings/tbn.scrbl @@ -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 diff --git a/tbn.rkt b/tbn.rkt index d86aaa4..40c1cfb 100644 --- a/tbn.rkt +++ b/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)])