Add tabulate-tbfs/state and tabulate-tbfs/state+headers.

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)))
+]}

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