networks: Add tbf/state-tabulate*.

This commit is contained in:
Sergiu Ivanov 2020-10-12 00:47:54 +02:00
parent 0987ce332a
commit f37155fd3e
2 changed files with 48 additions and 1 deletions

View file

@ -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)"

View file

@ -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?))