functions: Add tbf-tabulate*.

This commit is contained in:
Sergiu Ivanov 2020-07-12 00:18:25 +02:00
parent 3dee3163f0
commit e11f20431f

View File

@ -37,6 +37,7 @@
[list->tbf (-> (cons/c number? (cons/c number? (listof number?))) tbf?)]
[read-tbfs (-> (listof (listof number?)) (listof tbf?))]
[read-org-tbfs (->* (string?) (#:headers boolean?) (listof tbf?))]
[tbf-tabulate* (-> (listof tbf?) (listof (listof (or/c 0 1))))]
[tbf-tabulate (-> tbf? (listof (listof (or/c 0 1))))]))
(module+ test
@ -319,6 +320,27 @@
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
;;; Tabulates a list of TBFs.
;;;
;;; The result is a list of lists describing the truth table of the
;;; given TBFs. The first elements of each line give the values of
;;; the inputs, while the last elements give the values of each the
;;; functions corresponding to the input.
;;;
;;; All the TBFs in tbfs must have the same number of inputs as the
;;; first TBF in the list. This function does not check this
;;; condition.
(define (tbf-tabulate* tbfs)
(define funcs (for/list ([tbf tbfs])
(λ in (apply-tbf tbf (list->vector in)))))
(define nvars (vector-length (tbf-w (car tbfs))))
(tabulate* funcs (make-list nvars '(0 1))))
(module+ test
(test-case "tbf-tabulate*"
(check-equal? (tbf-tabulate* (list (tbf #(2 2) 1) (tbf #(1 1) 1)))
'((0 0 0 0) (0 1 1 0) (1 0 1 0) (1 1 1 1)))))
;;; Tabulates a TBF.
(define (tbf-tabulate tbf)
(define ins (apply