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
|
(module typed typed/racket
|
||||||
(require "utils.rkt")
|
(require "utils.rkt")
|
||||||
|
|
||||||
|
(provide
|
||||||
|
tabulate* tabulate*/strict)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require typed/rackunit))
|
(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)
|
(require 'typed)
|
||||||
(provide)
|
(provide
|
||||||
|
tabulate* tabulate*/strict)
|
||||||
|
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
|
@ -27,7 +63,6 @@
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out
|
(contract-out
|
||||||
[tabulate (-> procedure? (listof generic-set?) (listof list?))]
|
[tabulate (-> procedure? (listof generic-set?) (listof list?))]
|
||||||
[tabulate* (-> (listof 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))))]
|
||||||
|
@ -66,17 +101,6 @@
|
||||||
;;; 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* `(,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
|
;;; Like tabulate, but takes a list of functions taking
|
||||||
;;; the same arguments over the same domains.
|
;;; the same arguments over the same domains.
|
||||||
(define (tabulate* funcs doms)
|
(define (tabulate* funcs doms)
|
||||||
|
@ -92,6 +116,18 @@
|
||||||
(check-equal? (tabulate* empty '((#f #t) (#f #t)))
|
(check-equal? (tabulate* empty '((#f #t) (#f #t)))
|
||||||
'((#f #f) (#f #t) (#t #f) (#t #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
|
;;; 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.
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scribble/manual
|
#lang scribble/manual
|
||||||
@(require scribble/example racket/sandbox
|
@(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}
|
@title[#:tag "functions"]{dds/functions: Formal Functions}
|
||||||
|
|
||||||
|
@ -19,6 +19,47 @@ Boolean functions, etc.).
|
||||||
|
|
||||||
@section{Tabulating functions}
|
@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{Constructing functions}
|
||||||
|
|
||||||
@section{Random functions}
|
@section{Random functions}
|
||||||
|
|
Loading…
Reference in a new issue