Add typed versions of tabulate* and tabulate*/strict.

This commit is contained in:
Sergiu Ivanov 2022-03-06 19:54:05 +01:00
parent ccb70a5921
commit 66f1157200
2 changed files with 91 additions and 14 deletions

View file

@ -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.

View file

@ -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}