From e7b5a3931adb28911bc6732881be5848318a7c32 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Sat, 30 May 2020 23:55:48 +0200 Subject: [PATCH] functions: Add tabulate*/domain-list and use it in tabulate/domain-list. --- functions.rkt | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/functions.rkt b/functions.rkt index d271e42..0f3aab1 100644 --- a/functions.rkt +++ b/functions.rkt @@ -13,6 +13,7 @@ ;; Functions (contract-out [tabulate/domain-list (-> procedure? (listof generic-set?) (listof list?))] + [tabulate*/domain-list (-> (listof procedure?) (listof generic-set?) (listof list?))] [tabulate (->* (procedure?) () #:rest (listof generic-set?) (listof list?))] [tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))] [table->function (-> (listof (*list/c any/c any/c)) procedure?)] @@ -36,14 +37,26 @@ ;;; in order, produces a list of lists giving the values of arguments ;;; and the value of the functions for these inputs. (define (tabulate/domain-list func doms) - (for/list ([xs (apply cartesian-product doms)]) - (append xs (list (apply func xs))))) + (tabulate*/domain-list `(,func) doms)) (module+ test (test-case "tabulate/domain-list" (check-equal? (tabulate/domain-list (λ (x y) (and x y)) '((#f #t) (#f #t))) '((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))))) +;;; Like tabulate/domain-list, but takes a list of functions taking +;;; the same arguments over the same domains. +(define (tabulate*/domain-list funcs doms) + (for/list ([xs (apply cartesian-product doms)]) + (append xs (for/list ([f funcs]) (apply f xs))))) + +(module+ test + (test-case "tabulate*/domain-list" + (check-equal? (tabulate*/domain-list (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))))) + ;;; Like tabulate, but the domains are given as a rest argument. (define (tabulate func . doms) (tabulate/domain-list func doms))