======================================================================
Exercise 7.1

Try to mimic the above proof for the following instance of the
associativity of app.

(equal (app (app a b) a)
       (app a (app b a)))

Notice that the proof attempt fails.  One often has to strengthen a
theorem in order to apply induction.

Here is the definition of app.

(defun app (x y)
  (if (endp x)
      y
    (cons (car x)
          (app (cdr x) y))))

Theorem 7.1.
(equal (app (app a b) a)
       (app a (app b a)))

Proof Attempt.  Induct using the measure (acl2-count a).  Let q_1 be
(consp a) and let sigma_1,1 be {a <- (cdr a)}.

Base Case.
(implies (not (consp a))
         (equal (app (app a b) a)
                (app a (app b a))))

Given Thm 7 and the definition of app, this simplifies to

(implies (not (consp a))
         (equal (app b a)
                (app b a)))

which simplifies to T.

Induction Step.
(implies (and (consp a)                                  ; q_1
              (equal (app (app (cdr a) b) (cdr a))       ; IH
                     (app (cdr a) (app b (cdr a)))))
         (equal (app (app a b) a)                        ; lhs
                (app a (app b a))))                      ; rhs

We assume q_1 and IH and simplify lhs first and then rhs.

lhs = (app (app a b) a)
 = {Def app, q_1, Thm 7}
      (app (cons (car a) (app (cdr a) b)) a)
 = {Lemma 2, pg 104}
      (cons (car a) (app (app (cdr a) b) a)).

At this proof in the proof on page 106, we used IH: the left-hand
side of IH matched the app nest corresponding to that above.  But no
such match occurs here.  In IH we have (app (app (cdr a) b) (cdr a))
but in the line above we have (app (app (cdr a) b) a).  Does that
tell you something?  You bet!  

Since we cannot do any more with the left-hand side, we turn to the
right.

rhs = (app a (app b a))
 = {Def app, q_1, Thm 7}
      (cons (car a) (app (cdr a) (app b a))).

This side doesn't match its corresponding term in IH either.  

Our induction hypothesis is inapplicable to this problem.  Why?
Because the theorem is not general enough.  It only applies to
app-nests in which the first argument is the same as the last.  But
in the inductive proof we need the first and last arguments to be
different.  

A good heuristic is to ``generalize at the mismatch.''

======================================================================
Exercise 7.2

Here is the definition of a list reverse function.
 
  (defun rev (x)
    (if (endp x)
        nil
      (app (rev (cdr x)) (list (car x)))))
 
A ``true list'' is a binary tree whose right-most branch terminates in
nil.  True lists are recognized by the predicate defined as follows.
(This predicate is already defined in ACL2 so we do not define it here
but just display its definition.)

(defun true-listp (x)
  (if (atom x)
      (equal x nil)
    (true-listp (cdr x))))

Prove

(true-listp (rev x))

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.
 
The conjecture is a theorem.  ACL2 will prove it automatically if
you just type:

(thm (true-listp (rev x)))

It prints out a pretty understandable proof.  But because this part
of the book is about the logic and not the mechanical prover, we
prove the theorem ``by hand.''  The proof is very similar to the one
ACL2 produces.

Theorem 7.2.
(true-listp (rev x))

Proof.
We split into two cases on whether x is a cons.

Case 1:
(implies (not (consp x))
         (true-listp (rev x)))

= {Defs rev and endp and case condition (not (consp x))}

(implies (not (consp x))
         (true-listp nil))

= {Def true-listp, implies}

T

Case 2:
(implies (consp x)
         (true-listp (rev x)))

= {Defs rev and endp and case condition (consp x)}

(implies (consp x)
         (true-listp (app (rev (cdr x)) (list (car x)))))

= {Lemma 7.2, below}

(implies (consp x)
         (true-listp (list (car x))))

= {Defs list, true-listp, and atom, and axioms about cdr and cons}

(implies (consp x)
         (true-listp nil))

