---

Explore

Compute whether a given molecular statement is a tautology.

• Function ‘scheme/tautology?’

  Search truth tables for the absence of ‘FALSE’ to identify tautologies.

  Builds on ‘scheme/truth-table’.

  (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))))))
  (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)))
  
  (define (tautology? procedure arity)
    (not (member #f (map (lambda (row)
                           (car (reverse row)))
                         (truth-table procedure arity)))))
  

  (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))))))
  (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)))
  
  (define (tautology? procedure arity)
    (not (member #f (map (lambda (row)
                           (car (reverse row)))
                         (truth-table procedure arity)))))
  
  (unless (tautology? (lambda (p) (or p #t)) 1) (raise #f))
  (unless (tautology? (lambda (p q) (or p q #t)) 2) (raise #f))
  (unless (tautology? (lambda (p q r) (or p q r #t)) 3) (raise #f))
  
  (when (tautology? (lambda (p) (or p)) 1) (raise #f))
  (when (tautology? (lambda (p q) (or p q)) 2) (raise #f))
  (when (tautology? (lambda (p q r) (or p q r)) 3) (raise #f))
  
  "tests passed"
  

  tests passed