Type tbf-tabulate*.

This commit is contained in:
Sergiu Ivanov 2022-04-24 23:25:10 +02:00
parent 70caf3bb7e
commit 8ded018c05
2 changed files with 32 additions and 24 deletions

View File

@ -30,7 +30,7 @@
random-boolean-table random-boolean-function random-boolean-function/list
(struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
list->tbf lists->tbfs read-org-tbfs)
list->tbf lists->tbfs read-org-tbfs tbf-tabulate*)
(module+ test
(require typed/rackunit))
@ -499,7 +499,21 @@
(module+ test
(test-case "read-org-tbfs"
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
(: tbf-tabulate* (-> (Listof tbf) (Listof (Listof (U Zero One)))))
(define (tbf-tabulate* tbfs)
(define funcs (for/list ([tbf tbfs])
: (Listof (-> (Listof (U Zero One)) (U Zero One)))
(λ ([in : (Listof (U Zero One))])
(apply-tbf tbf (list->vector in)))))
(define nvars (vector-length (tbf-w (car tbfs))))
(tabulate*/list 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)))))
(module untyped racket
(module+ test
@ -590,7 +604,7 @@
random-boolean-table random-boolean-function random-boolean-function/list
(struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
list->tbf lists->tbfs read-org-tbfs)
list->tbf lists->tbfs read-org-tbfs tbf-tabulate*)
(require (rename-in (submod 'typed untyped)
[tabulate tabulate/untyped]
@ -599,7 +613,6 @@
(provide
;; Functions
(contract-out
[tbf-tabulate* (-> (listof tbf?) (listof (listof (or/c 0 1))))]
[tbf-tabulate (-> tbf? (listof (listof (or/c 0 1))))]
[tbf-tabulate*/boolean (-> (listof tbf?) (listof (listof boolean?)))]
[sbf (-> (vectorof number?) tbf?)]
@ -617,26 +630,6 @@
;;; Threshold Boolean functions
;;; ===========================
;;; 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*/untyped 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 (compose tbf-tabulate* list))

View File

@ -524,6 +524,21 @@ The input is typically what @racket[read-org-sexp] reads.
(read-org-tbfs "((1 2 1) (1 0 1))")
]}
@defproc[(tbf-tabulate* [tbfs (Listof tbf)])
(Listof (Listof (U Zero One)))]{
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 @racket[tbfs] must have the same number of inputs as the first
TBF in the list.
@examples[#:eval functions-evaluator
(tbf-tabulate* (list (tbf #(2 2) 1) (tbf #(1 1) 1)))
]}
@section[#:tag "fuctions/untyped"]{Untyped definitions}