functions: Add tabulate/01 and tabulate*/01.

This commit is contained in:
Sergiu Ivanov 2020-06-10 23:25:39 +02:00
parent 512de1a963
commit 45f4984f4c

View File

@ -19,6 +19,8 @@
[tabulate* (-> (listof procedure-fixed-arity?) (listof generic-set?) (listof list?))]
[tabulate/boolean (-> procedure-fixed-arity? (listof (listof boolean?)))]
[tabulate*/boolean (-> (non-empty-listof procedure-fixed-arity?) (listof (listof boolean?)))]
[tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
[tabulate*/01 (-> (non-empty-listof procedure?) (listof (listof (or/c 0 1))))]
[table->function (-> (listof (*list/c any/c any/c)) procedure?)]
[table->function/list (-> (listof (*list/c any/c any/c)) procedure?)]
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
@ -87,6 +89,25 @@
,(λ (x y) (or x y))))
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
;;; Like tabulate, but assumes the domains of all variables of the
;;; function are {0, 1}. func must have a fixed arity. It is an
;;; error to supply a function of variable arity.
(define (tabulate/01 func)
(tabulate func (make-list (procedure-arity func) '(0 1))))
(module+ test
(test-case "tabulate/01"
(check-equal? (tabulate/01 (λ (x y) (modulo (+ x y) 2)))
'((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
;;; Like tabulate/01, but takes a list of functions of the same arity.
(define (tabulate*/01 funcs)
(tabulate* funcs (make-list (procedure-arity (car funcs)) '(0 1))))
(module+ test
(test-case "tabulate*/01"
(check-equal? (tabulate*/01 `(,(λ (x y) (min x y)) ,(λ (x y) (max x y))))
'((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
;;; ======================
;;; Constructing functions