= {Defs true-listp, endp and implies}

T

Q.E.D.

Lemma 7.2.
(equal (true-listp (app a b))
       (true-listp b))

Proof.

Induct using the measure (acl2-count a), q_1 being (consp a), and
sigma_1,1 being {a <- (cdr a)}.

Base Case:
(implies (not (consp a))
         (equal (true-listp (app a b))
                (true-listp b)))

= {Defs app and endp and case condition (not (consp a))}

(implies (not (consp a))
         (equal (true-listp b)
                (true-listp b)))

= {Axioms about equal and def implies}

T.

Induction Step:
(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (app a b))
                (true-listp b)))

= {Defs app, endp, true-listp, and atom, axioms about car, cdr, cons,
   and if, and case condition (consp a)}

(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (app (cdr a) b))
                (true-listp b)))

= {IH and def implies}

T

Q.E.D.

The justifications above are not very detailed.  The Induction Step
above could have been described more carefully by exposing
intermediate steps:

Induction Step:
(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (app a b))
                (true-listp b)))

= {Defs app, endp, case condition (consp a)}

(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (cons (car a) (app (cdr a) b)))
                (true-listp b)))

= {Defs true-listp and endp and the axiom (consp (cons x y)) = t and
   the theorem (if t x y) = x.}

(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (cdr (cons (car a) (app (cdr a) b))))
                (true-listp b)))

= {Axiom (cdr (cons x y)) = y}

(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))   ; lhs of IH
                     (true-listp b)))               ; rhs of IH
         (equal (true-listp (app (cdr a) b))
                (true-listp b)))

= {Substituting rhs of IH for lhs into conclusion }

(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp b)
                (true-listp b)))

= {Theorem (equal x x) = t and def implies}

T

In fact, we tend to take even larger proof steps.  The proofs we are seeing
are so mechanical that we feel justified now in describing the Induction
Step above as follows:

Induction Step:
(implies (and (consp a)
              (equal (true-listp (app (cdr a) b))
                     (true-listp b)))
         (equal (true-listp (app a b))
                (true-listp b)))

= {defs app, endp, true-listp, atom, implies, and basic axioms and equality
     reasoning}

T

We sometimes go so far as to use the justification {symbolic
computation} instead of enumerating the ``obvious'' definitions and
axioms.

======================================================================
Exercise 7.3

Prove

(equal (app x nil) x)

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.
 
The conjecture is not a theorem.  A counterexample is
(equal (app 7 nil) 7).  The lhs evaluates to nil, because (endp 7) is 
``false'' but the rhs is 7.  Since 7 and nil are different, the equality
is ``false'' or nil.

One might speculate that (implies (consp x) (equal (app x nil) x))
is a theorem.  However, one would be wrong.  See Exercise 7.4.

Observe that the speculative conjecture above is false if x is '(1 2
3 . 7).  In this case, (consp x) is t.  But the equal evaluates to
nil, so the implication fails.  The equal evaluates to nil because
the lhs, (app x nil), reduces to '(1 2 3) while the rhs reduces
to '(1 2 3 . 7).

Here is a theorem similar to the one suggested by these conjectures.

Theorem 7.3.
(implies (true-listp x)
         (equal (app x nil) x))

Proof.  Induct as ``suggested'' by (true-listp x), i.e., unwind the
recursion in (true-listp x).  If you are uncertain as to what this means,
see the solution to Exercise 6.25.

Base Case:
(implies (not (consp x))
         (implies (true-listp x)
                  (equal (app x nil) x)))

= {propositional calculus and symbolic computation, esp., true-listp}

(implies (and (not (consp x))
              (equal x nil))
         (equal (app x nil) x))

= {equality and symbolic computation}

T

Induction Step:
(implies (and (consp x)
              (implies (true-listp (cdr x))
                       (equal (app (cdr x) nil) (cdr x))))
         (implies (true-listp x)
                  (equal (app x nil) x)))

