Add typed versions of tabulate* and tabulate*/strict.
This commit is contained in:
parent
ccb70a5921
commit
66f1157200
2 changed files with 91 additions and 14 deletions
|
@ -12,12 +12,48 @@
|
|||
(module typed typed/racket
|
||||
(require "utils.rkt")
|
||||
|
||||
(provide
|
||||
tabulate* tabulate*/strict)
|
||||
|
||||
(module+ test
|
||||
(require typed/rackunit))
|
||||
|
||||
(: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(Listof (Listof (U Any b))))))
|
||||
(define (tabulate* funcs doms)
|
||||
(for/list ([xs (in-list (apply cartesian-product doms))])
|
||||
(append xs (for/list ([f funcs]) : (Listof b)
|
||||
(apply f xs)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate*"
|
||||
(check-equal? (tabulate*
|
||||
(list (λ (x y) (and x y))
|
||||
(λ (x y) (or x y)))
|
||||
'((#f #t) (#f #t)))
|
||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))
|
||||
(check-equal? (tabulate* empty '((#f #t) (#f #t)))
|
||||
'((#f #f) (#f #t) (#t #f) (#t #t)))))
|
||||
|
||||
(: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(Listof (List (List a ...) (Listof b))))))
|
||||
(define (tabulate*/strict funcs doms)
|
||||
(for/list ([xs (in-list (apply cartesian-product doms))])
|
||||
(list xs (for/list ([f funcs]) : (Listof b)
|
||||
(apply f xs)))))
|
||||
|
||||
(module+ test
|
||||
(test-case "tabulate*/strict"
|
||||
(check-equal? (tabulate*/strict
|
||||
(list (λ (x y) (and x y))
|
||||
(λ (x y) (or x y)))
|
||||
'((#f #t) (#f #t)))
|
||||
'(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t))))))
|
||||
)
|
||||
|
||||
(require 'typed)
|
||||
(provide)
|
||||
(provide
|
||||
tabulate* tabulate*/strict)
|
||||
|
||||
|
||||
(provide
|
||||
|
@ -27,7 +63,6 @@
|
|||
;; Functions
|
||||
(contract-out
|
||||
[tabulate (-> procedure? (listof generic-set?) (listof list?))]
|
||||
[tabulate* (-> (listof procedure?) (listof generic-set?) (listof list?))]
|
||||
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
|
||||
[tabulate*/boolean (-> (non-empty-listof procedure?) (listof (listof boolean?)))]
|
||||
[tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
|
||||
|
@ -66,17 +101,6 @@
|
|||
;;; 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* `(,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 takes a list of functions taking
|
||||
;;; the same arguments over the same domains.
|
||||
(define (tabulate* funcs doms)
|
||||
|
@ -92,6 +116,18 @@
|
|||
(check-equal? (tabulate* empty '((#f #t) (#f #t)))
|
||||
'((#f #f) (#f #t) (#t #f) (#t #t)))))
|
||||
|
||||
;;; 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* `(,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
|
||||
;;; function are Boolean. func must have a fixed arity. It is an
|
||||
;;; error to supply a function of variable arity.
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/example racket/sandbox
|
||||
(for-label typed/racket/base "../functions.rkt"))
|
||||
(for-label typed/racket/base "../functions.rkt" dds/utils))
|
||||
|
||||
@title[#:tag "functions"]{dds/functions: Formal Functions}
|
||||
|
||||
|
@ -19,6 +19,47 @@ Boolean functions, etc.).
|
|||
|
||||
@section{Tabulating functions}
|
||||
|
||||
@defproc[(tabulate* [funcs (Listof (-> a ... b))]
|
||||
[doms (List (Listof a) ... a)])
|
||||
(Listof (Listof (U Any b)))]{
|
||||
|
||||
Like @racket[tabulate], but @racket[funcs] is a list of functions taking the
|
||||
same arguments over the same domains.
|
||||
|
||||
@examples[#:eval functions-evaluator
|
||||
(tabulate* (list (λ (x y) (and x y))
|
||||
(λ (x y) (or x y)))
|
||||
'((#f #t) (#f #t)))
|
||||
]}
|
||||
|
||||
@defproc[(tabulate*/strict [funcs (Listof (-> a ... b))]
|
||||
[doms (List (Listof a) ... a)])
|
||||
(Listof (List (List a ...) (Listof b)))]{
|
||||
|
||||
Like @racket[tabulate*], but the types of the arguments of the functions
|
||||
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 a list of elements of type
|
||||
@racket[b]. This is why this function returns a list of lists, each containing
|
||||
first a list of inputs, and then the list of outputs of @racket[funcs].
|
||||
|
||||
@examples[#:eval functions-evaluator
|
||||
(tabulate*/strict (list (λ (x y) (and x y))
|
||||
(λ (x y) (or x y)))
|
||||
'((#f #t) (#f #t)))
|
||||
]
|
||||
|
||||
The result of @racket[tabulate*] can be obtained by applying
|
||||
@racket[append-lists]:
|
||||
|
||||
@examples[#:eval functions-evaluator
|
||||
(require (only-in "utils.rkt" append-lists))
|
||||
(append-lists (tabulate*/strict (list (λ (x y) (and x y))
|
||||
(λ (x y) (or x y)))
|
||||
'((#f #t) (#f #t))))
|
||||
]}
|
||||
|
||||
@section{Constructing functions}
|
||||
|
||||
@section{Random functions}
|
||||
|
|
Loading…
Reference in a new issue