diff --git a/functions.rkt b/functions.rkt index 41a4e7c..8760f43 100644 --- a/functions.rkt +++ b/functions.rkt @@ -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. diff --git a/scribblings/functions.scrbl b/scribblings/functions.scrbl index b77a62d..2c82d59 100644 --- a/scribblings/functions.scrbl +++ b/scribblings/functions.scrbl @@ -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}