This is equivalent to the conjunction of Cases 1 and 2 below.

Case 1.
(implies (and (consp x)
              (true-listp (cdr x))
              (equal (app (cdr x) nil) (cdr x))
              (true-listp x))
         (equal (app x nil) x)) 

= {symbolic computation}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (app (cdr x) nil) (cdr x)))
         (equal (cons (car x) (app (cdr x) nil)) x))

= {IH}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (app (cdr x) nil) (cdr x)))
         (equal (cons (car x) (cdr x)) x))

= {symbolic computation}

T

Case 2.
(implies (and (consp x)
              (not (true-listp (cdr x)))
              (true-listp x))
         (equal (app x nil) x))

= {symbolic computation, esp., true-listp} 

T.

Q.E.D.

======================================================================
Exercise 7.4

What is wrong with the following argument?

(implies (consp x) (equal (app x nil) x))

Proof. Induct on x.  The base case, defined by (not (consp x)), is a
theorem because we know (consp x).  In the induction step we know
(consp x) and (equal (app (cdr x) nil) (cdr x)).  The induction
conclusion is (equal (app x nil) x), which expands to
(equal (cons (car x) (app (cdr x) nil)) x).  By the induction hypothesis,
we get (equal (cons (car x) (cdr x)) x), which is true.  Q.E.D?

See Exercise 7.3 for a counterexample to this conjecture.  Also, see
Exercise 7.3 for a corrected theorem and a correct proof.

The problem with the ``proof'' above is that the induction hypothesis
is represented as (equal (app (cdr x) nil) (cdr x)) when in fact
the logic requires it to be

(implies (consp (cdr x))
         (equal (app (cdr x) nil) (cdr x)))

The ``induction hypothesis'' used in the bogus proof is just the
conclusion of the correct induction hypothesis.  In the correct
proof, one can use the conclusion of the induction hypothesis only
by establishing the hypothesis of the induction hypothesis.

In the proof in question, this would require proving that if (consp
x) then (consp (cdr x)).  This implication does not hold.

======================================================================
Exercise 7.5

Prove

(equal (rev (app a b)) (app (rev a) (rev b)))

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.

The conjecture is not a theorem.  If a is '(1 2 3) and b is '(4 5 6),
then the lhs reduces to '(6 5 4 3 2 1) while the rhs reduces to '(3 2
1 6 5 4).

Theorem 7.5.
(equal (rev (app a b))
       (app (rev b) (rev a)))

Proof.  Induct as suggested by (app a b).

Base Case:
(implies (not (consp a))
         (equal (rev (app a b))
                (app (rev b) (rev a))))

= {symbolic computation}

(implies (not (consp a))
         (equal (rev b)
                (app (rev b) nil)))

= {Theorems 7.3 and 7.2}

T.

Induction Step:
(implies (and (consp a)
              (equal (rev (app (cdr a) b))
                     (app (rev b) (rev (cdr a)))))
         (equal (rev (app a b))
                (app (rev b) (rev a))))

= {symbolic computation}

(implies (and (consp a)
              (equal (rev (app (cdr a) b))
                     (app (rev b) (rev (cdr a)))))
         (equal (rev (cons (car a) (app (cdr a) b)))
                (app (rev b) (app (rev (cdr a)) (list (car a))))))

= {symbolic computation}

(implies (and (consp a)
              (equal (rev (app (cdr a) b))
                     (app (rev b) (rev (cdr a)))))
         (equal (app (rev (app (cdr a) b)) (list (car a)))
                (app (rev b) (app (rev (cdr a)) (list (car a))))))

= {IH -- subst rhs of IH for lhs of IH into conclusion above}

(implies (and (consp a)
              (equal (rev (app (cdr a) b))
                     (app (rev b) (rev (cdr a)))))
         (equal (app (app (rev b) (rev (cdr a))) (list (car a)))
                (app (rev b) (app (rev (cdr a)) (list (car a))))))

= {Lemma: Associativity of app, pg 105}

