(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)