; (certify-book "perm-quicksort-via-hm")

(in-package "ACL2")

; Load our usual quicksort.

(include-book "quicksort")

; Define the permutation relation, perm.

(defun rm (e x)
  (if (consp x)
      (if (equal e (car x))
          (cdr x)
          (cons (car x) (rm e (cdr x))))
      nil))

(defun memb (e x)
  (if (consp x)
      (or (equal e (car x))
          (memb e (cdr x)))
      nil))

(defun perm (x y)
  (if (consp x)
      (and (memb (car x) y)
           (perm (cdr x) (rm (car x) y)))
      (not (consp y))))

; Define ``how-many.''

(defun hm (e x)
  (if (endp x)
      0
      (if (equal e (car x))
          (+ 1 (hm e (cdr x)))
          (hm e (cdr x)))))

; Since we're counting, load an arithmetic book.

(include-book "arithmetic-5/top" :dir :system)

; This function returns an element (of x or of y) that will refute the claim
; that x and y are permutations of each other if there is such an element.  If
; there is not (i.e., if they are permutations of each other) then it doesn't
; matter what nc returns.  In Hyeonseo's definition, below, it returns nil.
; But in class we showed that it could return 45 instead.

(defun nc (x y)
; This is the ``non-common'' element function of Hyeonseo Ku.
  (cond
   ((and (endp x) (consp y))
    (car y))
   ((and (consp x) (endp y))
    (car x))
   ((and (endp x) (endp y))
    nil)
   (t (if (memb (car x) y)
          (nc (cdr x) (rm (car x) y))
          (car x)))))

; The case analysis in the function above could be more succinctly expressed.
; But this definition makes the intention clearer.

; This lemma was ``discovered'' using The Method while trying to prove the
; next one.

(defthm hm-rm
  (equal (hm e (rm d x))
         (if (equal e d)
             (if (memb d x)
                 (- (hm e x) 1)
                 (hm e x))
             (hm e x))))

; ACL2 chooses the wrong induction on this theorem.  We have to provide a hint.
; In class we saw that the hint (perm x y) would also do.  But inducting so as
; to unwind (hm (nc x y) x), as ACL2 chooses, is pointless!

(defthm perm-hm                   ; [0]
  (iff (perm x y)
       (equal (hm (nc x y) x)
              (hm (nc x y) y)))
  :hints (("Goal" :induct (nc x y))))

; Now we show how to exploit the above fact to prove that quicksort returns a
; permutation of its input.  The key lemma below is hm-quicksort.  The two
; intervening lemmas were discovered via The Method.

(defthm hm-remove-gt-lte
  (equal (+ (hm e (remove-gt d x))
            (hm e (remove-lte d x)))
         (hm e x)))
  
(defthm hm-append
  (equal (hm e (append a b))
         (+ (hm e a) (hm e b))))

(defthm hm-quicksort              ; [1]
  (equal (hm e (quicksort x))
         (hm e x)))

; To prove:
; (perm (quicksort x) x)          ; [2]

; using the strategy we've ``programmed'' above, ACL2 first rewrites [2],
; using [0], to:

; (equal (hm alpha (quicksort x)) ; [3]
;        (hm alpha x))

; where alpha is (nc (quicksort x) x).  But it doesn't matter what alpha is!
; The reason is that we prove [2] by appealing to [1], letting e be alpha
; (whatever alpha is).  

(defthm perm-quicksort
  (perm (quicksort x) x))

; This shows that we can now prove any perm property, (PERM delta gamma), by
; proving (EQUAL (HM E delta) (HM E gamma)).