diff --git a/scribblings/tbn.scrbl b/scribblings/tbn.scrbl index 9ce2259..cfeaf79 100644 --- a/scribblings/tbn.scrbl +++ b/scribblings/tbn.scrbl @@ -227,3 +227,39 @@ corresponds to the column giving the thresholds of the TBFs. (list (tbf/state (hash 'a 1 'b 2) 3) (tbf/state (hash 'a -2 'b 1) 1))) ]} + +@section{Tabulating TBFs and SBFs} + +@defproc[(tabulate-tbfs/state [tbfs (Listof TBF/State)]) (Listof (Listof Real))]{ + +Tabulates a list of @racket[TBF/State]. + +As in the case of @racket[tbf-tabulate*], the result is a list of +lists giving the truth tables of the given TBFs. The first elements +of each row give the values of the inputs, while the last elements +give the values of each function corresponding to the input. + +All the TBFs must have exactly the same inputs. This function does +not check this property. + +@ex[ +(tabulate-tbfs/state + (list (tbf/state (hash 'a 1 'b 2) 2) + (tbf/state (hash 'a -2 'b 2) 1))) +]} + +@defproc[(tabulate-tbfs/state+headers [tbfs (Listof TBF/State)]) + (Pairof (Listof Variable) + (Listof (Listof Real)))]{ + +Like @racket[tabulate-tbfs/state], but the first list of the result is +a gives the names of the variables appearing in the inputs of +@racket[(car tbfs)], followed by function names. The function names +are generated as @tt{fi}, where @tt{i} is the number of the TBF in +the list. + +@ex[ +(tabulate-tbfs/state+headers + (list (tbf/state (hash 'a 1 'b 2) 2) + (tbf/state (hash 'a -2 'b 2) 1))) +]} diff --git a/tbn.rkt b/tbn.rkt index 85f56a2..026c6a8 100644 --- a/tbn.rkt +++ b/tbn.rkt @@ -29,6 +29,8 @@ lists+vars->sbfs/state lists+headers->sbfs/state lists->sbfs/state read-org-tbfs/state read-org-tbfs/state+headers tbfs/state->lists tbfs/state->lists+headers + + tabulate-tbfs/state tabulate-tbfs/state+headers ) (: apply-tbf-to-state (-> TBF (State (U Zero One)) (U Zero One))) @@ -213,6 +215,53 @@ '((a b θ) (1 2 3) (-2 1 1))))) + + (: sbfs/state->lists (-> (Listof TBF/State) (Listof (Listof Real)))) + (define (sbfs/state->lists tbfs) + (for/list ([tbf (in-list tbfs)]) + (append (hash-map (tbf/state-w tbf) (λ (_ [w : Real]) w) #t) + (list (tbf/state-θ tbf))))) + + (module+ test + (test-case "tbfs/state->lists" + (check-equal? + (tbfs/state->lists (list (tbf/state (hash 'a 1 'b 2) 3) + (tbf/state (hash 'a -2 'b 1) 1))) + '((1 2 3) (-2 1 1))))) + + (: tabulate-tbfs/state (-> (Listof TBF/State) (Listof (Listof Real)))) + (define (tabulate-tbfs/state tbfs) + (define vars (hash-map (tbf/state-w (car tbfs)) (λ ([x : Variable] _) x) #t)) + (tabulate-state* (map (curry apply-tbf/state) tbfs) + (make-same-domains vars '(0 1)))) + + (module+ test + (test-case "tabulate-tbfs/state" + (check-equal? (tabulate-tbfs/state + (list (tbf/state (hash 'a 1 'b 2) 2) + (tbf/state (hash 'a -2 'b 2) 1))) + '((0 0 0 0) + (0 1 0 1) + (1 0 0 0) + (1 1 1 0))))) + + (: tabulate-tbfs/state+headers (-> (Listof TBF/State) (Pairof (Listof Variable) + (Listof (Listof Real))))) + (define (tabulate-tbfs/state+headers tbfs) + (define vars (hash-map (tbf/state-w (car tbfs)) (λ ([x : Variable] _) x) #t)) + (tabulate-state*+headers (map (curry apply-tbf/state) tbfs) + (make-same-domains vars '(0 1)))) + + (module+ test + (test-case "tabulate-tbfs/state+headers" + (check-equal? (tabulate-tbfs/state+headers + (list (tbf/state (hash 'a 1 'b 2) 2) + (tbf/state (hash 'a -2 'b 2) 1))) + '((a b f1 f2) + (0 0 0 0) + (0 1 0 1) + (1 0 0 0) + (1 1 1 0))))) ) (module+ test