diff --git a/functions.rkt b/functions.rkt index a95c27b..f646ba3 100644 --- a/functions.rkt +++ b/functions.rkt @@ -18,7 +18,8 @@ (provide pseudovariadic-lambda pvλ pseudovariadic-define pvdefine tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv - tabulate*/pv/boolean tabulate/pv/boolean tabulate*/pv/01 tabulate/pv/01) + tabulate*/pv/boolean tabulate/pv/boolean tabulate*/pv/01 tabulate/pv/01 + table->function/list) (module+ test (require typed/rackunit)) @@ -190,6 +191,21 @@ ,(pvλ (x y) (cast (max x y) (U Zero One))))) '((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1))))) + (: table->function/list (All (a) (-> (Listof (Listof a)) + (-> (Listof a) a)))) + (define (table->function/list table) + (define ht-tab + (for/hash ([line (in-list table)]) : (HashTable (Listof a) a) + (define-values (x fx) (split-at-right line 1)) + (values x (car fx)))) + (λ (x) (hash-ref ht-tab x))) + + (module+ test + (test-case "table->function/list" + (define negation/list (table->function/list '((#t #f) (#f #t)))) + (check-true (negation/list '(#f))) + (check-false (negation/list '(#t))))) + (module untyped racket (module+ test (require rackunit)) @@ -270,7 +286,8 @@ tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv tabulate*/pv/boolean tabulate/pv/boolean - tabulate*/pv/01 tabulate/pv/01) + tabulate*/pv/01 tabulate/pv/01 + table->function/list) (require (rename-in (submod 'typed untyped) [tabulate tabulate/untyped] @@ -283,7 +300,6 @@ ;; Functions (contract-out [table->function (-> (listof (*list/c any/c any/c)) procedure?)] - [table->function/list (-> (listof (*list/c any/c any/c)) procedure?)] [enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))] [enumerate-boolean-functions (-> number? (stream/c procedure?))] [enumerate-boolean-functions/list (-> number? (stream/c procedure?))] @@ -338,20 +354,6 @@ (check-true (negation #f)) (check-false (negation #t)))) -;;; Like table->function, but the produced function accepts a single -;;; list of arguments instead of individual arguments. -(define (table->function/list table) - ((curry hash-ref) - (for/hash ([line table]) - (let-values ([(x fx) (split-at-right line 1)]) - (values x (car fx)))))) - -(module+ test - (test-case "table->function/list" - (define negation/list (table->function/list '((#t #f) (#f #t)))) - (check-true (negation/list '(#f))) - (check-false (negation/list '(#t))))) - ;;; Returns the stream of the truth tables of all Boolean functions of ;;; a given arity. ;;; diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index 1f993fc..78dc926 100644 --- a/scribblings/functions.scrbl +++ b/scribblings/functions.scrbl @@ -240,6 +240,27 @@ Like @racket[tabulate/pv/01], but takes a list of functions of the same arity. @section{Constructing functions} +@defproc[(table->function/list [table (Listof (Listof a))]) + (-> (Listof a) a)]{ + +Given a table like the one produced by the functions of the @racket[tabulate] +family, creates a function which has this behaviour. + +More precisely, given a line of @racket[table] without its last element, the +function returned by @racket[table->function/list] produces the corresponding +last element. + +@examples[#:eval functions-evaluator +(define tab : (Listof (Listof Boolean)) + '((#f #f #f) + (#f #t #f) + (#t #f #f) + (#t #t #t))) +(define and/list (table->function/list tab)) +(and/list '(#f #t)) +(and/list '(#t #t)) +]} + @section{Random functions} @section{Threshold Boolean functions}