scolobb/dds
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Move tabulate/01 and tabulate*/01 to the untyped submodule.

Browse source
This commit is contained in:
Sergiu Ivanov 2022-04-10 19:36:00 +02:00
parent 1b22ba4a7e
commit 81496a2ee7
2 changed files with 42 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
functions.rkt
View file

@ -179,7 +179,9 @@
(listof (listof any/c)))]
[tabulate/boolean (-> procedure? (listof (listof boolean?)))]
[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)
(for/list ([xs (in-list (apply cartesian-product doms))])
@ -221,6 +223,22 @@
(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)))))
(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?))])
;; Functions
(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/list (-> (listof (*list/c any/c any/c)) procedure?)]
[enumerate-boolean-tables (-> number? (stream/c (listof (*list/c boolean? boolean?))))]
@ -273,30 +289,6 @@
(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
;;; ======================

23
scribblings/functions.scrbl
View file

@ -277,3 +277,26 @@ same arity.
(tabulate*/boolean `(,(λ (x y) (and 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))))
]}