networks: Add tbf/state-tabulate*.

example/example.org

@@ -955,6 +955,22 @@ tab
    All TBFs given to =print-org-tbfs/state= mush have exactly the same
    inputs.  This function does not check this property.
 
+   Here's how you can tabulate both of these TBFs in the same table
+   (e.g., to compare their truth tables):
+
+   #+BEGIN_SRC racket :results table drawer :var simple-tbfs/state=munch-sexp(simple-tbfs/state)
+(tbf/state-tabulate* (read-org-tbfs/state simple-tbfs/state))
+   #+END_SRC
+
+   #+RESULTS:
+   :results:
+   | a | b | f1 | f2 |
+   | 0 | 0 |  0 |  0 |
+   | 0 | 1 |  0 |  1 |
+   | 1 | 0 |  0 |  0 |
+   | 1 | 1 |  1 |  0 |
+   :end:
+
 * Reaction systems
   :PROPERTIES:
   :header-args:racket: :prologue "#lang racket\n(require graph dds/rs dds/utils)"

networks.rkt

@@ -89,7 +89,9 @@
                                        (listof tbf/state?))]
                [read-org-tbfs/state (->* (string?) (#:headers boolean?) (listof tbf/state?))]
                [print-org-tbfs/state (->* ((non-empty-listof tbf/state?)) (#:headers boolean?)
-       (listof (listof (or/c number? symbol?))))])
+                                          (listof (listof (or/c number? symbol?))))]
+               [tbf/state-tabulate* (->* ((non-empty-listof tbf/state?)) (#:headers boolean?)
+                                         (listof (listof (or/c symbol? number?))))])
  ;; Predicates
  (contract-out [variable? (-> any/c boolean?)]
                [state? (-> any/c boolean?)]
@@ -1085,6 +1087,35 @@
     (check-equal? (print-org-tbfs/state tbfs)
                   '((a b θ) (1 2 3) (-2 1 1)))))
 
+;;; Tabulates a list of tbf/state.
+;;;
+;;; As in the case of 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.
+;;;
+;;; If #:headers is #t, the output starts by a list giving the names
+;;; of the variables, and then the symbols 'fi, where i is the number
+;;; of the TBF in the list.
+(define (tbf/state-tabulate* tbfs #:headers [headers #t])
+  (define vars (hash-map (tbf/state-w (car tbfs)) (λ (x _) x) #t))
+  (tabulate-state* (map (curry apply-tbf/state) tbfs)
+                   (make-same-domains vars '(0 1))
+                   #:headers headers))
+
+(module+ test
+  (test-case "tbf/state-tabulate*"
+    (define tbfs (list (make-tbf/state '((a . 1) (b . 2)) 1)
+                       (make-tbf/state '((a . -2) (b . 3)) 1)))
+    (check-equal? (tbf/state-tabulate* tbfs)
+                  '((a b f1 f2)
+                    (0 0 0 0)
+                    (0 1 1 1)
+                    (1 0 0 0)
+                    (1 1 1 0)))))
 
 ;;; A TBN is a network form mapping TBFs to variables.
 (define tbn? (hash/c variable? tbf?))