; Problem Set 3 Answers
; 
; Here are my answers to Problem Set 3.  In this file I give the proofs
; for each conjecture.  I give them in two different formats.  For each
; problem I first give the "hand proof", writing out the traditional kind of
; proof.  Then, I give the "abbreviated proof", which is a sequence of
; ACL2s events.  The traditional proofs are comments; the abbreviated proofs
; are not.  You can process this file in ACL2s, but you should use
; Recursion and Induction mode. 

(include-book "m1" :ttags :all)

(in-package "M1")

; This will automatically include problem-set-1-answer.lisp and the
; definition of m1.  So now we have all these defuns:

; (defun len (x)
;   (if (endp x)
;       0
;     (+ 1 (len (cdr x)))))
; 
; (defun app (x y)
;   (if (endp x)
;       y
;     (cons (car x)
;           (app (cdr x) y))))
; 
; (defun rev (x)
;   (if (endp x)
;       nil
;     (app (rev (cdr x))
;          (cons (car x) nil))))
; 
; (defun member (e list)
;   (if (endp list)
;       nil
;     (if (equal e (car list))
;         t
;       (member e (cdr list)))))
; 
; (defun repeat (th n)
;      (if (zp n)
;          nil
;        (cons th (repeat th (- n 1)))))
; 
; (defun run (sched s)
;   (if (endp sched)
;       s
;     (run (cdr sched) (step s))))
; 
; For this problem set, you need not think about the definition of step.  Just
; imagine there is a one argument function named step.
; 
; Prove the following theorems.  I do not want mechanical proofs, but conventional
; ``hand proofs.''
; 
; Problem 3-1: (len (rev x)) = (len x)
; 
; Proof:
; 
; Induct on x.
; 
; Base case:
; 
; Givens:
; (not (consp x))
; 
; We will prove (len (rev x)) = (len x) by reducing both sides to the same thing:
; 
; lhs 
; =
; (len (rev x))
; =
; (len nil)
; =
; 0
; 
; rhs
; =
; (len x)
; =
; 0
; 
; Induction Step:
; Givens:  
; (consp x)
; (len (rev (cdr x))) = (len (cdr x))   [IH]
; 
; We will prove (len (rev x)) = (len x) by reducing both sides to the same thing.
; 
; lhs
; =
; (len (rev x))
; =
; (len (app (rev (cdr x)) (list (car x))))
; =                                           {len-app proved in class}
; (+ (len (rev (cdr x)))
;    (len (list (car x))))
; =
; (+ (len (rev (cdr x)))
;    1)
; =                                           {IH}
; (+ (len (cdr x)) 1)
; 
; rhs
; =
; (len x))
; =
; (+ 1 (len (cdr x)))
; =                                           {arithmetic}
; (+ (len (cdr x)) 1)
; 
; Q.E.D.
; 
; ---
; 
; We can give this proof in the abbreviated form.  First, I need the
; lemma we proved in class, len-app, which is proved by inducting
; the way (app a b) recurs:

; NOTE: When I defined the "M1" package I neglected to import the symbol
; THEOREM.  Thus, it is undefined in "M1".  So below I have to type it's full
; name, ACL2::THEOREM.  A similar comment goes for ACL2::ENABLE.  Sorry.

(acl2::theorem len-app
   (equal (len (app a b)) (+ (len a) (len b)))
   :hints (("Goal" :induct (app a b))))

(acl2::theorem  Problem-3-1
   (equal (len (rev x)) (len x))
   :hints (("Goal"
            :induct (rev x)                          ; Here is the induction hint and
            :in-theory (acl2::enable len-app))))     ; the acknowledgment of len-app

; ---

