Add tabulate, tabulate/strict, and tabulate/untyped.

This commit is contained in:
Sergiu Ivanov 2022-03-06 23:39:51 +01:00
parent fcf21c51aa
commit e7616684f5
2 changed files with 82 additions and 18 deletions

View file

@ -15,10 +15,11 @@
(for-syntax syntax/parse)) (for-syntax syntax/parse))
(provide (provide
tabulate* tabulate*/strict) tabulate* tabulate*/strict tabulate tabulate/strict)
(unsafe-provide (unsafe-provide
(rename-out [tabulate* tabulate*/untyped])) (rename-out [tabulate* tabulate*/untyped]
[tabulate tabulate/untyped]))
(module+ test (module+ test
(require typed/rackunit)) (require typed/rackunit))
@ -56,11 +57,32 @@
(λ (x y) (or x y))) (λ (x y) (or x y)))
'((#f #t) (#f #t))) '((#f #t) (#f #t)))
'(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t)))))) '(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t))))))
(: tabulate (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
(Listof (Listof (U Any b))))))
(define (tabulate func doms)
(tabulate* (list func) doms))
(module+ test
(test-case "tabulate"
(check-equal? (tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
(: tabulate/strict (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
(Listof (List (List a ...) (Listof b))))))
(define (tabulate/strict func doms)
(tabulate*/strict (list func) doms))
(module+ test
(test-case "tabulate/strict"
(check-equal? (tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t)))
'(((#f #f) (#f)) ((#f #t) (#f)) ((#t #f) (#f)) ((#t #t) (#t))))))
) )
(require 'typed) (require 'typed)
(provide (provide
tabulate* tabulate*/strict tabulate*/untyped) tabulate* tabulate*/strict tabulate*/untyped tabulate tabulate/strict
tabulate/untyped)
(provide (provide
@ -69,7 +91,6 @@
[struct tbf ((weights (vectorof number?)) (threshold number?))]) [struct tbf ((weights (vectorof number?)) (threshold number?))])
;; Functions ;; Functions
(contract-out (contract-out
[tabulate (-> procedure? (listof generic-set?) (listof list?))]
[tabulate/boolean (-> procedure? (listof (listof boolean?)))] [tabulate/boolean (-> procedure? (listof (listof boolean?)))]
[tabulate*/boolean (-> (non-empty-listof procedure?) (listof (listof boolean?)))] [tabulate*/boolean (-> (non-empty-listof procedure?) (listof (listof boolean?)))]
[tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))] [tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
@ -108,23 +129,11 @@
;;; Tabulating ;;; Tabulating
;;; ========== ;;; ==========
;;; Given a function and a list of domains for each of its arguments,
;;; in order, produces a list of lists giving the values of arguments
;;; and the value of the functions for these inputs.
(define (tabulate func doms)
(tabulate*/untyped `(,func) doms))
(module+ test
(test-case "tabulate"
(check-equal? (tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
;;; Like tabulate, but assumes the domains of all variables of the ;;; Like tabulate, but assumes the domains of all variables of the
;;; function are Boolean. func must have a fixed arity. It is an ;;; function are Boolean. func must have a fixed arity. It is an
;;; error to supply a function of variable arity. ;;; error to supply a function of variable arity.
(define (tabulate/boolean func) (define (tabulate/boolean func)
(tabulate func (make-list (procedure-arity func) '(#f #t)))) (tabulate/untyped func (make-list (procedure-arity func) '(#f #t))))
(module+ test (module+ test
(test-case "tabulate/boolean" (test-case "tabulate/boolean"
@ -147,7 +156,7 @@
;;; function are {0, 1}. func must have a fixed arity. It is an ;;; function are {0, 1}. func must have a fixed arity. It is an
;;; error to supply a function of variable arity. ;;; error to supply a function of variable arity.
(define (tabulate/01 func) (define (tabulate/01 func)
(tabulate func (make-list (procedure-arity func) '(0 1)))) (tabulate/untyped func (make-list (procedure-arity func) '(0 1))))
(module+ test (module+ test
(test-case "tabulate/01" (test-case "tabulate/01"

View file

@ -20,6 +20,61 @@ Boolean functions, etc.).
@section{Tabulating functions} @section{Tabulating functions}
@defproc[(tabulate [func (-> a ... b)]
[doms (List (Listof a) ... a)])
(Listof (Listof (U Any b)))]{
Given a function @racket[func] and a list of domains @racket[doms] for each of
its arguments, in order, produces a list of lists giving the values of
arguments and the value of the functions for these inputs.
@examples[#:eval functions-evaluator
(tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
]}
@defproc[(tabulate/strict [func (-> a ... b)]
[doms (List (Listof a) ... a)])
(Listof (List (List a ...) (Listof b)))]{
Like @racket[tabulate], but the types of the arguments of @racket[func]
explicitly appear in the return type.
As of 2022-03-06, I am not able to write the type of a list first containing
elements of types @racket[a ...], followed by an element of type @racket[b].
This is why this function returns a list of lists, each containing first a list
of inputs, and then the output of @racket[func].
@examples[#:eval functions-evaluator
(tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t)))
]}
@defproc[(tabulate/untyped [funcs procedure?]
[doms (listof list?)])
(listof list?)]{
A version of @racket[tabulate] without type checking.
As of 2022-03-06, Typed Racket cannot generate contracts for polymorphic
variable-arity functions. This means that @racket[tabulate] cannot be used
directly in untyped code and should be replaced by @racket[tabulate/untyped],
which is simply an @racket[unsafe-provide] of @racket[tabulate].
@examples[#:eval functions-evaluator
(tabulate/untyped (λ (x y) (and x y)) '((#f #t) (#f #t)))
]
The contracts in the documentation entry are provided for explanatory purposes
and are not actually enforced. Some contracts on the functions
@racket[tabulate] uses internally are still checked. For example, trying to
tabulate a function of wrong arity will still raise an error.
@examples[#:eval functions-evaluator
(module tabulate/untyped-test racket/base
(require "functions.rkt")
(tabulate/untyped (λ (x y z) (and x y z)) '((#f #t) (#f #t))))
(eval:error (require 'tabulate/untyped-test))
]}
@defproc[(tabulate* [funcs (Listof (-> a ... b))] @defproc[(tabulate* [funcs (Listof (-> a ... b))]
[doms (List (Listof a) ... a)]) [doms (List (Listof a) ... a)])
(Listof (Listof (U Any b)))]{ (Listof (Listof (U Any b)))]{