dds/functions.rkt

#lang typed/racket

;;; dds/functions

;;; This modules provides some definitions for working with functions:
;;; tabulating, (re)constructing from tables, generating random
;;; functions, etc.  Some definitions of particular kinds of functions
;;; are also provided (threshold Boolean functions, etc.).

(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
  [stream-map (All (a b) (-> (-> a b) (Sequenceof a) (Sequenceof b)))])

(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->unary-function 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 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)

(module+ test
  (require typed/rackunit))

(begin-for-syntax
  (require racket (for-syntax syntax/parse))

  (define (make-pseudovariadic-core args bodies tag-stx)
    (define nargs-stx (datum->syntax args (length (syntax->list args))))
    #`(λ xs
        (match xs
          [(list #,@args) #,@bodies]
          [_ (error #,tag-stx "invalid arity, expected ~a argument(s)" #,nargs-stx)])))

  (define (make-pseudovariadic-lambda stx)
    (syntax-parse stx
      [(_ (args:id ...) bodies:expr ...)
       (make-pseudovariadic-core #'(args ...)
                                 #'(bodies ...)
                                 (datum->syntax stx ''pseudovariadic-lambda))]))

  (define (make-pseudovariadic-define stx)
    (syntax-parse stx
      [(_ (name:id args:id ...) bodies:expr ...)
       #`(define name
           #,(make-pseudovariadic-core
              #'(args ...)
              #'(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))

(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))

(module+ test
  (test-case "pseudovariadic-define")
  (: f (-> Boolean * Boolean))
  (pseudovariadic-define (f x y) (and x y))
  (check-false (f #t #f))
  (check-exn exn:fail? (λ () (f #t #f #f)))

  (: g (-> Boolean * Boolean))
  (pvdefine (g x y) (and x y))
  (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 (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)
                                 (Listof (Listof (U Any b))))))
(make-tabulate* tabulate* append apply)

(module+ test
  (test-case "tabulate*"
    (check-equal? (tabulate*
                   (list (λ (x y) (and x y))
                         (λ (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)))
    (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)
                                       (Listof (List (List a ...) (Listof b))))))
(make-tabulate* tabulate*/strict list apply)

(module+ test
  (test-case "tabulate*/strict"
    (check-equal? (tabulate*/strict
                   (list (λ (x y) (and x y))
                         (λ (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))))))


(: tabulate*/pv (All (a b) (-> (Listof (-> a * b)) (Listof (Listof a))
                               (Listof (Listof (U a b))))))
(make-tabulate* tabulate*/pv append apply)

(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)
  (func arg))

(: tabulate*/list (All (a b) (-> (Listof (-> (Listof a) b)) (Listof (Listof a))
                                 (Listof (Listof (U a b))))))
(make-tabulate* tabulate*/list append simple-apply)

(module+ test
  (test-case "tabulate*/list"
    (check-equal? (tabulate*/list (list (λ ([xs : (Listof Boolean)])
                                          (and (car xs) (cadr xs)))
                                        (λ ([xs : (Listof Boolean)])
                                          (or (car xs) (cadr xs))))
                                  '((#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)
                               (Listof (Listof (U Any b))))))
(define (tabulate func doms)
  (tabulate* (list func) doms))

(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)
                                      (Listof (List (List a ...) (Listof b))))))
(define (tabulate/strict func doms)
  (tabulate*/strict (list func) doms))

(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))
                              (Listof (Listof (U a b))))))
(define (tabulate/pv func doms)
  (tabulate*/pv (list func) doms))

(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))
                                (Listof (Listof (U a b))))))
(define (tabulate/list func doms)
  (tabulate*/list (list func) doms))

(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 func (make-list arity '(#f #t))))

(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))
                            (Listof (Listof Boolean))))
(define (tabulate*/pv/boolean arity funcs)
  (tabulate*/pv funcs (make-list arity '(#f #t))))

(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))
                      (Listof (Listof (U Zero One)))))
(define (tabulate/pv/01 arity func)
  (tabulate/pv func (make-list arity '(0 1))))

(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)))
                       (Listof (Listof (U Zero One)))))
(define (tabulate*/pv/01 arity funcs)
  (tabulate*/pv funcs (make-list arity '(0 1))))

(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)
                             (Listof (Listof Boolean))))
(define (tabulate/list/boolean arity func)
  (tabulate/list func (make-list arity '(#f #t))))

(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))
                              (Listof (Listof Boolean))))
(define (tabulate*/list/boolean arity funcs)
  (tabulate*/list funcs (make-list arity '(#f #t))))

(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))
                        (Listof (Listof (U Zero One)))))
(define (tabulate/list/01 arity func)
  (tabulate/list func (make-list arity '(0 1))))

(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)))
                         (Listof (Listof (U Zero One)))))
(define (tabulate*/list/01 arity funcs)
  (tabulate*/list funcs (make-list arity '(0 1))))

(module+ test
  (test-case "tabulate*/list/01"
    (check-equal? (tabulate*/list/01
                   2
                   `(,(λ (xs) (assert-type (min (car xs) (cadr xs)) (U Zero One)))
                     ,(λ (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))
                                     (-> (Listof a) a))))
(define (table->function/list table)
  (table->unary-function
   (for/list ([line (in-list table)]) : (Listof (List (Listof a) a))
             (define-values (ins out) (split-at-right line 1))
             (list ins (car out)))))

(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->unary-function (All (a b) (-> (Listof (List a b)) (-> a b))))
(define (table->unary-function table)
  (define ht-tab
    (for/hash ([line (in-list table)]) : (HashTable a b)
      (values (car line) (cadr line))))
  (λ (x) (hash-ref ht-tab x)))

(module+ test
  (test-case "table->unary-function"
    (define unary-negation (table->unary-function '((#t #f) (#f #t))))
    (check-false (unary-negation #t))
    (check-true (unary-negation #f))))

(: table->function (All (a) (-> (Listof (Listof a)) (-> a * a))))
(define (table->function table)
  (define func (table->function/list table))
  (λ args (func args)))

(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)
  (define func (table->function/list table))
  (define arity (- (length (car table)) 1))
  (λ xs
    (if (= arity (length xs))
        (func xs)
        (error 'pseudovariadic-lambda
               "invalid arity, expected ~a argument(s)"
               arity))))

(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)
  (define inputs (boolean-power n))
  (define outputs (boolean-power/stream (assert-type (expt 2 n) Integer)))

  (: append-outputs (-> (Listof (Listof Boolean)) (Listof Boolean)
                        (Listof (Listof Boolean))))
  (define (append-outputs ins outs)
    (for/list ([row ins] [o outs]) (append row (list o))))

  (: yield (-> (Sequenceof (Listof Boolean)) (Sequenceof (Listof (Listof Boolean)))))
  (define (yield rest-outputs)
    (if (stream-empty? rest-outputs)
        (stream)
        (stream-cons (append-outputs inputs (stream-first rest-outputs))
                     (yield (stream-rest rest-outputs)))))

  (yield outputs))

(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))
                    ((#f #f #f) (#f #t #f) (#t #f #f) (#t #t #t))
                    ((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #f))
                    ((#f #f #f) (#f #t #f) (#t #f #t) (#t #t #t))
                    ((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #f))
                    ((#f #f #f) (#f #t #t) (#t #f #f) (#t #t #t))
                    ((#f #f #f) (#f #t #t) (#t #f #t) (#t #t #f))
                    ((#f #f #f) (#f #t #t) (#t #f #t) (#t #t #t))
                    ((#f #f #t) (#f #t #f) (#t #f #f) (#t #t #f))
                    ((#f #f #t) (#f #t #f) (#t #f #f) (#t #t #t))
                    ((#f #f #t) (#f #t #f) (#t #f #t) (#t #t #f))
                    ((#f #f #t) (#f #t #f) (#t #f #t) (#t #t #t))
                    ((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #f))
                    ((#f #f #t) (#f #t #t) (#t #f #f) (#t #t #t))
                    ((#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)
  (stream-map (inst table->function Boolean) (enumerate-boolean-tables n)))

(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)
  (stream-map (inst table->function/pv Boolean) (enumerate-boolean-tables n)))

(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
   (-> Positive-Integer (Sequenceof (-> (Listof Boolean) Boolean))))
(define (enumerate-boolean-functions/list n)
  (stream-map (inst table->function/list Boolean) (enumerate-boolean-tables n)))

(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)
  (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
  (test-case "random-boolean-table"
    (random-seed 1)
    (check-equal? (random-boolean-table 2)
                  '((#f #f #t)
                    (#f #t #t)
                    (#t #f #f)
                    (#t #t #t)))))

(: random-boolean-function (-> Positive-Integer (-> Boolean * Boolean)))
(define (random-boolean-function n)
  (table->function (random-boolean-table n)))

(module+ test
  (test-case "random-boolean-function"
    (random-seed 1)
    (define random-bool-f (random-boolean-function 2))
    (check-true (random-bool-f #f #f))
    (check-true (random-bool-f #f #t))
    (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)
  (table->function/list (random-boolean-table n)))

(module+ test
  (test-case "random-boolean-function/list"
    (random-seed 1)
    (define random-bool-f/list (random-boolean-function/list 2))
    (check-true (random-bool-f/list '(#f #f)))
    (check-true (random-bool-f/list '(#f #t)))
    (check-false (random-bool-f/list '(#t #f)))
    (check-true (random-bool-f/list '(#t #t)))))

(struct tbf ([weights : (Vectorof Real)] [threshold : Real])
  #:transparent #:type-name TBF)
(define tbf-w tbf-weights)
(define tbf-θ tbf-threshold)

(: 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
  (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)
  (any->01
   (>
    ;; The scalar product between the inputs and the weights.
    (for/sum ([x (in-vector inputs)]
              [w (in-vector (tbf-w tbf))]) : Real
             (* x w))
    (tbf-θ tbf))))

(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)
  (01->boolean (apply-tbf tbf (boolean->01/vector inputs))))

(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)
  (define-values (w θ) (split-at-right lst 1))
  (tbf (list->vector w) (car θ)))

(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)
  (map list->tbf lsts))

(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])
  (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
  (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)
  (define funcs (for/list ([tbf tbfs])
                  : (Listof (-> (Listof (U Zero One)) (U Zero One)))
                  (λ ([in : (Listof (U Zero One))])
                    (apply-tbf tbf (list->vector in)))))
  (define nvars (vector-length (tbf-w (car tbfs))))
  (tabulate*/list funcs (make-list nvars '(0 1))))

(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* (list t)))

(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)
  (define funcs (for/list ([tbf tbfs])
                  : (Listof (-> (Listof Boolean) Boolean))
                  (λ ([in : (Listof Boolean)])
                    (apply-tbf/boolean tbf (list->vector in)))))
  (define nvars (vector-length (tbf-w (car tbfs))))
  (tabulate*/list funcs (make-list nvars '(#f #t))))

(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)
  (= 0 (tbf-θ t)))

(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)
  (tbf w 0))

(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)))

(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])
  (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
  (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+ test
    (require rackunit))

  (provide
   (contract-out [tabulate* (-> (listof procedure?) (listof (listof any/c))
                                (listof (listof any/c)))]
                 [tabulate (-> procedure? (listof (listof any/c))
                               (listof (listof any/c)))]
                 [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))))]))

  (define (tabulate* funcs doms)
    (for/list ([xs (in-list (apply cartesian-product doms))])
      (append xs (for/list ([f funcs])
                   (apply f xs)))))

  (module+ test
    (test-case "tabulate*"
      (check-equal? (tabulate*
                     (list (λ (x y) (and x y))
                           (λ (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)))
      (check-equal? (tabulate* empty '((#f #t) (#f #t)))
                    '((#f #f) (#f #t) (#t #f) (#t #t)))))

  (define (tabulate func doms)
    (tabulate* (list func) doms))

  (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)))))

  (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)))))

  (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)))))
  )