; Example Proofs done in Lecture 14

(defun endp (x) (not (consp x)))
(defun app (x y)
  (if (endp x)
      y
    (cons (car x)
          (app (cdr x) y))))
-----------------------------------------------------------------

Q183a:
(consp x) --> (endp x) = nil

Proof:
(consp x) --> (endp x) = nil
<--> {rewrite with def endp}
(consp x) --> (not (consp x)) = nil
<--> {hyp}
(consp x) --> (not t) = nil
<--> {comp}
(consp x) --> t
<--> {basic}
t
Q.E.D.

Q183b:
!(consp x) --> (endp x) = t

Proof:
!(consp x) --> (endp x) = t
<--> {def endp}
!(consp x) --> !(consp x) = t
<--> {hyp, comp, basic}
t
Q.E.D.

Q188a:
(consp x) --> (app x y) = (cons (car x) (app (cdr x) y))

[This proof will illustrate how lemmas are like methods]

Proof:
[In brackets are some comments you wouldn't have to write,
but which I'm writing to help you understand what I'm doing.
Name the parts of formula.]
lhs: (app x y)
rhs: (cons (car x) (app (cdr x) y))

Goal:
(consp x) --> lhs=rhs

lhs
= {by the naming convention for lhs}
(app x y)
= {def app}
(if (endp x)
      y
    (cons (car x)
          (app (cdr x) y)))
= {Q183a, ifax2}
(cons (car x)
      (app (cdr x) y))
=
rhs
Q.E.D.


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

Theorem (very similar to homework problem Q206!)
((consp x)
  &
 (true-listp (cdr x)) --> (app (cdr x) nil) = (cdr x))
-->
(true-listp x) --> (app x nil) = x.

Proof.  [Again, I'll name the parts first]
H1: (consp x)
H2: (true-listp (cdr x)) --> (app (cdr x) nil) = (cdr x)
H2': (true-listp (cdr x))
lhs': (app (cdr x) nil)
rhs': (cdr x)
H2: H2' --> lhs'=rhs'
H3: (true-listp x)
lhs = (app x nil)
rhs = x

Goal:
(H1 & (H2' --> lhs'=rhs')) --> (H3 --> lhs=rhs)
<--> {promote}
(H1 & (H2' --> lhs'=rhs') & H3) --> lhs=rhs

---
To prove the formula above, I will prove that H3 is H2' 
and then use lhs'=rhs' to prove that lhs is rhs.

H3
=
(true-listp x)
= {def true-listp)
(if (endp x)
    (equal x nil)
    (true-listp (cdr x)))
= {Q183a, if-ax2}
(true-listp (cdr x))
= H2'

So now we return to the goal above:
---

(H1 & (H2' --> lhs'=rhs') & H3) --> lhs=rhs
<--> {by true-listp, q183a, if-ax2}  [this is just what I wrote above]
(H1 & (H2' --> lhs'=rhs') & H2') --> lhs=rhs
<--> {taut forward-chain}
(H1 & lhs'=rhs' & H2') --> lhs=rhs

---
Now I will prove lhs is rhs, assuming H1 and lhs'=rhs'.
I won't need H2' any more.

lhs
=
(app x nil)
= {Q188a, H1}
(cons (car x) (app (cdr x) nil))
=
(cons (car x) lhs')
= {lhs'=rhs'}
(cons (car x) rhs')
=
(cons (car x) (cdr x))
= {cons-car-cdr, H1}  ;  Ax: (consp x) --> (cons (car x)(cdr x)) = x.
x
= rhs.
Q.E.D.

-----------------------------------------------------------------
[In the proof above, we saw the use of promotion and forward
chaining.  Here it is again.]

Theorem:
((A --> (B & C))
 &
 (B --> D)
 &
 (C --> E))
-->
(A --> (D & E))

Proof:
(((A --> (B & C))
  &
  (B --> D)
  &
  (C --> E))
 -->
 (A --> (D & E)))

<--> {promotion}

(((A --> (B & C))
  &
  (B --> D)
  &
  (C --> E)
  &
  A)
 -->
 (D & E))

<--> {forward chaining, assoc,}

((B 
  &
  C
  &
  (B --> D)
  &
  (C --> E)
  &
  A)
 -->
 (D & E))

<--> {forward chaining, twice}

((B 
  &
  C
  &
  D
  &
  E
  &
  A)
 -->
 (D & E))

<--> {hyp D, E, comp, basic}

T
Q.E.D.