; Problem 3-2: (member e (app a b)) = (or (member e a) (member e b))
; 
; Proof:
; 
; By induction on a.
; 
; Base Case:
; Given: (not (consp a))
; 
; lhs = (member e (app a b))
;     = (member e b)
; 
; rhs = (or (member e a) (member e b))
;     = (or nil (member e b))
;     = (member e b)
; 
; Induction Step:
; Given: (consp a)
;        (member e (app (cdr a) b)) = (or (member e (cdr a)) (member e b)) [IH]
; 
; lhs = (member e (app a b))
;     = (member e (cons (car a) (app (cdr a) b)))
;     = (if (equal e (car a))
;           t
;           (member e (app (cdr a) b)))
;     = (or (equal e (car a))
;           (member e (app (cdr a) b)))
;     =                                     {IH}
;       (or (equal e (car a))
;           (or (member e (cdr a))
;               (member e b)))
; 
; rhs = (or (member e a) (member e b))
;     = (or (if (equal e (car a))
;               t
;             (member e (cdr a)))
;           (member e b))
;     = (or (or (equal e (car a))
;               (member e (cdr a)))
;           (member e b))
;     =                                      {prop calc}
;       (or (equal e (car a))
;           (or (member e (cdr a))
;               (member e b)))
; 
; Q.E.D.
; 
; ---
; Abbreviated Proof:

(acl2::theorem Problem-3-2
   (equal (member e (app a b))
          (or (member e a)
              (member e b)))
   :hints (("Goal" :induct (app a b))))

; ---
; 
; Problem 3-3: (natp n) -> (len (repeat x n)) = n
; 
; Proof:
; 
; By induction on n.
; 
; Base Case:
; Given: (zp n)
;        (natp n)
; 
; Note that we thus also know:
; 
;        n=0
; 
; Proof that lhs=rhs:
; 
; lhs = (len (repeat x n))
;     = (len (repeat x 0))
;     = (len nil)
;     = 0
; 
; rhs = n
;     = 0
; 
; Induction Step:
; Given: (not (zp n))
;        (natp n)
;        (natp (- n 1)) -> (len (repeat x (- n 1))) = (- n 1)     [IH]
; 
; Note that we know (natp (- n 1)) since n is a natp and n>0.  Thus, we have
; 
;        (len (repeat x (- n 1))) = (- n 1)                       [IH']
; 
; Proof that lhs=rhs:
; 
; lhs = (len (repeat x n))
;     = (len (cons x (repeat x (- n 1))))
;     = (+ 1 (len (repeat x (- n 1))))
;     =                                                           {IH'}
;       (+ 1 (- n 1))
;     =                                                           {arith}
;       n
; 
; rhs = n
; 
; Q.E.D.
; 
; ---
; 
; Abbreviated Proof:
(acl2::theorem Problem-3-3
   (implies (natp n)
            (equal (len (repeat x n)) n))
   :hints (("Goal" :induct (repeat x n))))
 
; ---
; 
; Problem 3-4: (run (app a b) s) = (run b (run a s)))
; 
; Proof:
; 
; By induction on a.
; 
; Base Case:
; Given: (not (consp a))
; 
; lhs = (run (app a b) s)
;     = (run b s)
; 
; rhs = (run b (run a s))
;     = (run b s)
; 
; Induction Step:
; Given: (consp a)
;        (run (app (cdr a) b) (step s)) = (run b (run (cdr a) (step s))) [IH]
; 
; Note:  To get our IH we replaced a by (cdr a) and replaced s by (step s)!
; 
; lhs = (run (app a b) s)
;     = (run (cons (car a) (app (cdr a) b)) s)
;     = (run (app (cdr a) b) (step s))
;     =                                             [IH]
;     = (run b (run (cdr a) (step s)))
; 
; rhs = (run b (run a s))
;     = (run b (run (cdr a) (step s)))
; 
; Q.E.D.
; 
; ---
; 
; To do Problem-3-4 mechanically we have to introduce step and run.
; They are not in problem-set-1-answers.  I'll just introduce step
; as an undefined function.  Because I didn't import defstub into
; the M1 package I have to use the explicit package name.  You
; won't need to use defstub in general (we wouldn't  need it if
; I loaded m1).

; ---
; Abbreviated Proof:
 
(acl2::theorem Problem-3-4
   (equal (run (app a b) s)
          (run b (run a s)))
   :hints (("Goal" :induct (run a s))))