T.

Q.E.D.

======================================================================
Exercise 7.6

Prove

(equal (rev (rev x)) x)

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.

The conjecture is not a theorem.  If x is '(1 2 3 . 7), then the lhs
reduces to '(1 2 3) while the rhs is '(1 2 3 . 7).

Theorem 7.6.
(implies (true-listp x)
         (equal (rev (rev x)) x))

Proof.  Induct as suggested by (true-listp x).

Base Case:
(implies (not (consp x))
         (implies (true-listp x)
                  (equal (rev (rev x)) x)))

= {symbolic computation}

T.

Induction Step:
(implies (and (consp x)
              (implies (true-listp (cdr x))
                       (equal (rev (rev (cdr x))) (cdr x))))
         (implies (true-listp x)
                  (equal (rev (rev x)) x)))

= {symbolic computation -- see the Induction Step in our proof of
   Theorem 7.3, above, for an explicit handling of the case split
   caused by having an implication as a hypothesis.  One branch of
   this split (Case 2 in 7.2) is trivial and we are left with the other.}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (rev (rev (cdr x))) (cdr x)))
         (equal (rev (rev x)) x))

= {symbolic computation}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (rev (rev (cdr x))) (cdr x)))
         (equal (rev (app (rev (cdr x)) (list (car x)))) x))

= {Theorem 7.5}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (rev (rev (cdr x))) (cdr x)))
         (equal (app (rev (list (car x)))
                     (rev (rev (cdr x))))
                x))

= {symbolic computation}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (rev (rev (cdr x))) (cdr x)))
         (equal (cons (car x)
                      (rev (rev (cdr x))))
                x))

= {IH}

(implies (and (consp x)
              (true-listp (cdr x))
              (equal (rev (rev (cdr x))) (cdr x)))
         (equal (cons (car x)
                      (cdr x))
                x))

= {symbolic computation}

T.

Q.E.D.

======================================================================
Exercise 7.7

The following function produces the mirror image of a tree.

(defun swap-tree (x)
  (if (atom x)
      x
    (cons (swap-tree (cdr x))
          (swap-tree (car x)))))

Prove

(equal (flatten (swap-tree x)) (rev (flatten x)))

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.

The definition of flatten is

(defun flatten (x)
  (cond
   ((atom x) (list x))
   (t (app (flatten (car x))
           (flatten (cdr x))))))

Theorem 7.7.
(equal (flatten (swap-tree x))
       (rev (flatten x)))

Proof.  Induct as suggested by (swap-tree x).  That is, the measure is
(acl2-count x), q_1 is (consp x), sigma_1,1 is {x <- (car x)}, and
sigma_1,2 is {x <- (cdr x)}.  (The recursive scheme of swap-tree would
actually suggest that q_1 be (not (atom x)), but that is equivalent to
(consp x).)

Base Case:
(implies (not (consp x))
         (equal (flatten (swap-tree x))
                (rev (flatten x))))

= {symbolic computation -- (flatten x) in this case is just (list x).}

T.

Induction Step:
(implies (and (consp x)
              (equal (flatten (swap-tree (car x)))    ; IH1
                     (rev (flatten (car x))))
              (equal (flatten (swap-tree (cdr x)))    ; IH2
                     (rev (flatten (cdr x)))))
         (equal (flatten (swap-tree x))
                (rev (flatten x))))

= {symbolic computation}

(implies (and (consp x)
              (equal (flatten (swap-tree (car x)))    ; IH1
                     (rev (flatten (car x))))
              (equal (flatten (swap-tree (cdr x)))    ; IH2
                     (rev (flatten (cdr x)))))
         (equal (flatten (cons (swap-tree (cdr x))
                               (swap-tree (car x))))
                (rev (app (flatten (car x))
                          (flatten (cdr x))))))

= {symbolic computation}

