diff --git a/functions.rkt b/functions.rkt index 8739b75..de6df99 100644 --- a/functions.rkt +++ b/functions.rkt @@ -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)) diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index 018f26b..e8630ed 100644 --- a/scribblings/functions.scrbl +++ b/scribblings/functions.scrbl @@ -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}