(in-package "ACL2")

;; Formalize and prove the theorem: Permutation is an equivalence
;; relation (i.e., reflexive, symmetric and transitive).  Furthermore,
;; 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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OK, so we have all the concepts necessary for stating the theorem.
;; Let's state it.

(defthm perm-reflexive
  (perm x x))

#||

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

Here is the checkpoint.

(IMPLIES (AND (CONSP X)
              (MEM (CAR X) Y)
              (PERM (DEL (CAR X) Y) (CDR X))
              (PERM (CDR X) (DEL (CAR X) Y)))
         (PERM Y X))

;; If we omit the last hypothesis then we seem to have a plausible
;; lemma:


||#

(defthm perm-symmetric-lemma
  (implies (and (consp x)
                (mem (car x) y)
                (perm (del (car x) y) (cdr x)))
           (perm y x)))

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

#||

Fails

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

Subgoal *1/5''
(IMPLIES (AND (CONSP X)
              (NOT (MEM (CAR X) Z))
              (MEM (CAR X) Y)
              (PERM (CDR X) (DEL (CAR X) Y)))
         (NOT (PERM Y Z)))

Subgoal *1/3''
(IMPLIES (AND (CONSP X)
              (MEM (CAR X) Z)
              (NOT (PERM (DEL (CAR X) Y) (DEL (CAR X) Z)))
              (MEM (CAR X) Y)
              (PERM (CDR X) (DEL (CAR X) Y))
              (PERM Y Z))
         (PERM (CDR X) (DEL (CAR X) Z)))

Let's start with the second checkpoint.  We see a contradition between
the third and the final hypothesis.

But Fails again

(defthm perm-del-del 
  (implies (perm y z)
           (perm (del a y) (del a z))))

Subgoal *1/4.2
(IMPLIES (AND (CONSP Y)
              (NOT (EQUAL A (CAR Y)))
              (PERM (DEL A (CDR Y))
                    (DEL A (DEL (CAR Y) Z)))
              (MEM (CAR Y) Z)
              (PERM (CDR Y) (DEL (CAR Y) Z)))
         (MEM (CAR Y) (DEL A Z)))

Subgoal *1/4.1
(IMPLIES (AND (CONSP Y)
              (NOT (EQUAL A (CAR Y)))
              (PERM (DEL A (CDR Y))
                    (DEL A (DEL (CAR Y) Z)))
              (MEM (CAR Y) Z)
              (PERM (CDR Y) (DEL (CAR Y) Z)))
         (PERM (DEL A (CDR Y))
               (DEL (CAR Y) (DEL A Z))))


||#

;; The first checkpoint suggests the following lemma.

(defthm mem-del 
  (implies (and (not (equal a b))
                (mem b z))
           (mem b (del a z))))

;; The second checkpoint suggests the following.

(defthm del-del 
  (equal (del a (del b x))
         (del b (del a x))))

;; Now this succeeds

(defthm perm-del-del 
  (implies (perm y z)
           (perm (del a y) (del a z))))

#||

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

; We get the checkpoint "Subgoal *1/5''" shown earlier.
; Inspection suggests this lemma, which fails.


(defthm not-perm-if-different-members 
  (implies (and (not (mem a z))
                (mem a y))
           (not (perm y z))))

Now we look at the checkpoints for this one.

Subgoal *1/2''
(IMPLIES (AND (CONSP Y)
              (MEM (CAR Y) Z)
              (MEM A (DEL (CAR Y) Z))
              (NOT (MEM A Z))
              (MEM A (CDR Y)))
         (NOT (PERM (CDR Y) (DEL (CAR Y) Z))))

Clearly the third and fourth hypotheses are contradictory.  So we
formulate the following lemma.


||#


(defthm mem-del-implies-mem 
  (implies (not (mem a z))
           (not (mem a (del b z)))))

;; So we try this again.

(defthm not-perm-if-different-members 
  (implies (and (not (mem a z))
                (mem a y))
           (not (perm y z))))

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

;; Now let us try the perm-rev lemma.

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


#||

(u)

;; We totally got lucky here.  It somehow generalized the theorem to
;; an appropriate lemma and then succeeded.  But we may not get lucky
;; all the time, so we'll try it without the generalization.

||#


#||

(defthm perm-rev
  (perm (rev x) x)
  :hints (("Goal"
           :do-not '(generalize))))

Hits us with a weird problem.
(IMPLIES (AND (CONSP X)
              (PERM (REV (CDR X)) (CDR X)))
         (PERM (APP (REV (CDR X)) (LIST (CAR X)))
               X))

We can push this through, but something is unsatisfying about the
approach.  The reason why it does not feel natural is that we don't
seem to capture the reason why this is true.  So we abandon this
attempt and try something a bit more general.

||#