---

Implementation

Compute a truth table for the given molecular statement.

• Function ‘scheme/boolean-product’ :noweb:
  • 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’ :noweb:
  • 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’ :noweb:

  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