Move tabulate/boolean and tabulate*/boolean to typed/untyped.
This commit is contained in:
parent
096d536908
commit
c19d18122c
2 changed files with 45 additions and 27 deletions
|
@ -155,7 +155,10 @@
|
||||||
(contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c))
|
(contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c))
|
||||||
(listof (listof any/c)))]
|
(listof (listof any/c)))]
|
||||||
[tabulate (-> procedure? (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)
|
(define (tabulate* funcs doms)
|
||||||
(for/list ([xs (in-list (apply cartesian-product doms))])
|
(for/list ([xs (in-list (apply cartesian-product doms))])
|
||||||
|
@ -178,7 +181,26 @@
|
||||||
(module+ test
|
(module+ test
|
||||||
(test-case "tabulate"
|
(test-case "tabulate"
|
||||||
(check-equal? (tabulate (λ (x y) (and x y)) '((#f #t) (#f #t)))
|
(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)
|
(require 'typed)
|
||||||
|
@ -197,8 +219,6 @@
|
||||||
[struct tbf ((weights (vectorof number?)) (threshold number?))])
|
[struct tbf ((weights (vectorof number?)) (threshold number?))])
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out
|
(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 (-> procedure? (listof (listof (or/c 0 1))))]
|
||||||
[tabulate*/01 (-> (non-empty-listof 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 (-> (listof (*list/c any/c any/c)) procedure?)]
|
||||||
|
@ -235,29 +255,6 @@
|
||||||
;;; Tabulating
|
;;; 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
|
;;; Like tabulate, but assumes the domains of all variables of the
|
||||||
;;; function are {0, 1}. func must have a fixed arity. It is an
|
;;; function are {0, 1}. func must have a fixed arity. It is an
|
||||||
;;; error to supply a function of variable arity.
|
;;; error to supply a function of variable arity.
|
||||||
|
|
|
@ -213,3 +213,24 @@ same arguments over the same domains.
|
||||||
(λ (x y) (or x y)))
|
(λ (x y) (or x y)))
|
||||||
'((#f #t) (#f #t)))
|
'((#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))))
|
||||||
|
]}
|
||||||
|
|
Loading…
Reference in a new issue