Switch functions entirely to Typed Racket.
This commit is contained in:
Sergiu Ivanov
parent
0e2b91fdd1
commit
9182ea9ecb
290
functions.rkt
290
functions.rkt
|
|
@ -1,4 +1,4 @@
|
|||
#lang racket
|
||||
#lang typed/racket
|
||||
|
||||
;;; dds/functions
|
||||
|
||||
|
|
@ -9,16 +9,15 @@
|
|||
|
||||
(require "utils.rkt")
|
||||
|
||||
(module typed typed/racket
|
||||
(require "utils.rkt"
|
||||
(require "utils.rkt"
|
||||
syntax/parse/define typed/racket/stream
|
||||
(only-in typed/racket/unsafe unsafe-provide)
|
||||
(for-syntax syntax/parse))
|
||||
|
||||
(require/typed racket/stream
|
||||
(require/typed racket/stream
|
||||
[stream-map (All (a b) (-> (-> a b) (Sequenceof a) (Sequenceof b)))])
|
||||
|
||||
(provide
|
||||
(provide
|
||||
pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
|
||||
tabulate* tabulate*/strict tabulate*/pv tabulate tabulate/strict tabulate/pv
|
||||
tabulate*/pv/boolean tabulate/pv/boolean tabulate*/pv/01 tabulate/pv/01
|
||||
|
|
@ -33,10 +32,10 @@
|
|||
list->tbf lists->tbfs read-org-tbfs tbf-tabulate* tbf-tabulate
|
||||
tbf-tabulate*/boolean sbf? sbf list->sbf read-org-sbfs)
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(require typed/rackunit))
|
||||
|
||||
(begin-for-syntax
|
||||
(begin-for-syntax
|
||||
(require racket (for-syntax syntax/parse))
|
||||
|
||||
(define (make-pseudovariadic-core args bodies tag-stx)
|
||||
|
|
@ -62,20 +61,20 @@
|
|||
#'(bodies ...)
|
||||
(datum->syntax #'name `(quote ,(syntax->datum #'name)))))])))
|
||||
|
||||
(define-syntax (pseudovariadic-lambda stx) (make-pseudovariadic-lambda stx))
|
||||
(define-syntax (pvλ stx) (make-pseudovariadic-lambda stx))
|
||||
(define-syntax (pseudovariadic-lambda stx) (make-pseudovariadic-lambda stx))
|
||||
(define-syntax (pvλ stx) (make-pseudovariadic-lambda stx))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "pseudovariadic-lambda")
|
||||
(check-false ((pseudovariadic-lambda (x y) (and x y)) #t #f))
|
||||
(check-false ((pvλ (x y) (and x y)) #t #f))
|
||||
(check-exn exn:fail? (λ () ((pseudovariadic-lambda (x y) (and x y)) #t #f #f)))
|
||||
(check-exn exn:fail? (λ () ((pvλ (x y) (and x y)) #t #f #f))))
|
||||
|
||||
(define-syntax (pseudovariadic-define stx) (make-pseudovariadic-define stx))
|
||||
(define-syntax (pvdefine stx) (make-pseudovariadic-define stx))
|
||||
(define-syntax (pseudovariadic-define stx) (make-pseudovariadic-define stx))
|
||||
(define-syntax (pvdefine stx) (make-pseudovariadic-define stx))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "pseudovariadic-define")
|
||||
(: f (-> Boolean * Boolean))
|
||||
(pseudovariadic-define (f x y) (and x y))
|
||||
|
|
@ -87,17 +86,17 @@
|
|||
(check-false (g #t #f))
|
||||
(check-exn exn:fail? (λ () (g #t #f #f))))
|
||||
|
||||
(define-syntax-parse-rule (make-tabulate* name:id row-op:id apply-op:id)
|
||||
(define-syntax-parse-rule (make-tabulate* name:id row-op:id apply-op:id)
|
||||
(define (name funcs doms)
|
||||
(for/list ([xs (in-list (apply cartesian-product doms))])
|
||||
(row-op xs (for/list ([f funcs]) : (Listof b)
|
||||
(apply-op f xs))))))
|
||||
|
||||
(: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(: tabulate* (All (b a ... ) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(Listof (Listof (U Any b))))))
|
||||
(make-tabulate* tabulate* append apply)
|
||||
(make-tabulate* tabulate* append apply)
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*"
|
||||
(check-equal? (tabulate*
|
||||
(list (λ (x y) (and x y))
|
||||
|
|
@ -107,11 +106,11 @@
|
|||
(check-equal? (tabulate* empty '((#f #t) (#f #t)))
|
||||
'((#f #f) (#f #t) (#t #f) (#t #t)))))
|
||||
|
||||
(: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(: tabulate*/strict (All (b a ...) (-> (Listof (-> a ... b)) (List (Listof a) ... a)
|
||||
(Listof (List (List a ...) (Listof b))))))
|
||||
(make-tabulate* tabulate*/strict list apply)
|
||||
(make-tabulate* tabulate*/strict list apply)
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/strict"
|
||||
(check-equal? (tabulate*/strict
|
||||
(list (λ (x y) (and x y))
|
||||
|
|
@ -120,25 +119,25 @@
|
|||
'(((#f #f) (#f #f)) ((#f #t) (#f #t)) ((#t #f) (#f #t)) ((#t #t) (#t #t))))))
|
||||
|
||||
|
||||
(: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a))
|
||||
(: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a))
|
||||
(Listof (Listof (U a b))))))
|
||||
(make-tabulate* tabulate*/pv append apply)
|
||||
(make-tabulate* tabulate*/pv append apply)
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/pv"
|
||||
(check-equal? (tabulate*/pv (list (pvλ (x y) (and x y))
|
||||
(pvλ (x y) (or x y)))
|
||||
'((#f #t) (#f #t)))
|
||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
||||
|
||||
(define-syntax-parse-rule (simple-apply func:expr arg:expr)
|
||||
(define-syntax-parse-rule (simple-apply func:expr arg:expr)
|
||||
(func arg))
|
||||
|
||||
(: tabulate*/list (All (a b) (-> (Listof (-> (Listof a) b)) (Listof (Listof a))
|
||||
(: tabulate*/list (All (a b) (-> (Listof (-> (Listof a) b)) (Listof (Listof a))
|
||||
(Listof (Listof (U a b))))))
|
||||
(make-tabulate* tabulate*/list append simple-apply)
|
||||
(make-tabulate* tabulate*/list append simple-apply)
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/list"
|
||||
(check-equal? (tabulate*/list (list (λ ([xs : (Listof Boolean)])
|
||||
(and (car xs) (cadr xs)))
|
||||
|
|
@ -147,130 +146,130 @@
|
|||
'((#f #t) (#f #t)))
|
||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
||||
|
||||
(: tabulate (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
|
||||
(: tabulate (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
|
||||
(Listof (Listof (U Any b))))))
|
||||
(define (tabulate func doms)
|
||||
(define (tabulate func doms)
|
||||
(tabulate* (list func) doms))
|
||||
|
||||
(module+ test
|
||||
(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)))))
|
||||
|
||||
(: tabulate/strict (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
|
||||
(: tabulate/strict (All (b a ...) (-> (-> a ... b) (List (Listof a) ... a)
|
||||
(Listof (List (List a ...) (Listof b))))))
|
||||
(define (tabulate/strict func doms)
|
||||
(define (tabulate/strict func doms)
|
||||
(tabulate*/strict (list func) doms))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/strict"
|
||||
(check-equal? (tabulate/strict (λ (x y) (and x y)) '((#f #t) (#f #t)))
|
||||
'(((#f #f) (#f)) ((#f #t) (#f)) ((#t #f) (#f)) ((#t #t) (#t))))))
|
||||
|
||||
(: tabulate/pv (All (a b) (-> (-> a * b) (Listof (Listof a))
|
||||
(: tabulate/pv (All (a b) (-> (-> a * b) (Listof (Listof a))
|
||||
(Listof (Listof (U a b))))))
|
||||
(define (tabulate/pv func doms)
|
||||
(define (tabulate/pv func doms)
|
||||
(tabulate*/pv (list func) doms))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/pv"
|
||||
(check-equal? (tabulate/pv (pvλ (x y) (and x y)) '((#f #t) (#f #t)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
(: tabulate/list (All (a b) (-> (-> (Listof a) b) (Listof (Listof a))
|
||||
(: tabulate/list (All (a b) (-> (-> (Listof a) b) (Listof (Listof a))
|
||||
(Listof (Listof (U a b))))))
|
||||
(define (tabulate/list func doms)
|
||||
(define (tabulate/list func doms)
|
||||
(tabulate*/list (list func) doms))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/list"
|
||||
(check-equal? (tabulate/list (λ ([xs : (Listof Boolean)])
|
||||
(and (car xs) (cadr xs)))
|
||||
'((#f #t) (#f #t)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
(: tabulate/pv/boolean (-> Positive-Integer (-> Boolean * Boolean) (Listof (Listof Boolean))))
|
||||
(define (tabulate/pv/boolean arity func)
|
||||
(: tabulate/pv/boolean (-> Positive-Integer (-> Boolean * Boolean) (Listof (Listof Boolean))))
|
||||
(define (tabulate/pv/boolean arity func)
|
||||
(tabulate/pv func (make-list arity '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/pv/boolean"
|
||||
(check-equal? (tabulate/pv/boolean 2 (pvλ (x y) (and x y)))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
(: tabulate*/pv/boolean (-> Positive-Integer (Listof (-> Boolean * Boolean))
|
||||
(: tabulate*/pv/boolean (-> Positive-Integer (Listof (-> Boolean * Boolean))
|
||||
(Listof (Listof Boolean))))
|
||||
(define (tabulate*/pv/boolean arity funcs)
|
||||
(define (tabulate*/pv/boolean arity funcs)
|
||||
(tabulate*/pv funcs (make-list arity '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/pv/boolean"
|
||||
(check-equal? (tabulate*/pv/boolean 2 (list (pvλ (x y) (and x y))
|
||||
(pvλ (x y) (or x y))))
|
||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
||||
|
||||
(: tabulate/pv/01 (-> Positive-Integer (-> (U Zero One) * (U Zero One))
|
||||
(: tabulate/pv/01 (-> Positive-Integer (-> (U Zero One) * (U Zero One))
|
||||
(Listof (Listof (U Zero One)))))
|
||||
(define (tabulate/pv/01 arity func)
|
||||
(define (tabulate/pv/01 arity func)
|
||||
(tabulate/pv func (make-list arity '(0 1))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/pv/01"
|
||||
(check-equal? (tabulate/pv/01 2 (pvλ (x y)
|
||||
(assert-type (modulo (+ x y) 2) (U Zero One))))
|
||||
'((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
|
||||
|
||||
(: tabulate*/pv/01 (-> Positive-Integer (Listof (-> (U Zero One) * (U Zero One)))
|
||||
(: tabulate*/pv/01 (-> Positive-Integer (Listof (-> (U Zero One) * (U Zero One)))
|
||||
(Listof (Listof (U Zero One)))))
|
||||
(define (tabulate*/pv/01 arity funcs)
|
||||
(define (tabulate*/pv/01 arity funcs)
|
||||
(tabulate*/pv funcs (make-list arity '(0 1))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/pv/01"
|
||||
(check-equal? (tabulate*/pv/01 2 `(,(pvλ (x y) (assert-type (min x y) (U Zero One)))
|
||||
,(pvλ (x y) (assert-type (max x y) (U Zero One)))))
|
||||
'((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
|
||||
|
||||
(: tabulate/list/boolean (-> Positive-Integer (-> (Listof Boolean) Boolean)
|
||||
(: tabulate/list/boolean (-> Positive-Integer (-> (Listof Boolean) Boolean)
|
||||
(Listof (Listof Boolean))))
|
||||
(define (tabulate/list/boolean arity func)
|
||||
(define (tabulate/list/boolean arity func)
|
||||
(tabulate/list func (make-list arity '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/list/boolean"
|
||||
(check-equal? (tabulate/list/boolean 2 (λ (xs) (and (car xs) (cadr xs))))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
(: tabulate*/list/boolean (-> Positive-Integer (Listof (-> (Listof Boolean) Boolean))
|
||||
(: tabulate*/list/boolean (-> Positive-Integer (Listof (-> (Listof Boolean) Boolean))
|
||||
(Listof (Listof Boolean))))
|
||||
(define (tabulate*/list/boolean arity funcs)
|
||||
(define (tabulate*/list/boolean arity funcs)
|
||||
(tabulate*/list funcs (make-list arity '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/list/boolean"
|
||||
(check-equal?
|
||||
(tabulate*/list/boolean 2 (list (λ (xs) (and (car xs) (cadr xs)))
|
||||
(λ (xs) (or (car xs) (cadr xs)))))
|
||||
'((#f #f #f #f) (#f #t #f #t) (#t #f #f #t) (#t #t #t #t)))))
|
||||
|
||||
(: tabulate/list/01 (-> Positive-Integer (-> (Listof (U Zero One)) (U Zero One))
|
||||
(: tabulate/list/01 (-> Positive-Integer (-> (Listof (U Zero One)) (U Zero One))
|
||||
(Listof (Listof (U Zero One)))))
|
||||
(define (tabulate/list/01 arity func)
|
||||
(define (tabulate/list/01 arity func)
|
||||
(tabulate/list func (make-list arity '(0 1))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate/list/01"
|
||||
(check-equal?
|
||||
(tabulate/list/01 2 (λ (xs)
|
||||
(assert-type (modulo (+ (car xs) (cadr xs)) 2) (U Zero One))))
|
||||
'((0 0 0) (0 1 1) (1 0 1) (1 1 0)))))
|
||||
|
||||
(: tabulate*/list/01 (-> Positive-Integer (Listof (-> (Listof (U Zero One)) (U Zero One)))
|
||||
(: tabulate*/list/01 (-> Positive-Integer (Listof (-> (Listof (U Zero One)) (U Zero One)))
|
||||
(Listof (Listof (U Zero One)))))
|
||||
(define (tabulate*/list/01 arity funcs)
|
||||
(define (tabulate*/list/01 arity funcs)
|
||||
(tabulate*/list funcs (make-list arity '(0 1))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tabulate*/list/01"
|
||||
(check-equal? (tabulate*/list/01
|
||||
2
|
||||
|
|
@ -278,34 +277,34 @@
|
|||
,(λ (xs) (assert-type (max (car xs) (cadr xs)) (U Zero One)))))
|
||||
'((0 0 0 0) (0 1 0 1) (1 0 0 1) (1 1 1 1)))))
|
||||
|
||||
(: table->function/list (All (a) (-> (Listof (Listof a))
|
||||
(: table->function/list (All (a) (-> (Listof (Listof a))
|
||||
(-> (Listof a) a))))
|
||||
(define (table->function/list table)
|
||||
(define (table->function/list table)
|
||||
(define ht-tab
|
||||
(for/hash ([line (in-list table)]) : (HashTable (Listof a) a)
|
||||
(define-values (x fx) (split-at-right line 1))
|
||||
(values x (car fx))))
|
||||
(λ (x) (hash-ref ht-tab x)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "table->function/list"
|
||||
(define negation/list (table->function/list '((#t #f) (#f #t))))
|
||||
(check-true (negation/list '(#f)))
|
||||
(check-false (negation/list '(#t)))))
|
||||
|
||||
(: table->function (All (a) (-> (Listof (Listof a)) (-> a * a))))
|
||||
(define (table->function table)
|
||||
(: table->function (All (a) (-> (Listof (Listof a)) (-> a * a))))
|
||||
(define (table->function table)
|
||||
(define func (table->function/list table))
|
||||
(λ args (func args)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "table->function"
|
||||
(define negation (table->function '((#t #f) (#f #t))))
|
||||
(check-true (negation #f))
|
||||
(check-false (negation #t))))
|
||||
|
||||
(: table->function/pv (All (a) (-> (Listof (Listof a)) (-> a * a))))
|
||||
(define (table->function/pv table)
|
||||
(: table->function/pv (All (a) (-> (Listof (Listof a)) (-> a * a))))
|
||||
(define (table->function/pv table)
|
||||
(define func (table->function/list table))
|
||||
(define arity (- (length (car table)) 1))
|
||||
(λ xs
|
||||
|
|
@ -315,15 +314,15 @@
|
|||
"invalid arity, expected ~a argument(s)"
|
||||
arity))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "table->function/pv"
|
||||
(define negation (table->function/pv '((#t #f) (#f #t))))
|
||||
(check-true (negation #f))
|
||||
(check-false (negation #t))
|
||||
(check-exn exn:fail? (λ () (negation #f #t)))))
|
||||
|
||||
(: enumerate-boolean-tables (-> Positive-Integer (Sequenceof (Listof (Listof Boolean)))))
|
||||
(define (enumerate-boolean-tables n)
|
||||
(: enumerate-boolean-tables (-> Positive-Integer (Sequenceof (Listof (Listof Boolean)))))
|
||||
(define (enumerate-boolean-tables n)
|
||||
(define inputs (boolean-power n))
|
||||
(define outputs (boolean-power/stream (assert-type (expt 2 n) Integer)))
|
||||
|
||||
|
|
@ -341,7 +340,7 @@
|
|||
|
||||
(yield outputs))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-tables"
|
||||
(check-equal? (stream->list (enumerate-boolean-tables 2))
|
||||
'(((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #f))
|
||||
|
|
@ -361,46 +360,46 @@
|
|||
((#f #f #t) (#f #t #t) (#t #f #t) (#t #t #f))
|
||||
((#f #f #t) (#f #t #t) (#t #f #t) (#t #t #t))))))
|
||||
|
||||
(: enumerate-boolean-functions (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
|
||||
(define (enumerate-boolean-functions n)
|
||||
(: enumerate-boolean-functions (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
|
||||
(define (enumerate-boolean-functions n)
|
||||
(stream-map (inst table->function Boolean) (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-functions"
|
||||
(define bool-f1 (stream-first (enumerate-boolean-functions 1)))
|
||||
(check-false (bool-f1 #f))
|
||||
(check-false (bool-f1 #t))))
|
||||
|
||||
(: enumerate-boolean-functions/pv (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
|
||||
(define (enumerate-boolean-functions/pv n)
|
||||
(: enumerate-boolean-functions/pv (-> Positive-Integer (Sequenceof (-> Boolean * Boolean))))
|
||||
(define (enumerate-boolean-functions/pv n)
|
||||
(stream-map (inst table->function/pv Boolean) (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-functions/pv"
|
||||
(define bool-f1/pv (stream-first (enumerate-boolean-functions/pv 1)))
|
||||
(check-false (bool-f1/pv #f))
|
||||
(check-false (bool-f1/pv #t))
|
||||
(check-exn exn:fail? (λ () (bool-f1/pv #f #f)))))
|
||||
|
||||
(: enumerate-boolean-functions/list
|
||||
(: enumerate-boolean-functions/list
|
||||
(-> Positive-Integer (Sequenceof (-> (Listof Boolean) Boolean))))
|
||||
(define (enumerate-boolean-functions/list n)
|
||||
(define (enumerate-boolean-functions/list n)
|
||||
(stream-map (inst table->function/list Boolean) (enumerate-boolean-tables n)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "enumerate-boolean-functions/list"
|
||||
(define bool-f1/list (stream-first (enumerate-boolean-functions/list 1)))
|
||||
(check-false (bool-f1/list '(#f)))
|
||||
(check-false (bool-f1/list '(#t)))))
|
||||
|
||||
(: random-boolean-table (-> Positive-Integer (Listof (Listof Boolean))))
|
||||
(define (random-boolean-table n)
|
||||
(: random-boolean-table (-> Positive-Integer (Listof (Listof Boolean))))
|
||||
(define (random-boolean-table n)
|
||||
(define ins (boolean-power n))
|
||||
(define outs (stream-take (in-random 2) (assert-type (expt 2 n) Nonnegative-Integer)))
|
||||
(for/list ([i ins] [o outs])
|
||||
(append i (list (if (= o 1) #t #f)))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "random-boolean-table"
|
||||
(random-seed 1)
|
||||
(check-equal? (random-boolean-table 2)
|
||||
|
|
@ -409,11 +408,11 @@
|
|||
(#t #f #f)
|
||||
(#t #t #t)))))
|
||||
|
||||
(: random-boolean-function (-> Positive-Integer (-> Boolean * Boolean)))
|
||||
(define (random-boolean-function n)
|
||||
(: random-boolean-function (-> Positive-Integer (-> Boolean * Boolean)))
|
||||
(define (random-boolean-function n)
|
||||
(table->function (random-boolean-table n)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "random-boolean-function"
|
||||
(random-seed 1)
|
||||
(define random-bool-f (random-boolean-function 2))
|
||||
|
|
@ -422,11 +421,11 @@
|
|||
(check-false (random-bool-f #t #f))
|
||||
(check-true (random-bool-f #t #t))))
|
||||
|
||||
(: random-boolean-function/list (-> Positive-Integer (-> (Listof Boolean) Boolean)))
|
||||
(define (random-boolean-function/list n)
|
||||
(: random-boolean-function/list (-> Positive-Integer (-> (Listof Boolean) Boolean)))
|
||||
(define (random-boolean-function/list n)
|
||||
(table->function/list (random-boolean-table n)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "random-boolean-function/list"
|
||||
(random-seed 1)
|
||||
(define random-bool-f/list (random-boolean-function/list 2))
|
||||
|
|
@ -435,20 +434,20 @@
|
|||
(check-false (random-bool-f/list '(#t #f)))
|
||||
(check-true (random-bool-f/list '(#t #t)))))
|
||||
|
||||
(struct tbf ([weights : (Vectorof Real)] [threshold : Real]) #:transparent)
|
||||
(define tbf-w tbf-weights)
|
||||
(define tbf-θ tbf-threshold)
|
||||
(struct tbf ([weights : (Vectorof Real)] [threshold : Real]) #:transparent)
|
||||
(define tbf-w tbf-weights)
|
||||
(define tbf-θ tbf-threshold)
|
||||
|
||||
(: boolean->01/vector (-> (Vectorof Boolean) (Vectorof (U Zero One))))
|
||||
(define (boolean->01/vector bool-v)
|
||||
(: boolean->01/vector (-> (Vectorof Boolean) (Vectorof (U Zero One))))
|
||||
(define (boolean->01/vector bool-v)
|
||||
(vector-map (λ (x) (any->01 x)) bool-v))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "boolean->01/vector"
|
||||
(check-equal? (boolean->01/vector #(#t #f #f)) #(1 0 0))))
|
||||
|
||||
(: apply-tbf (-> tbf (Vectorof (U Zero One)) (U Zero One)))
|
||||
(define (apply-tbf tbf inputs)
|
||||
(: apply-tbf (-> tbf (Vectorof (U Zero One)) (U Zero One)))
|
||||
(define (apply-tbf tbf inputs)
|
||||
(any->01
|
||||
(>
|
||||
;; The scalar product between the inputs and the weights.
|
||||
|
|
@ -457,53 +456,53 @@
|
|||
(* x w))
|
||||
(tbf-θ tbf))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "apply-tbf"
|
||||
(define f1 (tbf #(2 -2) 1))
|
||||
(check-equal? (tabulate/pv/01 2 (pvλ (x y) (apply-tbf f1 (vector x y))))
|
||||
'((0 0 0) (0 1 0) (1 0 1) (1 1 0)))))
|
||||
|
||||
(: apply-tbf/boolean (-> tbf (Vectorof Boolean) Boolean))
|
||||
(define (apply-tbf/boolean tbf inputs)
|
||||
(: apply-tbf/boolean (-> tbf (Vectorof Boolean) Boolean))
|
||||
(define (apply-tbf/boolean tbf inputs)
|
||||
(01->boolean (apply-tbf tbf (boolean->01/vector inputs))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "apply-tbf/boolean"
|
||||
(define f1 (tbf #(2 -2) 1))
|
||||
(check-equal? (tabulate/pv/boolean 2 (pvλ (x y) (apply-tbf/boolean f1 (vector x y))))
|
||||
'((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f)))))
|
||||
|
||||
(: list->tbf (-> (Listof Real) tbf))
|
||||
(define (list->tbf lst)
|
||||
(: list->tbf (-> (Listof Real) tbf))
|
||||
(define (list->tbf lst)
|
||||
(define-values (w θ) (split-at-right lst 1))
|
||||
(tbf (list->vector w) (car θ)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "list->tbf"
|
||||
(check-equal? (list->tbf '(1 2 3)) (tbf #(1 2) 3))))
|
||||
|
||||
(: lists->tbfs (-> (Listof (Listof Real)) (Listof tbf)))
|
||||
(define (lists->tbfs lsts)
|
||||
(: lists->tbfs (-> (Listof (Listof Real)) (Listof tbf)))
|
||||
(define (lists->tbfs lsts)
|
||||
(map list->tbf lsts))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "read-tbfs"
|
||||
(check-equal? (lists->tbfs '((1 2 3) (2 3 4)))
|
||||
(list (tbf '#(1 2) 3) (tbf '#(2 3) 4)))))
|
||||
|
||||
(: read-org-tbfs (->* (String) (#:headers Boolean) (Listof tbf)))
|
||||
(define (read-org-tbfs str #:headers [headers #f])
|
||||
(: read-org-tbfs (->* (String) (#:headers Boolean) (Listof tbf)))
|
||||
(define (read-org-tbfs str #:headers [headers #f])
|
||||
(define sexp (assert-type (read-org-sexp str) (Listof Any)))
|
||||
(define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
|
||||
(lists->tbfs (assert-type sexp-clean (Listof (Listof Real)))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "read-org-tbfs"
|
||||
(check-equal? (read-org-tbfs "((1 2 1) (1 0 1))")
|
||||
(list (tbf '#(1 2) 1) (tbf '#(1 0) 1)))))
|
||||
|
||||
(: tbf-tabulate* (-> (Listof tbf) (Listof (Listof (U Zero One)))))
|
||||
(define (tbf-tabulate* tbfs)
|
||||
(: tbf-tabulate* (-> (Listof tbf) (Listof (Listof (U Zero One)))))
|
||||
(define (tbf-tabulate* tbfs)
|
||||
(define funcs (for/list ([tbf tbfs])
|
||||
: (Listof (-> (Listof (U Zero One)) (U Zero One)))
|
||||
(λ ([in : (Listof (U Zero One))])
|
||||
|
|
@ -511,22 +510,22 @@
|
|||
(define nvars (vector-length (tbf-w (car tbfs))))
|
||||
(tabulate*/list funcs (make-list nvars '(0 1))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tbf-tabulate*"
|
||||
(check-equal? (tbf-tabulate* (list (tbf #(2 2) 1) (tbf #(1 1) 1)))
|
||||
'((0 0 0 0) (0 1 1 0) (1 0 1 0) (1 1 1 1)))))
|
||||
|
||||
(: tbf-tabulate (-> tbf (Listof (Listof (U Zero One)))))
|
||||
(define (tbf-tabulate t)
|
||||
(: tbf-tabulate (-> tbf (Listof (Listof (U Zero One)))))
|
||||
(define (tbf-tabulate t)
|
||||
(tbf-tabulate* (list t)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tbf-tabulate"
|
||||
(check-equal? (tbf-tabulate (tbf #(1 2) 1))
|
||||
'((0 0 0) (0 1 1) (1 0 0) (1 1 1)))))
|
||||
|
||||
(: tbf-tabulate*/boolean (-> (Listof tbf) (Listof (Listof Boolean))))
|
||||
(define (tbf-tabulate*/boolean tbfs)
|
||||
(: tbf-tabulate*/boolean (-> (Listof tbf) (Listof (Listof Boolean))))
|
||||
(define (tbf-tabulate*/boolean tbfs)
|
||||
(define funcs (for/list ([tbf tbfs])
|
||||
: (Listof (-> (Listof Boolean) Boolean))
|
||||
(λ ([in : (Listof Boolean)])
|
||||
|
|
@ -534,47 +533,47 @@
|
|||
(define nvars (vector-length (tbf-w (car tbfs))))
|
||||
(tabulate*/list funcs (make-list nvars '(#f #t))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "tbf-tabulate*/boolean"
|
||||
(check-equal? (tbf-tabulate*/boolean (list (tbf #(1 2) 1)))
|
||||
'((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #t)))))
|
||||
|
||||
(: sbf? (-> tbf Boolean))
|
||||
(define (sbf? t)
|
||||
(: sbf? (-> tbf Boolean))
|
||||
(define (sbf? t)
|
||||
(= 0 (tbf-θ t)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "sbf?"
|
||||
(check-false (sbf? (tbf #(1 2) 3)))
|
||||
(check-true (sbf? (tbf #(1 2) 0)))))
|
||||
|
||||
(: sbf (-> (Vectorof Real) tbf))
|
||||
(define (sbf w)
|
||||
(: sbf (-> (Vectorof Real) tbf))
|
||||
(define (sbf w)
|
||||
(tbf w 0))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "sbf"
|
||||
(check-equal? (sbf #(1 -1)) (tbf '#(1 -1) 0))))
|
||||
|
||||
(: list->sbf (-> (Listof Real) tbf))
|
||||
(define (list->sbf lst) (sbf (list->vector lst)))
|
||||
(: list->sbf (-> (Listof Real) tbf))
|
||||
(define (list->sbf lst) (sbf (list->vector lst)))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "list->sbf"
|
||||
(check-equal? (list->sbf '(1 -1)) (tbf '#(1 -1) 0))))
|
||||
|
||||
(: read-org-sbfs (->* (String) (#:headers Boolean) (Listof tbf)))
|
||||
(define (read-org-sbfs str #:headers [headers #f])
|
||||
(: read-org-sbfs (->* (String) (#:headers Boolean) (Listof tbf)))
|
||||
(define (read-org-sbfs str #:headers [headers #f])
|
||||
(define sexp (assert-type (read-org-sexp str) (Listof Any)))
|
||||
(define sexp-clean (cond [headers (cdr sexp)] [else sexp]))
|
||||
(map list->sbf (assert-type sexp-clean (Listof (Listof Real)))))
|
||||
|
||||
(module+ test
|
||||
(module+ test
|
||||
(test-case "read-org-sbfs"
|
||||
(check-equal? (read-org-sbfs "((1 1) (1 -1))")
|
||||
(list (tbf '#(1 1) 0) (tbf '#(1 -1) 0)))))
|
||||
|
||||
(module untyped racket
|
||||
(module untyped racket
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
|
||||
|
|
@ -646,22 +645,3 @@
|
|||
(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)))))
|
||||
)
|
||||
)
|
||||
|
||||
(require 'typed)
|
||||
(provide
|
||||
pseudovariadic-lambda pvλ pseudovariadic-define pvdefine
|
||||
tabulate* tabulate*/strict tabulate*/pv
|
||||
tabulate tabulate/strict tabulate/pv
|
||||
tabulate*/pv/boolean tabulate/pv/boolean
|
||||
tabulate*/pv/01 tabulate/pv/01
|
||||
tabulate*/list tabulate/list
|
||||
tabulate*/list/boolean tabulate/list/boolean tabulate*/list/01 tabulate/list/01
|
||||
table->function/list table->function table->function/pv
|
||||
enumerate-boolean-tables enumerate-boolean-functions
|
||||
enumerate-boolean-functions/pv enumerate-boolean-functions/list
|
||||
random-boolean-table random-boolean-function random-boolean-function/list
|
||||
|
||||
(struct-out tbf) tbf-w tbf-θ boolean->01/vector apply-tbf apply-tbf/boolean
|
||||
list->tbf lists->tbfs read-org-tbfs tbf-tabulate* tbf-tabulate
|
||||
tbf-tabulate*/boolean sbf? sbf list->sbf read-org-sbfs)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
(parameterize ([sandbox-output 'string]
|
||||
[sandbox-error-output 'string]
|
||||
[sandbox-memory-limit 50])
|
||||
(make-evaluator 'typed/racket #:requires '((submod "functions.rkt" typed)))))
|
||||
(make-evaluator 'typed/racket #:requires '("functions.rkt"))))
|
||||
|
||||
@(define-syntax-rule (ex . args)
|
||||
(examples #:eval functions-evaluator . args))
|
||||
|
|
@ -610,10 +610,10 @@ See also @racket[read-org-tbfs].
|
|||
}
|
||||
@section[#:tag "fuctions/untyped"]{Untyped definitions}
|
||||
|
||||
@defmodule[(submod dds/functions typed untyped)]
|
||||
@defmodule[(submod dds/functions untyped)]
|
||||
|
||||
@(require (for-label (only-in racket/contract/base listof any/c)
|
||||
(for-label (only-in (submod "../functions.rkt" typed untyped)
|
||||
(for-label (only-in (submod "../functions.rkt" untyped)
|
||||
tabulate/boolean tabulate*/boolean
|
||||
tabulate/01 tabulate*/01))))
|
||||
|
||||
|
|
@ -632,7 +632,7 @@ accompanied by the explicit mention "untyped".
|
|||
(parameterize ([sandbox-output 'string]
|
||||
[sandbox-error-output 'string]
|
||||
[sandbox-memory-limit 50])
|
||||
(make-evaluator 'racket #:requires '((submod "functions.rkt" typed untyped)))))
|
||||
(make-evaluator 'racket #:requires '((submod "functions.rkt" untyped)))))
|
||||
|
||||
@(define-syntax-rule (ex/untyped . args)
|
||||
(examples #:eval functions-evaluator/untyped . args))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user