functions: Add tabulate*/domain-list and use it in tabulate/domain-list.
This commit is contained in:
parent
cd00e2a4d4
commit
e7b5a3931a
1 changed files with 15 additions and 2 deletions
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in a new issue