diff --git a/example/example.org b/example/example.org index 8db76a6..f611355 100644 --- a/example/example.org +++ b/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)" diff --git a/networks.rkt b/networks.rkt index 6a34435..fa1025e 100644 --- a/networks.rkt +++ b/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?))