(in-package "ACL2")

;; Formalize and prove the theorem: If you reverse a list then the result
;; is a permutation of the original list.

;; First define the relevant concepts

;; We define the notion of reversing a list.  That needs the concept
;; of appending.

(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)) (list (car x)))))


;; Now we define the concept of permutation

(defun mem (e x)
  (if (endp x)
      nil
    (if (equal e (car x))
        T
      (mem e (cdr x)))))

(defun del (e x)
  (if (endp x) nil
    (if (equal e (car x))
        (cdr x)
      (cons (car x) (del e (cdr x))))))

(defun perm (x y)
  (if (endp x) (endp y)
    (and (mem (car x) y)
         (perm (cdr x) (del (car x) y)))))


;; So why do we think this is a theorem.  This is because for each
;; object e, the number of times e occurs in x is the same as the
;; number of times e occurs in (rev x).  So we will try to formalize
;; that strategy.  But then we need to define the notion of "number of
;; times e occurs in x.

(defun how-many (e x)
  (if (endp x) 0
    (+ (if (equal e (car x)) 1 0)
       (how-many e (cdr x)))))

;; Let's first prove that we are indeed in the right track.  That is,
;; the number of times e occurs in x is the same as the number of
;; times e occurs in (rev x).

#||

(defthm how-many-rev
  (equal (how-many e (rev x))
         (how-many e x)))

;; Notice that we have oriented the equality in a specific way.  This
;; is because each theorem we prove will be later used as a rule.  The
;; simplest rule is the "rewrite" rule.  We are asking ACL2 here: "If
;; you see a term of the form how-many of rev, replace it with
;; how-many of the argument to rev.


;; The theorem was proven but we were a bit lucky, because it
;; generalized just the right way.  We may not be lucky in general, so
;; let's see what we would do if it did not generalize.

(u)

