(*---------------------------------------------------------------------------*
 * "minsort" - a naive sort, but a good test for formal development.         *
 * Minsort is not really a sorting algorithm, since it eliminates duplicates *
 * in the input.                                                             *
 *---------------------------------------------------------------------------*)

(*---------------------------------------------------------------------------*
 * Bring in and open up required context.                                    *
 *---------------------------------------------------------------------------*)

app load ["bossLib", "Q", "permTheory", "sortingTheory"];

open bossLib sortingTheory permTheory listTheory 
     relationTheory arithmeticTheory;


(*---------------------------------------------------------------------------*
 * Algorithms.                                                               *
 *---------------------------------------------------------------------------*)

val expunge_def = 
 Define
    `(expunge x []     = [])
 /\  (expunge x (h::t) = if x=h then expunge x t else h::expunge x t)`;


val min_def = 
 Define
    `(min [] m = m) 
 /\  (min (h::t) m = if m <= h then min t m else min t h)`;


val minsort_def = 
 Hol_defn "minsort"
    `(minsort [] = []) 
 /\  (minsort (h::t) =
       let m = min t h
       in 
         m::minsort (expunge m (h::t)))`;


(*---------------------------------------------------------------------------*
 * Lemmas about min.                                                         *
 *---------------------------------------------------------------------------*)

val MEM_min = Q.prove
(`!h t. MEM (min t h) (h::t)`,
 Induct_on `t` 
  THEN RW_TAC list_ss [min_def]
  THEN PROVE_TAC [MEM, DECIDE (Term `~(x<=y) ==> ~(x=y)`)]);


val min_leq_start = Q.prove
(`!h t. min t h <= h`,
 Induct_on `t` 
  THEN RW_TAC list_ss [min_def]
  THEN Q.PAT_ASSUM `$! M` (MP_TAC o SPEC_ALL)
  THEN DECIDE_TAC);

val min_leq = Q.prove
(`!h t x. MEM x (h::t) ==> min t h <= x`,
Induct_on `t` THENL
 [RW_TAC list_ss [min_def,MEM],
  ONCE_REWRITE_TAC [MEM]
   THEN RW_TAC list_ss [min_def] THEN
   PROVE_TAC [min_leq_start,LESS_EQ_TRANS,MEM,
              DECIDE(Term`!x y. x<=y /\ ~(z<=y) ==> x<=z`)]]);

(*---------------------------------------------------------------------------*
 * Lemmas about expunge.                                                     *
 *---------------------------------------------------------------------------*)

val not_MEM_expunge = Q.prove
(`!x l. ~MEM x (expunge x l)`,
 Induct_on `l` 
  THEN RW_TAC list_ss [expunge_def,MEM]);

val MEM_expunge = Q.prove
(`!x y l. ~(y=x) ==> MEM x l ==> MEM x (expunge y l)`,
 Induct_on `l` 
  THEN RW_TAC list_ss [expunge_def,MEM]
  THEN PROVE_TAC []);

val MEM_expunge_MEM = Q.prove
(`!x y l. MEM x (expunge y l) ==> MEM x l`,
 Induct_on `l` 
    THEN RW_TAC list_ss [expunge_def]
    THEN PROVE_TAC [MEM]);


(*---------------------------------------------------------------------------*
 * Argument boundedness of expunge.                                          *
 *---------------------------------------------------------------------------*)

val expunge_argb = Q.prove
(`!x l. LENGTH (expunge x l) <= LENGTH l`,
 Induct_on `l` 
   THEN RW_TAC list_ss [expunge_def] 
   THEN PROVE_TAC [DECIDE (Term `x<=y  ==> x <= SUC y`)]);


(*---------------------------------------------------------------------------*
 * Strictness of expunge.                                                    *
 *---------------------------------------------------------------------------*)

val expunge_strict = Q.prove
(`!x l. MEM x l ==> LENGTH (expunge x l) < LENGTH l`,
 Induct_on `l` 
    THEN RW_TAC list_ss [MEM,expunge_def]
    THEN PROVE_TAC [expunge_argb, DECIDE (Term `x <= y ==> x < SUC y`)]);


(*---------------------------------------------------------------------------*
 * Termination of minsort.                                                   *
 * First, instantiate the definition of `minsort' with the termination       *
 * relation.                                                                 *
 *---------------------------------------------------------------------------*)

val (minsort_eqns, minsort_ind) = 
Defn.tprove
 (minsort_def,
  WF_REL_TAC `measure LENGTH`
   THEN PROVE_TAC [expunge_strict,MEM_min]);

(*---------------------------------------------------------------------------*
 * Correctness:                                                              *
 *                                                                           *
 *    o !x l. MEM x l = MEM x (minsort l)                                    *
 *    o !l. sorted $<= (minsort l)                                           *
 *                                                                           *
 *---------------------------------------------------------------------------*)
           
val MEM_minsort = Q.store_thm("MEM_minsort",
 `!l x. MEM x (minsort l) = MEM x l`,
recInduct minsort_ind
 THEN RW_TAC std_ss [minsort_eqns,MEM]
 THEN PROVE_TAC [MEM_expunge, MEM_min, MEM, MEM_expunge_MEM]);


val SORTED_minsort = Q.store_thm
("SORTED_minsort",
 `!l. SORTED $<= (minsort l)`,
 recInduct minsort_ind
  THEN RW_TAC std_ss [minsort_eqns] THENL 
  [RW_TAC std_ss [SORTED_def],
   `transitive $<=` by (ONCE_REWRITE_TAC[transitive_def] THEN DECIDE_TAC) 
     THEN PROVE_TAC [SORTED_eq,MEM_minsort, MEM_expunge_MEM, min_leq]]);

