Move tabulate/boolean and tabulate*/boolean to typed/untyped.

This commit is contained in:
Sergiu Ivanov 2022-04-09 01:32:54 +02:00
parent 096d536908
commit c19d18122c
2 changed files with 45 additions and 27 deletions

View File

@ -155,7 +155,10 @@
(contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c))
(listof (listof any/c)))]
[tabulate (-> procedure? (listof (listof any/c))
(listof (listof any/c)))]))
(listof (listof any/c)))]
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
[tabulate*/boolean (-> (non-empty-listof procedure?)
(listof (listof boolean?)))]))
(define (tabulate* funcs doms)
(for/list ([xs (in-list (apply cartesian-product doms))])
@ -178,7 +181,26 @@
(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))))))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
(define (tabulate/boolean func)
(tabulate func (make-list (procedure-arity func) '(#f #t))))
(module+ test
(test-case "tabulate/boolean"
(check-equal? (tabulate/boolean (lambda (x y) (and x y)))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
(define (tabulate*/boolean funcs)
(define doms (make-list (procedure-arity (car funcs)) '(#f #t)))
(tabulate* funcs doms))
(module+ test
(test-case "tabulate*/boolean"
(check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
,(λ (x y) (or x y))))
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
)
)
(require 'typed)
@ -197,8 +219,6 @@
[struct tbf ((weights (vectorof number?)) (threshold number?))])
;; Functions
(contract-out
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
[tabulate*/boolean (-> (non-empty-listof procedure?) (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?)]
@ -235,29 +255,6 @@
;;; Tabulating
;;; ==========
;;; 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.
(define (tabulate/boolean func)
(tabulate/untyped func (make-list (procedure-arity func) '(#f #t))))
(module+ test
(test-case "tabulate/boolean"
(check-equal? (tabulate/boolean (lambda (x y) (and x y)))
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
;;; Like tabulate/boolean, but takes a list of functions of the same
;;; arity.
(define (tabulate*/boolean funcs)
(define doms (make-list (procedure-arity (car funcs)) '(#f #t)))
(tabulate*/untyped funcs doms))
(module+ test
(test-case "tabulate*/boolean"
(check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
,(λ (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.

View File

@ -213,3 +213,24 @@ same arguments over the same domains.
(λ (x y) (or x y)))
'((#f #t) (#f #t)))
]}
@defproc[(tabulate/boolean [func procedure?]) (listof (listof boolean?))]{
Like @racket[tabulate], but assumes the domains of all variables of the
function are Boolean. @racket[func] must have a fixed arity. It is an error
to supply a function of variable arity.
@examples[#:eval functions-evaluator/untyped
(tabulate/boolean (lambda (x y) (and x y)))
]}
@defproc[(tabulate*/boolean [funcs (non-empty-listof procedure?)])
(listof (listof boolean?))]{
Like @racket[tabulate/boolean], but takes a list of functions of the
same arity.
@examples[#:eval functions-evaluator/untyped
(tabulate*/boolean `(,(λ (x y) (and x y))
,(λ (x y) (or x y))))
]}