Add table->function/list.
This commit is contained in:
parent
1503434306
commit
3b51a4ba51
2 changed files with 40 additions and 17 deletions
|
@ -18,7 +18,8 @@
|
||||||
(provide
|
(provide
|
||||||
pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
|
pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
|
||||||
tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv
|
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
|
(module+ test
|
||||||
(require typed/rackunit))
|
(require typed/rackunit))
|
||||||
|
@ -190,6 +191,21 @@
|
||||||
,(pvλ (x y) (cast (max x y) (U Zero One)))))
|
,(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)))))
|
'((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 untyped racket
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit))
|
(require rackunit))
|
||||||
|
@ -270,7 +286,8 @@
|
||||||
tabulate* tabulate*/strict tabulate*/pv
|
tabulate* tabulate*/strict tabulate*/pv
|
||||||
tabulate tabulate/strict tabulate/pv
|
tabulate tabulate/strict tabulate/pv
|
||||||
tabulate*/pv/boolean tabulate/pv/boolean
|
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)
|
(require (rename-in (submod 'typed untyped)
|
||||||
[tabulate tabulate/untyped]
|
[tabulate tabulate/untyped]
|
||||||
|
@ -283,7 +300,6 @@
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out
|
(contract-out
|
||||||
[table->function (-> (listof (*list/c any/c any/c)) procedure?)]
|
[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-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
|
||||||
[enumerate-boolean-functions (-> number? (stream/c procedure?))]
|
[enumerate-boolean-functions (-> number? (stream/c procedure?))]
|
||||||
[enumerate-boolean-functions/list (-> number? (stream/c procedure?))]
|
[enumerate-boolean-functions/list (-> number? (stream/c procedure?))]
|
||||||
|
@ -338,20 +354,6 @@
|
||||||
(check-true (negation #f))
|
(check-true (negation #f))
|
||||||
(check-false (negation #t))))
|
(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
|
;;; Returns the stream of the truth tables of all Boolean functions of
|
||||||
;;; a given arity.
|
;;; a given arity.
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -240,6 +240,27 @@ Like @racket[tabulate/pv/01], but takes a list of functions of the same arity.
|
||||||
|
|
||||||
@section{Constructing functions}
|
@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{Random functions}
|
||||||
|
|
||||||
@section{Threshold Boolean functions}
|
@section{Threshold Boolean functions}
|
||||||
|
|
Loading…
Reference in a new issue