(defthm how-many-rev
  (equal (how-many e (rev x))
         (how-many e x))
  :hints (("Goal"
           :do-not '(generalize))))

;; Fails with the following two checkpoints.

;; Subgoal *1/2.2'
;; (IMPLIES (AND (CONSP X)
;;               (EQUAL (HOW-MANY (CAR X) (REV (CDR X)))
;;                      (HOW-MANY (CAR X) (CDR X))))
;;          (EQUAL (HOW-MANY (CAR X)
;;                           (APP (REV (CDR X)) (LIST (CAR X))))
;;                 (+ 1 (HOW-MANY (CAR X) (CDR X)))))

;; Subgoal *1/2.1
;; (IMPLIES (AND (CONSP X)
;;               (EQUAL (HOW-MANY E (REV (CDR X)))
;;                      (HOW-MANY E (CDR X)))
;;               (NOT (EQUAL E (CAR X))))
;;          (EQUAL (HOW-MANY E (APP (REV (CDR X)) (LIST (CAR X))))
;;                 (HOW-MANY E (CDR X))))

;; A cursory look at this suggests that we need to do something about
;; how-many of app.

||#

(defthm how-many-app
  (equal (how-many e (app x y))
         (+ (how-many e x)
            (how-many e y))))

;; Now we try the how-many-rev again!

(defthm how-many-rev
  (equal (how-many e (rev x))
         (how-many e x))
  :hints (("Goal"
           :do-not '(generalize))))

;; And it succeeds.

;; But now we need to connect how-many with perm.  How do we do that?
;; We want to formalize and prove the statement "If forall e (how-many
;; e x) = (how-many e y)) then (perm x y).  But we don't have the
;; quantifier, at least for now.

;; So think!










































;; OK, so we define a counter-example generator for perm.  That is, we
;; define a function that will return the object whose count will
;; differ in x and y when x and y are not permutations.

(defun perm-counter-example (x y)
  (cond ((atom x) (car y))
        ((not (mem (car x) y))
         (car x))
        (t (perm-counter-example (cdr x) (del (car x) y)))))

#||
    
(defthm perm-how-many
  (implies (equal (how-many (perm-counter-example x y) x)
                  (how-many (perm-counter-example x y) y))
           (perm x y)))

;; Fails with these failed subgoals.

;; Subgoal *1/4''
;; (IMPLIES (AND (CONSP X) (NOT (MEM (CAR X) Y)))
;;          (NOT (EQUAL (HOW-MANY (CAR X) X)
;;                      (HOW-MANY (CAR X) Y))))

;; Subgoal *1/2.2'
;; (IMPLIES (AND (CONSP X)
;;               (MEM (CAR X) Y)
;;               (NOT (EQUAL (HOW-MANY (CAR X) (CDR X))
;;                           (HOW-MANY (CAR X) (DEL (CAR X) Y))))
;;               (EQUAL (PERM-COUNTER-EXAMPLE (CDR X)
;;                                            (DEL (CAR X) Y))
;;                      (CAR X))
;;               (EQUAL (+ 1 (HOW-MANY (CAR X) (CDR X)))
;;                      (HOW-MANY (CAR X) Y)))
;;          (PERM (CDR X) (DEL (CAR X) Y)))

;; Subgoal *1/2.1'
;; (IMPLIES (AND (CONSP X)
;;               (MEM (CAR X) Y)
;;               (NOT (EQUAL (HOW-MANY (PERM-COUNTER-EXAMPLE (CDR X)
;;                                                           (DEL (CAR X) Y))
;;                                     Y)
;;                           (HOW-MANY (PERM-COUNTER-EXAMPLE (CDR X)
;;                                                           (DEL (CAR X) Y))
;;                                     (DEL (CAR X) Y))))
;;               (NOT (EQUAL (PERM-COUNTER-EXAMPLE (CDR X)
;;                                                 (DEL (CAR X) Y))
;;                           (CAR X)))
;;               (EQUAL (HOW-MANY (PERM-COUNTER-EXAMPLE (CDR X)
;;                                                      (DEL (CAR X) Y))
;;                                (CDR X))
;;                      (HOW-MANY (PERM-COUNTER-EXAMPLE (CDR X)
;;                                                      (DEL (CAR X) Y))
;;                                Y)))
;;          (PERM (CDR X) (DEL (CAR X) Y)))

;; OK so we start looking them one at a time.

||#

;; The first is asking about how-many of an object that is not
;; member.  But that guy's count is 0.  Let's prove that.

(defthm how-many-not-mem
  (implies (not (mem e x))
           (equal (how-many e x) 0)))

#||

;; Now try again

(defthm perm-how-many
  (implies (equal (how-many (perm-counter-example x y) x)
                  (how-many (perm-counter-example x y) y))
           (perm x y)))
||#

;; As expected the first goal is gone.  But there are two more.  Now,
;; we notice that we are required to deal with how-many of a del.  So
;; let's try to think about a general rule.

(defthm how-many-del
  (equal (how-many e (del a b))
         (if (and (equal e a)
                  (mem e b))
             (1- (how-many e b))
           (how-many e b))))

;; Done, and we'll let it go this time.

(defthm perm-how-many
  (implies (equal (how-many (perm-counter-example x y) x)
                  (how-many (perm-counter-example x y) y))
           (perm x y)))

;; But we want to just remove the implication and make it an equality.
;; So we also prove the other direction.

(defthm perm-implies-how-many
  (implies (perm x y)
           (equal (how-many e x)
                  (how-many e y))))


;; Now we have successfully traded the perm for how-many.

(defthm perm-how-many-rewrite
  (equal (perm x y)
         (equal (how-many (perm-counter-example x y) x)
                (how-many (perm-counter-example x y) y))))


;; Now we try our original theorem.


(defthm perm-rev
  (perm (rev x) x))

;; Success!!


;; Let's now see how this has simplified further reasoning about perm.

(defthm perm-reflexive
 (perm x x))

#||

(defthm perm-symmetric
  (implies (perm x y)
           (perm y x)))

;; Fails!  Why?  We have now caused the equality of perm to get in our
;; way.  So we disable that.

||#

(in-theory (disable perm-how-many-rewrite))

;; Now give it back

(defthm perm-symmetric
  (implies (perm x y)
           (perm y x)))

;; The lesson!  Think about your lemmas carefully.  Some lemmas can
;; cause others to fail.

(defthm perm-transitive
  (implies (and (perm x y)
                (perm y z))
           (perm x z)))

;; Try: Introduce the insertion-sort function in logic mode and then
;; prove:

;; (perm (insertion-sort x) x)