Personal website

Implementation

Compute a truth table for the given molecular statement.

Function scheme/boolean-product

Implement

(define (boolean-product length)
  "Return a list of all Boolean sequences of LENGTH."
  (let more-rows ((row (- (expt 2 length) 1)))
    (if (< row 0) (list)
        (cons (let more-columns ((column (- length 1)))
                (if (< column 0) (list)
                    (cons (even? (quotient row (expt 2 column)))
                          (more-columns (- column 1)))))
              (more-rows (- row 1))))))

Test

<<scheme/boolean-product>>
(unless (equal? (boolean-product 1)
                '((#f)
                  (#t)))
  (raise #f))
(unless (equal? (boolean-product 2)
                '((#f #f)
                  (#f #t)
                  (#t #f)
                  (#t #t)))
  (raise #f))
(unless (equal? (boolean-product 3)
                '((#f #f #f)
                  (#f #f #t)
                  (#f #t #f)
                  (#f #t #t)
                  (#t #f #f)
                  (#t #f #t)
                  (#t #t #f)
                  (#t #t #t)))
  (raise #f))
"tests passed"

tests passed

Function scheme/truth-table

Implement

Builds on scheme/boolean-product.

<<scheme/boolean-product>>
(define (truth-table procedure arity)
  "Return a truth table for PROCEDURE with ARITY."
  (map (lambda (inputs)
         (append inputs (list (apply procedure inputs))))
       (boolean-product arity)))

Test

<<scheme/truth-table>>
(unless (equal? (truth-table not 1)
                '((#f #t)
                  (#t #f)))
  (raise #f))
(unless (equal? (truth-table (lambda (p q) (and p q)) 2)
                '((#f #f #f)
                  (#f #t #f)
                  (#t #f #f)
                  (#t #t #t)))
  (raise #f))
(unless (equal? (truth-table (lambda (p q r) (or p q r)) 3)
                '((#f #f #f #f)
                  (#f #f #t #t)
                  (#f #t #f #t)
                  (#f #t #t #t)
                  (#t #f #f #t)
                  (#t #f #t #t)
                  (#t #t #f #t)
                  (#t #t #t #t)))
  (raise #f))
"tests passed"

tests passed

Function scheme/org-truth-table

Generate a truth table for presentation in Org documents.

Implement

Builds on scheme/truth-table.

Note. HEADERS are expected in LaTeX format.

<<scheme/truth-table>>
(define (org-truth-table procedure headers)
  (append (list (map (lambda (header)
                       (string-append "\\(" header "\\)"))
                     headers))
          (list (list))
          (list (append (list "/")
                        (make-list (- (length headers) 2) "")
                        (list "<")))
          (map (lambda (row)
                 (map (lambda (value)
                        (if value
                            "true"
                            "false"))
                      row))
               (truth-table procedure
                            (- (length headers)
                               1)))))

Test

<<scheme/org-truth-table>>
(unless
    (equal? (org-truth-table not '("P" "\\lnot P"))
            '(("\\(P\\)" "\\(\\lnot P\\)")
              ()
              ("/" "<")
              ("false" "true")
              ("true" "false")))
  (raise #f))
(unless
    (equal? (org-truth-table (lambda (p q) (and p q))
                             '("P" "Q" "P \\land Q"))
            '(("\\(P\\)" "\\(Q\\)" "\\(P \\land Q\\)")
              ()
              ("/" "" "<")
              ("false" "false" "false")
              ("false" "true" "false")
              ("true" "false" "false")
              ("true" "true" "true")))
  (raise #f))
"tests passed"

tests passed