(implies (and (consp x)
              (equal (flatten (swap-tree (car x)))    ; IH1
                     (rev (flatten (car x))))
              (equal (flatten (swap-tree (cdr x)))    ; IH2
                     (rev (flatten (cdr x)))))
         (equal (app (flatten (swap-tree (cdr x)))
                     (flatten (swap-tree (car x))))
                (rev (app (flatten (car x))
                          (flatten (cdr x))))))

= {Theorem 7.5}

(implies (and (consp x)
              (equal (flatten (swap-tree (car x)))    ; IH1
                     (rev (flatten (car x))))
              (equal (flatten (swap-tree (cdr x)))    ; IH2
                     (rev (flatten (cdr x)))))
         (equal (app (flatten (swap-tree (cdr x)))
                     (flatten (swap-tree (car x))))
                (app (rev (flatten (cdr x)))
                     (rev (flatten (car x))))))

= {IH1 and IH2}

(implies (and (consp x)
              (equal (flatten (swap-tree (car x)))    ; IH1
                     (rev (flatten (car x))))
              (equal (flatten (swap-tree (cdr x)))    ; IH2
                     (rev (flatten (cdr x)))))
         (equal (app (rev (flatten (cdr x)))
                     (rev (flatten (car x))))
                (app (rev (flatten (cdr x)))
                     (rev (flatten (car x))))))

= {symbolic computation}

T.

Q.E.D.

======================================================================
Exercise 7.8

Here is another way to reverse a list.

(defun rev1 (x a)
  (if (endp x)
      a
    (rev1 (cdr x) (cons (car x) a))))

Prove

(equal (rev1 x nil) (rev x))

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.

Theorem 7.8.
(equal (rev1 x nil) (rev x))

Proof.
(rev1 x nil)

= {Lemma 7.8, below}

(app (rev x) nil)

= {Theorems 7.3 and 7.2}

(rev x).

Q.E.D.

Lemma 7.8.
(equal (rev1 x a) (app (rev x) a))

Proof.  Induct as suggested by (rev1 x a).  Note that q_1 is (consp x)
-- actually, it is the equivalent (not (endp x)) -- and sigma_1,1 is
{x <- (cdr x); a <- (cons (car x) a)}.

Base Case:
(implies (not (consp x))
         (equal (rev1 x a) (app (rev x) a)))

= {symbolic computation}

T.

Induction Step:
(implies (and (consp x)
              (equal (rev1 (cdr x) (cons (car x) a))
                     (app (rev (cdr x)) (cons (car x) a))))
         (equal (rev1 x a)
                (app (rev x) a)))

= {symbolic computation}

(implies (and (consp x)
              (equal (rev1 (cdr x) (cons (car x) a))
                     (app (rev (cdr x)) (cons (car x) a))))
         (equal (rev1 (cdr x) (cons (car x) a))
                (app (app (rev (cdr x)) (list (car x))) a)))

= {Lemma:  Associativity of app, pg 105}

(implies (and (consp x)
              (equal (rev1 (cdr x) (cons (car x) a))
                     (app (rev (cdr x)) (cons (car x) a))))
         (equal (rev1 (cdr x) (cons (car x) a))
                (app (rev (cdr x)) (app (list (car x)) a))))

= {symbolic computation}

(implies (and (consp x)
              (equal (rev1 (cdr x) (cons (car x) a))
                     (app (rev (cdr x)) (cons (car x) a))))
         (equal (rev1 (cdr x) (cons (car x) a))
                (app (rev (cdr x)) (cons (car x) a))))

= {prop calc -- IH is conclusion}

T.

Q.E.D.

The moral of this simple little proof is that it is often necessary to
generalize a conjecture before proving it by induction.  We needed a
variable, a, in the second argument of rev1, not the constant nil.

======================================================================
Exercise 7.9

Here is another way to flatten a tree, due to John McCarthy,

(defun mc-flatten (x a)
  (if (atom x)
      (cons x a)
    (mc-flatten (car x)
                (mc-flatten (cdr x) a))))

Prove

