Move tabulate/01 and tabulate*/01 to the untyped submodule.
This commit is contained in:
parent
1b22ba4a7e
commit
81496a2ee7
2 changed files with 42 additions and 27 deletions
|
@ -179,7 +179,9 @@
|
||||||
(listof (listof any/c)))]
|
(listof (listof any/c)))]
|
||||||
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
|
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
|
||||||
[tabulate*/boolean (-> (non-empty-listof procedure?)
|
[tabulate*/boolean (-> (non-empty-listof procedure?)
|
||||||
(listof (listof boolean?)))]))
|
(listof (listof boolean?)))]
|
||||||
|
[tabulate/01 (-> procedure? (listof (listof (or/c 0 1))))]
|
||||||
|
[tabulate*/01 (-> (non-empty-listof procedure?) (listof (listof (or/c 0 1))))]))
|
||||||
|
|
||||||
(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))])
|
||||||
|
@ -221,6 +223,22 @@
|
||||||
(check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
|
(check-equal? (tabulate*/boolean `(,(λ (x y) (and x y))
|
||||||
,(λ (x y) (or x y))))
|
,(λ (x y) (or x y))))
|
||||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
||||||
|
|
||||||
|
(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)))))
|
||||||
|
|
||||||
|
(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)))))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -241,8 +259,6 @@
|
||||||
[struct tbf ((weights (vectorof number?)) (threshold number?))])
|
[struct tbf ((weights (vectorof number?)) (threshold number?))])
|
||||||
;; Functions
|
;; Functions
|
||||||
(contract-out
|
(contract-out
|
||||||
[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 (-> (listof (*list/c any/c any/c)) procedure?)]
|
||||||
[table->function/list (-> (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?))))]
|
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
|
||||||
|
@ -273,30 +289,6 @@
|
||||||
(require rackunit))
|
(require rackunit))
|
||||||
|
|
||||||
|
|
||||||
;;; ==========
|
|
||||||
;;; Tabulating
|
|
||||||
;;; ==========
|
|
||||||
|
|
||||||
;;; 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/untyped 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*/untyped 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
|
;;; Constructing functions
|
||||||
;;; ======================
|
;;; ======================
|
||||||
|
|
|
@ -277,3 +277,26 @@ same arity.
|
||||||
(tabulate*/boolean `(,(λ (x y) (and x y))
|
(tabulate*/boolean `(,(λ (x y) (and x y))
|
||||||
,(λ (x y) (or x y))))
|
,(λ (x y) (or x y))))
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@defproc[(tabulate/01 [func procedure?]) (listof (listof (or/c 0 1)))]{
|
||||||
|
|
||||||
|
Like @racket[tabulate], but assumes the domains of all variables of the
|
||||||
|
function are @tt{{0,1}}. @racket[func] must have a fixed arity. It is an
|
||||||
|
error to supply a function of variable arity.
|
||||||
|
|
||||||
|
@examples[#:eval functions-evaluator/untyped
|
||||||
|
(tabulate/01 (λ (x y) (modulo (+ x y) 2)))
|
||||||
|
]
|
||||||
|
|
||||||
|
The same remarks apply as for @racket[tabulate/boolean] (untyped).
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(tabulate*/01 [funcs (listof procedure?)]) (listof (listof (or/c 0 1)))]{
|
||||||
|
|
||||||
|
Like @racket[tabulate/01] (untyped), but takes a list of functions of the
|
||||||
|
same arity.
|
||||||
|
|
||||||
|
@examples[#:eval functions-evaluator/untyped
|
||||||
|
(tabulate*/01 `(,(λ (x y) (min x y)) ,(λ (x y) (max x y))))
|
||||||
|
]}
|
||||||
|
|
Loading…
Reference in a new issue