(equal (mc-flatten x nil) (flatten x))

or show a counterexample.  If you show a counterexample, can you
modify the conjecture to make it a theorem?  If so, prove the modified
conjecture.

Theorem 7.9.
(equal (mc-flatten x nil) (flatten x))

Proof.
(mc-flatten x nil)

= {Lemma 7.9a, below}

(app (flatten x) nil)

= {Theorem 7.3 and Lemma 7.9b, below}

(flatten x)

Q.E.D.

Lemma 7.9a.
(equal (mc-flatten x a)
       (app (flatten x) a))

Proof.  Induct as suggested by (mc-flatten x a).  We use (consp x) for q_1,
instead of (not (atom x)) as actually suggested.  Note that we have
two substitutions:

sigma_1,1 = {x <- (car x); a <- (mc-flatten (cdr x) a)}

sigma_1,2 = {x <- (cdr x); a <- a}.

Base Case:
(implies (not (consp x))
         (equal (mc-flatten x a)
                (app (flatten x) a)))

= {symbolic computation}

T.

Induction Step:
(implies (and (consp x)
              (equal (mc-flatten (car x) (mc-flatten (cdr x) a))     ; IH1
                     (app (flatten (car x))
                          (mc-flatten (cdr x) a)))
              (equal (mc-flatten (cdr x) a)                          ; IH2
                     (app (flatten (cdr x))
                          a)))
         (equal (mc-flatten x a)
                (app (flatten x)
                     a)))

= {symbolic computation}

(implies (and (consp x)
              (equal (mc-flatten (car x) (mc-flatten (cdr x) a))     ; IH1
                     (app (flatten (car x))
                          (mc-flatten (cdr x) a)))
              (equal (mc-flatten (cdr x) a)                          ; IH2
                     (app (flatten (cdr x))
                          a)))
         (equal (mc-flatten (car x) (mc-flatten (cdr x) a))
                (app (app (flatten (car x))
                          (flatten (cdr x)))
                     a)))

= {IH1}

(implies (and (consp x)
              (equal (mc-flatten (car x) (mc-flatten (cdr x) a))     ; IH1
                     (app (flatten (car x))
                          (mc-flatten (cdr x) a)))
              (equal (mc-flatten (cdr x) a)                          ; IH2
                     (app (flatten (cdr x))
                          a)))
         (equal (app (flatten (car x))
                     (mc-flatten (cdr x) a))
                (app (app (flatten (car x))
                          (flatten (cdr x)))
                     a)))

= {IH2}

(implies (and (consp x)
              (equal (mc-flatten (car x) (mc-flatten (cdr x) a))     ; IH1
                     (app (flatten (car x))
                          (mc-flatten (cdr x) a)))
              (equal (mc-flatten (cdr x) a)                          ; IH2
                     (app (flatten (cdr x))
                          a)))
         (equal (app (flatten (car x))
                     (app (flatten (cdr x))
                          a))
                (app (app (flatten (car x))
                          (flatten (cdr x)))
                     a)))

= {Lemma:  Associativity of app, pg 105}

T.

Q.E.D.

Lemma 7.9b.
(true-listp (flatten x))

Proof.  Induct as suggested by (flatten x).

Base Case:
(implies (not (consp x))
         (true-listp (flatten x)))

= {symbolic computation}

T.

Induction Step:
(implies (and (consp x)
              (true-listp (flatten (car x)))
              (true-listp (flatten (cdr x))))
         (true-listp (flatten x)))

= {symbolic computation}

(implies (and (consp x)
              (true-listp (flatten (car x)))
              (true-listp (flatten (cdr x))))
         (true-listp (app (flatten (car x))
                          (flatten (cdr x)))))

= {Lemma 7.2}

(implies (and (consp x)
              (true-listp (flatten (car x)))
              (true-listp (flatten (cdr x))))
         (true-listp (flatten (cdr x))))

= {prop calc -- second IH is conclusion}

T.

Q.E.D.

